Autocreate/set text layer

we're undergoing a standards change that will require some extensive editing
of some custom scripts/lisps to relfect the new layer names.

but I began to wonder if the ones we use for annotating could be all
replaced with simpler routines.

basically i need a routine to recognize an object's layer and create and/or
set the current layer to the same name with "-text" as a suffix.

example:

a line is drawn on layer EX-LINE.

to annotate the line the user selects the object and the routine will create
a layer "EX-LINE-TEXT" if it doesn't exist, or set it current if it does
exist.

(i should then be able to add the necessary annotation commands to the
routine)

any help or direction to something already written would be appreciated. it
will take me forever to kludge the whole thing up on my own.

 

whot do you wont excatly??? i think i cxan halp u

 

Try this:

(setq entitylayer (assoc 8 (entget (car (entsel "Select item for notation:
")))));;; finds the Layer name of the selected entity.
(command "LAYER" "M" (strcat entitylayer "-TEXT") "C" <the color you want>
"" "");;; makes a (possibly new) Layer with the same name plus -TEXT.
<...continue with annotation commands....>

"Making" the Layer spares you the trouble of finding out whether it exists
or not, and doing something different depending on what you find out. If it
exists, it doesn't change anything, unless it exists with a different color
than you code in, in which case it will "fix" that. And it sets that Layer
as current, unlike the New layer option, whether it exists already or not.

You can do other stuff too, of course (linetype for the Layer, error
handling, etc.).

 

I'm think you might be missing a call to CDR in that code.

 

do you mean in place of the CAR ?

 

I thought i was being pretty exact with what i need. what more info do you
need?

 

No, they mean in front of the (assoc 8) part, and they're right -- my
mistake. It should be:
(setq entitylayer (cdr (assoc 8 (entget (car (entsel "Select item for
notation: "))))))

Without the (cdr), it sets the entitylayer quantity to the whole dotted
pair, including the 8 and the parentheses. Using (cdr) gets you just the
layer name part.

 

thanks, that is working well.

but now i realize it requires idiot-proofing because if a "-text" layer is
selected (by mistake), i will get a "-text-text" layer, and so on....

 

Hi,

The code below does what you asked for and a little more. You should be
able to visualise what it does and adjust to meet more specific needs.

--


Laurie Comerford
CADApps
www.cadapps.com.au

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function to select an object and create
' a layer with name based on that of the selected object
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub CreateTextLayer()
On Error Resume Next
Dim sLayerName As String
Dim oLayer As AcadLayer
Dim oEnt As AcadEntity
Dim Pt(0 To 2) As Double
Dim sNameExtension As String
sNameExtension = "-TEXT"
Do
ThisDrawing.Utility.GetEntity oEnt, Pt, "Select object for '" &
sNameExtension & "' layer creation"
sLayerName = oEnt.Layer
If InStr((UCase(sLayerName)), UCase(sNameExtension)) = 0 Then
sLayerName = sLayerName & sNameExtension
Set oLayer = ThisDrawing.Layers.Add(sLayerName)
' You can set a whole range of layer features using the 'With'
' feature below.
With oLayer
.Color = acRed ' This was written in R3. The colour system for
layers is different in R2004 format drawings
.Linetype = "CONTINUOUS"
.Lineweight = acLnWt030
.Plottable = True
End With
ThisDrawing.ActiveLayer = sLayerName
' Option to move selected item to the layer if it is text of mtext
If TypeOf oEnt Is AcadText Or TypeOf oEnt Is AcadMText Then
oEnt.Layer = sLayerName
End If
End If
Loop Until Err <> 0
' Line above keeps code going till
' user presses <Esc> or fails to select an object.
MsgBox "No object selected, finishing program run"
End Sub

 

hiya laurie,

i'm getting a format error when i try to load this.

 

Hi Doug,

It's VBA code.

Type "vbaide" at the command line.

Select the "Insert" menu and choose a "Module"

Right click on the module and select "View Code"

Clipboard the code I sent into the module.

Save the file and then you can run the code from there.

--


Laurie Comerford
CADApps
www.cadapps.com.au