Mark Object's Layer using Multileader

[harilalmn]

I want to mark layers of some elements in the drawing. I thought of using MLeader for this. I wrote some code in lisp but doesn't work. What am I doing wrong here?

 

(defun c:ObjLayer(/ pnt1 pnt2 n obj dxf LayerName newdxf)
 (setq n 1)
 (while (> n 0)
   (setq pnt1 (getpoint "\nPick first point:"))
   (setq pnt2 (getpoint pnt1 "\nPick next point:"))
   (setq obj (car (entsel "\nPick Entity:")))
   (setq dxf (entget obj))
   (setq LayerName (cdr (assoc 8 dxf)))
   (setq newdxf '((0 . "MULTILEADER")
	     (cons 110 (car pnt1)(cadr pnt1)(caddr pnt1))
	     (cons 10 (car pnt2)(cadr pnt2)(caddr pnt2))
	     (cons 304 LayerName)
	     (cons 8 "A-ANNO-DIMS")
	     ))
   (entmake newdxf)
   (setq n (1+ n))
 )
)

[Dadgad]

This is not nearly as sexy as the lisp solution which you are after, and it looks like you are getting close to what you are after. No doubt someone will jump in to sort out your lisp, but barring that, I have set up a multileader style, the text of which, includes a field. If you use it, you need to double click into the field, which will open the field definition box as shown. Once there you can push the button to prompt for object selection.

[Tharwat]

Old one of mine ...

 

