Topic: I am looking for a lisp to label lines with layer name

[ELOQUINTET]

I seem to recall seeing something like this somewhere but not sure if it was in the swamp or not. I need desperately lisp lisp which would label what layer each line is on. I am trying to revamped a program we use for drawing assemblies to put certain elements on specified layers creating in effect subassemblies but in order to understand everything i need to be able to tell one from the other so i know what to put on the same layer in my code. Does anyone have something that will put a layer label beside every line selected
Thanks

[ronjonp]

Try this Dan,

Code: [Select]

(defun rjp-addtext (ins hgt text / doc x)
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (vla-addText
    (if (= (getvar 'cvport) 1)
      (vla-get-paperspace doc)
      (vla-get-modelspace doc)
    )
    text
    (vlax-3d-point ins)
    (* (getvar 'dimscale) hgt)
  )
)


(defun c:x (/ index ss obj lyr ept spt mpt)
  (setq index -1)
  (if (setq ss (ssget "x" '((0 . "LINE"))))
    (progn
      (while (< (setq index (1+ index)) (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss index))
      lyr (vla-get-layer obj)
      ept (vlax-get obj 'endpoint)
      spt (vlax-get obj 'startpoint)
      mpt (polar ept (angle ept spt) (/ (distance ept spt) 2.0))
)
(rjp-addtext mpt 1 lyr)
      )
      (princ)
    )
  )
  (princ)
)

Puts the layername at the end of the line.

[ELOQUINTET]

i will try it tomorrow and let you know ron thanks a bunch. this will help me trememndously. i have about 115 items i need to identify phewwww

[ronjonp]

i will try it tomorrow and let you know ron thanks a bunch. this will help me trememndously. i have about 115 items i need to identify phewwww

Glad to help

[Kerry]

Nice starter Ron !

[CAB]

I like it, good job Ron.

[ronjonp]

Thanks Guys

[LE]

Yes...

And take the day off please, it will be on theswamp account...

[ronjonp]

Dan,

I updated the code above to place the text on the midpoint of the line.

Ron

[ELOQUINTET]

ron i was using it and it works good but what would be ideal would be if the text would run vertically it it is labelling a vertical line because when i have lines intersecting i have labels on top of eachother. i also have some lines whose layers weren't labelled. it worked good for what i need it for but would need to be improved if i were to use it more. that aside i am very grateful for your help it made the job i was doing alot easier. presh

[CADmium]

here is a Lisp, integrating Layernames in Linetypedefinitions..

[CAB]

Hey Ron,
How about aligning the text with the lines?

Code: [Select]

(defun rjp-addtext (ins hgt text ang / doc x)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (setq txtObj (vla-addtext
                 (if (= (getvar 'cvport) 1)
                   (vla-get-paperspace doc)
                   (vla-get-modelspace doc)
                 )
                 text
                 (vlax-3d-point ins)
                 hgt
               )
  )
  (vla-put-rotation txtObj ang)
  (vla-put-alignment txtObj acalignmentbottomcenter)
  (vla-put-textalignmentpoint txtobj (vlax-3d-point ins))
)


(defun c:x (/ index ss obj lyr ept spt mpt txtht)
  (setq index -1)
  ;;(if (setq ss (ssget "x" '((0 . "LINE"))))
  (if (setq ss (ssget '((0 . "LINE"))))
    (progn
      (while (< (setq index (1+ index)) (sslength ss))
        (setq obj (vlax-ename->vla-object (ssname ss index))
              lyr (vla-get-layer obj)
              ept (vlax-get obj 'endpoint)
              spt (vlax-get obj 'startpoint)
              ang (angle spt ept)
              mpt (polar ept (angle ept spt) (/ (distance ept spt) 2.0))
        )
        (if (and (> ang (* 0.5 pi)) (< ang (* 1.5 pi)))
          (setq ang (+ ang pi))
        )
        (setq mpt (polar mpt (+ ang (/ pi 2.0)) (* (getvar 'dimscale) (getvar 'dimgap))))
        (if (zerop (setq txtht (getvar 'textsize)))
          (setq txtht 5)
        )
        (rjp-addtext mpt txtht lyr ang)
      )
    )
  )
  (princ)
)

[ronjonp]

Hey Ron,
How about aligning the text with the lines?

Code: [Select]

(defun rjp-addtext (ins hgt text ang / doc x)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (setq txtObj (vla-addtext
                 (if (= (getvar 'cvport) 1)
                   (vla-get-paperspace doc)
                   (vla-get-modelspace doc)
                 )
                 text
                 (vlax-3d-point ins)
                 hgt
               )
  )
  (vla-put-rotation txtObj ang)
  (vla-put-alignment txtObj acalignmentbottomcenter)
  (vla-put-textalignmentpoint txtobj (vlax-3d-point ins))
)


(defun c:x (/ index ss obj lyr ept spt mpt txtht)
  (setq index -1)
  ;;(if (setq ss (ssget "x" '((0 . "LINE"))))
  (if (setq ss (ssget '((0 . "LINE"))))
    (progn
      (while (< (setq index (1+ index)) (sslength ss))
        (setq obj (vlax-ename->vla-object (ssname ss index))
              lyr (vla-get-layer obj)
              ept (vlax-get obj 'endpoint)
              spt (vlax-get obj 'startpoint)
              ang (angle spt ept)
              mpt (polar ept (angle ept spt) (/ (distance ept spt) 2.0))
        )
        (if (and (> ang (* 0.5 pi)) (< ang (* 1.5 pi)))
          (setq ang (+ ang pi))
        )
        (setq mpt (polar mpt (+ ang (/ pi 2.0)) (* (getvar 'dimscale) (getvar 'dimgap))))
        (if (zerop (setq txtht (getvar 'textsize)))
          (setq txtht 5)
        )
        (rjp-addtext mpt txtht lyr ang)
      )
    )
  )
  (princ)
)

I like

[Fatty]

You can try this also
This will be to label lines with fields

Code: [Select]

(defun C:llb (/ acsp   adoc     end_pt    line_ang
      mid_pt obj_field obj_id    ss       start_pt
      str_field txt_pt
     )
  (if (< (atoi (substr (getvar "acadver") 1 2)) 15)
    (progn
      (alert
"Programm wiil be works in\n
    AutoCAD 2000 and higher versions"
      )
      (exit)
      (princ)
    )
  )

  (or (vl-load-com))

  (defun *error* (msg)
    (princ msg)
    (vla-endundomark
      (vla-get-activedocument
(vlax-get-acad-object)
      )
    )
    (princ)
  )

  (or adoc
      (setq adoc (vla-get-activedocument
   (vlax-get-acad-object)
)
      )
  )
  (or acsp
      (setq acsp (if (= (getvar "CVPORT") 1)
   (vla-get-paperspace
     adoc
   )
   (vla-get-modelspace
     adoc
   )
)
      )
  )

  (vla-endundomark
    adoc
  )
  (vla-startundomark
    adoc
  )
  (setq ss (ssget (list (cons 0 "LINE"))))
  (vlax-for line_obj
     (vla-get-activeselectionset adoc)
    (setq obj_id    (vla-get-ObjectID line_obj)
  str_field (strcat "%<\\AcObjProp Object(%<\\_ObjId "
    (itoa obj_id)
    ">%).Layer>%"
    )
    )
    (setq start_pt (vlax-get line_obj 'Startpoint)
  end_pt   (vlax-get line_obj 'Endpoint)
  line_ang (angle start_pt end_pt)
  mid_pt   (mapcar (function (lambda (a b) (* (+ a b) 0.5)))
   start_pt
   end_pt
   )
    )
    (if (and (> line_ang (/ pi 2))
     (< line_ang (* pi 1.5))
)
      (setq line_ang (+ pi line_ang))
    )
    (setq txt_pt (polar mid_pt
(+ line_ang (/ pi 2.0))
(* (getvar "DIMTXT") 0.5)
)
    )
    (setq obj_field (vlax-invoke acsp 'AddMText txt_pt 0.0 str_field))
    (vlax-put obj_field 'Rotation line_ang)
    (vlax-put obj_field 'Layer (vlax-get line_obj 'Layer))
    (vlax-put obj_field 'Color 256)
  )
  (vla-regen adoc acactiveviewport)
  (*error* nil)
  (princ)
)
[code]

~'J'~[/code]

[ELOQUINTET]

hmmm hadn't looked in this thread since the new year and you guys have been busy. the main thing i need to acheive in this project at this point is to seperate the shade roll lines onto shade1 or shade2 layers accordingly. if you look in vba forum you can see where we left off. hmmm maybe i should look myself as someone may have posted something. i will review the other solutions posted here too thanks