(defun c:Test (/ spc p1 p2 str lead)
 (vl-load-com)
 ;; Tharwat 08. 07. 2011
 (cond ((not acdoc)
        (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
       )
 )
 (setq spc (if (> (vla-get-activespace acdoc) 0)
             (vla-get-modelspace acdoc)
             (vla-get-paperspace acdoc)
           )
 )
 (while
   (and
     (setq p1 (getpoint "\n specify First Point :"))
     (setq p2 (getpoint p1 "\n Specify Second point :"))
     (setq str
            (car (entsel "\n Specify any entity to get its Layer name :"))
     )
   )
    (progn
      (setq lead (vla-addmleader
                   spc
                   (vlax-make-variant
                     (vlax-safearray-fill
                       (safearray vlax-vbdouble '(0 . 5))
                       (apply 'append (list p1 p2))
                     )
                   )
                   0
                 )
      )
      (vla-put-textstring lead (cdr (assoc 8 (entget str))))
    )
 )
 (princ)
)

[harilalmn]

Excellent...!!! Tharwat..., Exactly what I wanted...!!!! thanks a lot...!!!

[harilalmn]

I knew this method of using field. But thought of not getting into the task of editing the text everytime. Well, Thanks for the support, Dadgad...

[harilalmn]

Tharwat, Is there a way to control the "Landing Distance" property?

[Lee Mac]

(apply 'append (list p1 p2))

 

(apply 'append (list '(a b c) '(d e f)))  =  (a b c d e f)  =  (append '(a b c) '(d e f))

[Lee Mac]

Another, using a Field:

 

[color=GREEN];; Object Layer in MLeader Field  -  Lee Mac  -  www.lee-mac.com[/color]

([color=BLUE]defun[/color] c:layerleader ( [color=BLUE]/[/color] _getpoints _objectid acdoc e l )

   ([color=BLUE]setq[/color] acdoc ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color])))

   ([color=BLUE]setq[/color] _getpoints
       ([color=BLUE]lambda[/color] ( [color=BLUE]/[/color] l p )
           ([color=BLUE]if[/color] ([color=BLUE]car[/color] ([color=BLUE]setq[/color] l ([color=BLUE]list[/color] ([color=BLUE]getpoint[/color] [color=MAROON]"\nFirst Point: "[/color]))))
               ([color=BLUE]while[/color] ([color=BLUE]setq[/color] p ([color=BLUE]getpoint[/color] [color=MAROON]"\nNext Point <Done>: "[/color] ([color=BLUE]car[/color] l)))
                   ([color=BLUE]mapcar[/color]
                      '([color=BLUE]lambda[/color] ( a b ) ([color=BLUE]grdraw[/color] a b 3 1))
                       ([color=BLUE]setq[/color] l ([color=BLUE]cons[/color] p l))
                       ([color=BLUE]cdr[/color] l)
                   )
               )
           )
           ([color=BLUE]redraw[/color]) ([color=BLUE]reverse[/color] l)
       )
   )

   ([color=BLUE]setq[/color] _objectid
       ([color=BLUE]eval[/color]
           ([color=BLUE]list[/color] '[color=BLUE]lambda[/color] '( obj )
               ([color=BLUE]if[/color]
                   ([color=BLUE]and[/color]
                       ([color=BLUE]vl-string-search[/color] [color=MAROON]"64"[/color] ([color=BLUE]getenv[/color] [color=MAROON]"PROCESSOR_ARCHITECTURE"[/color]))
                       ([color=BLUE]vlax-method-applicable-p[/color] ([color=BLUE]vla-get-utility[/color] acdoc) 'getobjectidstring)
                   )
                   ([color=BLUE]list[/color] '[color=BLUE]vla-getobjectidstring[/color] ([color=BLUE]vla-get-utility[/color] acdoc) 'obj '[color=BLUE]:vlax-false[/color])
                  '([color=BLUE]itoa[/color] ([color=BLUE]vla-get-objectid[/color] obj))
               )
           )
       )
   )

   ([color=BLUE]if[/color]
       ([color=BLUE]and[/color]
           ([color=BLUE]setq[/color] e ([color=BLUE]car[/color] ([color=BLUE]entsel[/color])))
           ([color=BLUE]<[/color] 1 ([color=BLUE]length[/color] ([color=BLUE]setq[/color] l (_getpoints))))
       )
       ([color=BLUE]vla-put-textstring[/color]
           ([color=BLUE]vlax-invoke[/color]
               ([color=BLUE]vlax-get-property[/color] acdoc ([color=BLUE]if[/color] ([color=BLUE]=[/color] 1 ([color=BLUE]getvar[/color] 'CVPORT)) 'paperspace 'modelspace))
               'addmleader
               ([color=BLUE]apply[/color] '[color=BLUE]append[/color] l) 0
           )
           ([color=BLUE]strcat[/color] [color=MAROON]"%<\\AcObjProp Object(%<\\_ObjId "[/color] (_objectid ([color=BLUE]vlax-ename->vla-object[/color] e)) [color=MAROON]">%).Layer>%"[/color])
       )
   )
   ([color=BLUE]vla-regen[/color] acdoc [color=BLUE]acactiveviewport[/color])
   ([color=BLUE]princ[/color])
)
([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

[johmmeke]

just found this great little thing, is it possible to pick multiple objects, and display the layers there on, and how many objects on that layer ...

think it's a pretty hard to do .. sorry .. just thinking how fantastic that would be

 

Greetz JOhn

[Tharwat]

just found this great little thing, is it possible to pick multiple objects, and display the layers there on, and how many objects on that layer ...

think it's a pretty hard to do .. sorry .. just thinking how fantastic that would be

 

Greetz JOhn

 

Try it now ...

 

(defun c:Test (/ spc p1 p2 str lead)
 (vl-load-com)
 ;; Tharwat 08. 07. 2011
 (cond ((not acdoc)
        (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
       )
 )
 (setq spc (if (> (vla-get-activespace acdoc) 0)
             (vla-get-modelspace acdoc)
             (vla-get-paperspace acdoc)
           )
 )
 (while
   (and
     (setq p1 (getpoint "\n specify First Point :"))
     (setq p2 (getpoint p1 "\n Specify Second point :"))
     (setq
       str (car
             (entsel "\n Specify any entity to get its Layer name :")
           )
     )
   )
    (progn
      (setq lead (vla-addmleader
                   spc
                   (vlax-make-variant
                     (vlax-safearray-fill
                       (safearray vlax-vbdouble '(0 . 5))
                       (apply 'append (list p1 p2))
                     )
                   )
                   0
                 )
      )
      (vla-put-textstring
        lead
        (strcat
          "Layer name = "
          (cdr (assoc 8 (entget str)))
          "\\P"
          "Number of Object(s) :"
          (itoa
            (sslength
              (ssget "_x" (list (cons 8 (cdr (assoc 8 (entget str))))))
            )
          )
        )
      )
    )
 )
 (princ)
)

[johmmeke]

Hey Tharwat

 

thanks for the more very quick replay ...

only i stil can only select one object .. are am i doing something wrong?

Greetz JOhn

[Tharwat]

only i stil can only select one object .. are am i doing something wrong?

 

Do you mean that you want to get the number of the selected objects ?

[johmmeke]

think i have not explane myself good ..

 

select multiple object ... output: all the layers the selected objects are on, and how many of the selected objects are on wich layer ...

vb layer layer:green -2

layer:blue -1

layer:red

 

is this a better example?

 

greetz JOhn

[johmmeke]

With a little copy and paste and some trial and error i have come this far.

but getting a error at the end to put the string

 

i left the original code in there tot help me

 

i'm not that great with lisp, just learning

 

 

(defun c:lala (/ spc p1 p2 str lead)
 (vl-load-com)
 ;; Tharwat 08. 07. 2011
 (cond ((not acdoc)
        (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
       )
 )
 (setq spc (if (> (vla-get-activespace acdoc) 0)
             (vla-get-modelspace acdoc)
             (vla-get-paperspace acdoc)
           )
 )
 (while
   (and
     (setq p1 (getpoint "\n specify First Point :"))
     (setq p2 (getpoint p1 "\n Specify Second point :"))
;      (setq str lst)
;;;
;;;            (car (entsel "\n Specify any entity to get its Layer name :"))
;;;


(setq ss (ssget))
 (progn
   (repeat (setq i (sslength ss))
     (setq layer (cdr (assoc 8 (entget (ssname ss (setq i (1- i)))))))
     (if (not (member layer lst)) (setq lst (cons layer lst)))
   )
   (setq lst (acad_strlsort lst))
 )


(setq str lst)
;;;
     
   )
    (progn
      (setq lead (vla-addmleader
                   spc
                   (vlax-make-variant
                     (vlax-safearray-fill
                       (safearray vlax-vbdouble '(0 . 5))
                       (apply 'append (list p1 p2))
                     )
                   )
                   0
                 )
      )
      (vla-put-textstring lead (cdr (assoc 8 (entget str))))
    )
 )
 (princ)
)