Topic: Lisp to read attribute and draw mleader with leader style

[linktf]

I'm looking to draw a mleader (with a leader style CLL_Anno) using the block basepoint as insertion point, read two attributes from that block and use those as the text for the mleader. for example: "attribute - attribute". Attached is dwg with blocks with attributes and leader style. (Block is "Trees", Attributes are "V_SPECIES" "V_DBH_DIM")
Please Help!
Thanks!

[ronjonp]

Heading out for the day but this should get you started .. welcome to TheSwamp.

Code: [Select]

(defun c:foo (/ _getatt e o p1 p2)
  (defun _getatt (block tag / att result)
    (foreach att (vlax-invoke block 'getattributes)
      (if (eq (strcase tag) (strcase (vla-get-tagstring att)))
(progn (setq result (vla-get-textstring att)))
      )
    )
    result
  )
  (if (and (setq e (car (entsel "\nSelect block: ")))
   (setq p1 (cdr (assoc 10 (entget e))))
   (setq p2 (getpoint (trans p1 0 1) "\nSpecify leader arrowhead location: "))
      )
    (progn (setq o (vlax-ename->vla-object e))
   (command "._mleader"
    (trans p1 0 1)
    p2
    (strcat (_getatt o "V_SPECIES") " - " (_getatt o "V_DBH_DIM"))
   )
    )
  )
  (princ)
)

[WILL HATCH]

My first lisp woot! (by first I really mean I gripped it all from someone else basically....)
Creates a field so your changes will just reflect

Code - Auto/Visual Lisp: [Select]

1. ;Started by ronjonp: http://www.theswamp.org/index.php?topic=45573.msg507273#msg507273
2. (defun c:foo (/ _getatt e o p1 p2)
3. ;modded to return ObjectId:
4.   (defun _getatt (block tag / att result)
5.     (foreach att (vlax-invoke block 'getattributes)
6.       (if (eq (strcase tag) (strcase (vla-get-tagstring att)))
7.         (setq result (Get-ObjectIDx64 att))
8.       )
9.     )
10.     result
11.   )
12.   (if (and (setq e (car (entsel "\nSelect block: ")))
13.            (setq p1 (cdr (assoc 10 (entget e))))
14.            (setq p2 (getpoint (trans p1 0 1) "\nSpecify leader arrowhead location: "))
15.       )
16.     (progn (setq o (vlax-ename->vla-object e))
17.            (command "._mleader"
18.                     (trans p1 0 1)
19.                     p2
20. ;modded to insert a field instead:
21.                     (strcat
22.                         "%<\\AcObjProp Object(%<\\_ObjId "
23.                         (_getatt o "V_SPECIES")
24.                         ">%).TextString>%"
25.                         " - "
26.                         "%<\\AcObjProp Object(%<\\_ObjId "
27.                         (_getatt o "V_DBH_DIM")
28.                         ">%).TextString>%"
29.                         )
30.            )
31.     )
32.   )
33.   (princ)
34. )
35.  
36.  
37. ;taken from: http://www.jtbworld.com/lisp/AreaText.htm
38.  
39. (defun Get-ObjectIDx64 (obj / util)
40.   (setq util (vla-get-Utility (vla-get-activedocument (vlax-get-acad-object))))
41.   (if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj)))
42.   (if (= (type obj) 'VLA-OBJECT)
43.     (if (> (vl-string-search "x64" (getvar "platform")) 0)
44.       (vlax-invoke-method util "GetObjectIdString" obj :vlax-False)
45.       (rtos (vla-get-objectid obj) 2 0)
46.     )
47.   )
48. )

[Lee Mac]

Good idea to use fields Will! 

Here is my version of the program:

Code - Auto/Visual Lisp: [Select]

1. (defun c:mlb ( / at1 at2 ent enx ins lst mld pnt )
2.     (while
3.         (progn
4.             (setvar 'errno 0)
5.             (setq ent (car (entsel "\nSelect block <exit>: ")))
6.             (cond
7.                 (   (= 7 (getvar 'errno))
8.                     (princ "\nMissed, try again.")
9.                 )
10.                 (   (null ent)
11.                     nil
12.                 )
13.                 (   (/= "INSERT" (cdr (assoc 0 (setq enx (entget ent)))))
14.                     (princ "\nObject is not a block.")
15.                 )
16.                 (   (/= 1 (cdr (assoc 66 enx)))
17.                     (princ "\nBlock is not attributed.")
18.                 )
19.                 (   (not
20.                         (and
21.                             (setq lst (vlax-invoke (vlax-ename->vla-object ent) 'getattributes)
22.                                   lst (mapcar '(lambda ( x ) (cons (strcase (vla-get-tagstring x)) x)) lst)
23.                             )
24.                             (setq at1 (cdr (assoc "V_SPECIES" lst)))
25.                             (setq at2 (cdr (assoc "V_DBH_DIM" lst)))
26.                         )
27.                     )
28.                     (princ "\nBlock does not contain \"V_SPECIES\" & \"V_DBH_DIM\" attributes.")
29.                 )
30.                 (   (setq ins (cdr (assoc 10 enx))
31.                           pnt (getpoint (trans ins ent 1) "\nPick leader endpoint <exit>: ")
32.                     )
33.                     (setq mld
34.                         (vlax-invoke
35.                             (vlax-get-property (LM:acdoc)
36.                                 (if (= 1 (getvar 'cvport))
37.                                     'paperspace
38.                                     'modelspace
39.                                 )
40.                             )
41.                             'addmleader
42.                             (append (trans ins ent 0) (trans pnt 1 0))
43.                             0
44.                         )
45.                     )
46.                     (vla-put-textstring mld
47.                         (strcat
48.                             "%<\\AcObjProp Object(%<\\_ObjId "
49.                             (LM:ObjectID at1)
50.                             ">%).TextString>% - %<\\AcObjProp Object(%<\\_ObjId "
51.                             (LM:ObjectID at2)
52.                             ">%).TextString>%"
53.                         )
54.                     )
55.                     (vla-put-textrotation mld 0.0)
56.                     (if (<= (car pnt) (car (trans ins ent 1)))
57.                         (progn
58.                             (vla-setdoglegdirection mld 0 (vlax-3D-point (trans '(-1.0 0.0) 1 0 t)))
59.                             (vlax-invoke mld 'setleaderlinevertices 0 (append (trans ins ent 0) (trans pnt 1 0)))
60.                         )
61.                         (vla-setdoglegdirection mld 0 (vlax-3D-point (trans '(1.0 0.0) 1 0 t)))
62.                     )
63.                     (vla-regen (LM:acdoc) acactiveviewport)
64.                     t
65.                 )
66.             )
67.         )
68.     )
69.     (princ)
70. )
71.    
72. ;; ObjectID  -  Lee Mac
73. ;; Returns a string containing the ObjectID of a supplied VLA-Object
74. ;; Compatible with 32-bit & 64-bit systems
75.  
76. (defun LM:ObjectID ( obj )
77.     (eval
78.         (list 'defun 'LM:ObjectID '( obj )
79.             (if
80.                 (and
81.                     (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
82.                     (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
83.                 )
84.                 (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
85.                '(itoa (vla-get-objectid obj))
86.             )
87.         )
88.     )
89.     (LM:ObjectID obj)
90. )
91.  
92. ;; Active Document  -  Lee Mac
93. ;; Returns the VLA Active Document Object
94.  
95. (defun LM:acdoc nil
96.     (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
97.     (LM:acdoc)
98. )
99.  
100. (vl-load-com) (princ)

The above should also work in all UCS & Views.

[WILL HATCH]

Very nice Lee! I stand in awe of your ability to work within the bounds of this syntax.
I can't read lisp and understand much... It's so cryptic

[Lee Mac]

That's very kind of you to say Will, thanks 
Of course, if you have any questions about my code, I'd be happy to explain.

[linktf]

 :kewl: THIS IS AWESOME!  Thank you all so much. Lee, we have been chasing eachother around on multiple boards. Thanks for helping me, going to save me tons of time. I have learned a lot about lisp routines and coding this last week. One more question. If i wanted to replace the dash with an add new line, to make it a multline text leader, how would i change the code?

Thanks again!

[Lee Mac]

:kewl: THIS IS AWESOME!  Thank you all so much. Lee, we have been chasing eachother around on multiple boards. Thanks for helping me, going to save me tons of time. I have learned a lot about lisp routines and coding this last week.

You're most welcome 
I have included a link in your thread at ADG to this one to help others with a similar requirement.

One more question. If i wanted to replace the dash with an add new line, to make it a multline text leader, how would i change the code?

Change:

Code - Auto/Visual Lisp: [Select]

50. ">%).TextString>% - %<\\AcObjProp Object(%<\\_ObjId "

to:

Code - Auto/Visual Lisp: [Select]

50. ">%).TextString>%\n%<\\AcObjProp Object(%<\\_ObjId "

[linktf]

I just noticed a problem with using fields. When the mleader is drawn, the right attachment does not line up with the end of the text. It seems to want to line up with the Field definition. Is there a way to fix this?

[Lee Mac]

I just noticed a problem with using fields. When the mleader is drawn, the right attachment does not line up with the end of the text. It seems to want to line up with the Field definition. Is there a way to fix this?

Is the right attachment option set correctly in your MLeader Style?

[linktf]

It is, then I changed the settings to something else and then back again, saved and restarted AutoCAD and now they are magically working. Silly AutoCAD! 

[linktf]

What if the one of the attributes had no data. Can't draw leader, can it be changed to only insert the one attribute?

[linktf]

Lee, I tried to modify the lisp code to use for other kinds of blocks with different attribute definitions but am having a problem, it worked fine from the start but when I save and close then re-open, the leaders i used the code below on show hash-tags (ie. ###############). any clue?




(defun c:mlb_Interpretation ( / at1 at2 ent enx ins lst mld pnt )
    (while
        (progn
            (setvar 'errno 0)
            (setq ent (car (entsel "\nSelect block <exit>: ")))
            (cond
                (   (= 7 (getvar 'errno))
                    (princ "\nMissed, try again.")
                )
                (   (null ent)
                    nil
                )
                (   (/= "INSERT" (cdr (assoc 0 (setq enx (entget ent)))))
                    (princ "\nObject is not a block.")
                )
                (   (/= 1 (cdr (assoc 66 enx)))
                    (princ "\nBlock is not attributed.")
                )
                (   (not
                        (and
                            (setq lst (vlax-invoke (vlax-ename->vla-object ent) 'getattributes)
                                  lst (mapcar '(lambda ( x ) (cons (strcase (vla-get-tagstring x)) x)) lst)
                            )
                            (setq at1 (cdr (assoc "LAND_FEAT" lst)))
                            (setq at2 (cdr (assoc "COMMENTS" lst)))
                        )
                    )
                    (princ "\nBlock does not contain \"LAND_FEAT\" & \"COMMENTS\" attributes.")
                )
                (   (setq ins (cdr (assoc 10 enx))
                          pnt (getpoint (trans ins ent 1) "\nPick leader endpoint <exit>: ")
                    )
                    (setq mld
                        (vlax-invoke
                            (vlax-get-property (LM:acdoc)
                                (if (= 1 (getvar 'cvport))
                                    'paperspace
                                    'modelspace
                                )
                            )
                            'addmleader
                            (append (trans ins ent 0) (trans pnt 1 0))
                            0
                        )
                    )
                    (vla-put-textstring mld
                        (strcat
                            "%<\\AcObjProp Object(%<\\_ObjId "
                            (LM:ObjectID at1)
                            ">%).TextString>%\n%<\\AcObjProp Object(%<\\_ObjId "
                            (LM:ObjectID at2)
                            ">%).TextString>%"
                        )
                    )
                    (vla-put-textrotation mld 0.0)
                    (if (<= (car pnt) (car (trans ins ent 1)))
                        (progn
                            (vla-setdoglegdirection mld 0 (vlax-3D-point (trans '(-1.0 0.0) 1 0 t)))
                            (vlax-invoke mld 'setleaderlinevertices 0 (append (trans ins ent 0) (trans pnt 1 0)))
                        )
                        (vla-setdoglegdirection mld 0 (vlax-3D-point (trans '(1.0 0.0) 1 0 t)))
                    )
                    (vla-regen (LM:acdoc) acactiveviewport)
                    t
                )
            )
        )
    )
    (princ)
)
 
;; ObjectID  -  Lee Mac
;; Returns a string containing the ObjectID of a supplied VLA-Object
;; Compatible with 32-bit & 64-bit systems
 
(defun LM:ObjectID ( obj )
    (eval
        (list 'defun 'LM:ObjectID '( obj )
            (if
                (and
                    (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
                    (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
                )
                (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
               '(itoa (vla-get-objectid obj))
            )
        )
    )
    (LM:ObjectID obj)
)
 
;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object
 
(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)
 
(vl-load-com) (princ)

[Lee Mac]

What if the one of the attributes had no data. Can't draw leader, can it be changed to only insert the one attribute?

Try the following modified program:

Code - Auto/Visual Lisp: [Select]

1. (defun c:mlb2 ( / at1 at2 ent enx ins lst mld pnt )
2.     (while
3.         (progn
4.             (setvar 'errno 0)
5.             (setq ent (car (entsel "\nSelect block <exit>: ")))
6.             (cond
7.                 (   (= 7 (getvar 'errno))
8.                     (princ "\nMissed, try again.")
9.                 )
10.                 (   (null ent)
11.                     nil
12.                 )
13.                 (   (/= "INSERT" (cdr (assoc 0 (setq enx (entget ent)))))
14.                     (princ "\nObject is not a block.")
15.                 )
16.                 (   (/= 1 (cdr (assoc 66 enx)))
17.                     (princ "\nBlock is not attributed.")
18.                 )
19.                 (   (not
20.                         (and
21.                             (setq lst (vlax-invoke (vlax-ename->vla-object ent) 'getattributes)
22.                                   lst (mapcar '(lambda ( x ) (cons (strcase (vla-get-tagstring x)) x)) lst)
23.                             )
24.                             (setq at1 (cdr (assoc "LAND_FEAT" lst)))
25.                             (setq at2 (cdr (assoc "COMMENTS"  lst)))
26.                         )
27.                     )
28.                     (princ "\nBlock does not contain \"LAND_FEAT\" & \"COMMENTS\" attributes.")
29.                 )
30.                 (   (and
31.                         (= "" (vla-get-textstring at1))
32.                         (= "" (vla-get-textstring at2))
33.                     )
34.                     (princ "\nBoth attributes are empty.")
35.                 )
36.                 (   (setq ins (cdr (assoc 10 enx))
37.                           pnt (getpoint (trans ins ent 1) "\nPick leader endpoint <exit>: ")
38.                     )
39.                     (setq mld
40.                         (vlax-invoke
41.                             (vlax-get-property (LM:acdoc)
42.                                 (if (= 1 (getvar 'cvport))
43.                                     'paperspace
44.                                     'modelspace
45.                                 )
46.                             )
47.                             'addmleader
48.                             (append (trans ins ent 0) (trans pnt 1 0))
49.                             0
50.                         )
51.                     )
52.                     (vla-put-textstring mld
53.                         (strcat
54.                             (if (= "" (vla-get-textstring at1))
55.                                 ""
56.                                 (strcat
57.                                     "%<\\AcObjProp Object(%<\\_ObjId "
58.                                     (LM:ObjectID at1)
59.                                     ">%).TextString>%"
60.                                     (if (= "" (vla-get-textstring at2)) "" "\n")
61.                                 )
62.                             )
63.                             (if (= "" (vla-get-textstring at2))
64.                                 ""
65.                                 (strcat
66.                                     "%<\\AcObjProp Object(%<\\_ObjId "
67.                                     (LM:ObjectID at2)
68.                                     ">%).TextString>%"
69.                                 )
70.                             )
71.                         )
72.                     )
73.                     (vla-put-textrotation mld 0.0)
74.                     (if (<= (car pnt) (car (trans ins ent 1)))
75.                         (progn
76.                             (vla-setdoglegdirection mld 0 (vlax-3D-point (trans '(-1.0 0.0) 1 0 t)))
77.                             (vlax-invoke mld 'setleaderlinevertices 0 (append (trans ins ent 0) (trans pnt 1 0)))
78.                         )
79.                         (vla-setdoglegdirection mld 0 (vlax-3D-point (trans '(1.0 0.0) 1 0 t)))
80.                     )
81.                     (vla-regen (LM:acdoc) acactiveviewport)
82.                     t
83.                 )
84.             )
85.         )
86.     )
87.     (princ)
88. )
89.  
90. ;; ObjectID  -  Lee Mac
91. ;; Returns a string containing the ObjectID of a supplied VLA-Object
92. ;; Compatible with 32-bit & 64-bit systems
93.  
94. (defun LM:ObjectID ( obj )
95.     (eval
96.         (list 'defun 'LM:ObjectID '( obj )
97.             (if
98.                 (and
99.                     (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
100.                     (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
101.                 )
102.                 (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
103.                '(itoa (vla-get-objectid obj))
104.             )
105.         )
106.     )
107.     (LM:ObjectID obj)
108. )
109.  
110. ;; Active Document  -  Lee Mac
111. ;; Returns the VLA Active Document Object
112.  
113. (defun LM:acdoc nil
114.     (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
115.     (LM:acdoc)
116. )
117.  
118. (vl-load-com) (princ)

Lee, I tried to modify the lisp code to use for other kinds of blocks with different attribute definitions but am having a problem, it worked fine from the start but when I save and close then re-open, the leaders i used the code below on show hash-tags (ie. ###############). any clue?

Perhaps a REGEN is required?
The program appears to perform successfully in my testing.


[ PS: Formatting code in your posts... ]

[linktf]

still getting ############, even after re-running new mlb2

[Lee Mac]

still getting ############, even after re-running new mlb2

Could you post the drawing?

[linktf]

Yup, here it is. It's also taking an inordinate amount of time to save. btw, I work for a university so that why the education stamp pops up.


<DWG w/ EDU Stamp removed>

[Lee Mac]

Non Autodesk DWG.  This DWG file was saved by a software application that was not developed or licensed by Autodesk.  Autodesk cannot guarantee the application compatibility or integrity of this file.

What software are you using?

[linktf]

AutoCAD 2013 Educational

So i created two lisps. one with a set of two attributes, and another with a different set of attributes in the code. both are attached. one set works fine, but the other one seems to be doing something wonky.

[Lee Mac]

It's also taking an inordinate amount of time to save.

Here are the results of the AUDIT command:

Auditing Header
Auditing Tables
Layout Dictionary Entry BTR doesn't point back Deleted
Auditing Entities Pass 1
Pass 1 27900   objects audited
Invalid number as X coordinate in object.
  Set to           0.000000.
Invalid number as Y coordinate in object.
  Set to           0.000000.
Pass 1 28000   objects audited
Invalid number as X coordinate in object.
  Set to           0.000000.
Invalid number as Y coordinate in object.
  Set to           0.000000.
Pass 1 180800  objects audited
Auditing Entities Pass 2
AcDbLayout(59)
Placing Layout1 in ACAD_LAYOUT dictionary
Pass 2 180800  objects audited
Auditing Blocks
 26      Blocks audited
Auditing AcDsRecords
Total errors found 4 fixed 4
Erased 0 objects

[Lee Mac]

still getting ############, even after re-running new mlb2

MLB2 performs fine for me with your posted drawing.

[linktf]

well maybe its this stupid education version!

[linktf]

This ####### problem has come back to haunt me. I have found out that the MLB2 works totally fine until I save the file and quit autocad. The next time I open the dwg, it has "########" instead of the attributes in the multleaders? not sure why? Here is the code i've modified and am using.

Code - Auto/Visual Lisp: [Select]

1. (defun c:mlb2_SSF ( / at1 at2 ent enx ins lst mld pnt )
2.     (while
3.         (progn
4.             (setvar 'errno 0)
5.             (setq ent (car (entsel "\nSelect block <exit>: ")))
6.             (cond
7.                 (   (= 7 (getvar 'errno))
8.                     (princ "\nMissed, try again.")
9.                 )
10.                 (   (null ent)
11.                     nil
12.                 )
13.                 (   (/= "INSERT" (cdr (assoc 0 (setq enx (entget ent)))))
14.                     (princ "\nObject is not a block.")
15.                 )
16.                 (   (/= 1 (cdr (assoc 66 enx)))
17.                     (princ "\nBlock is not attributed.")
18.                 )
19.                 (   (not
20.                         (and
21.                             (setq lst (vlax-invoke (vlax-ename->vla-object ent) 'getattributes)
22.                                   lst (mapcar '(lambda ( x ) (cons (strcase (vla-get-tagstring x)) x)) lst)
23.                             )
24.                             (setq at1 (cdr (assoc "LAND_FEAT" lst)))
25.                             (setq at2 (cdr (assoc "COMMENTS"  lst)))
26.                         )
27.                     )
28.                     (princ "\nBlock does not contain \"LAND_FEAT\" & \"COMMENTS\" attributes.")
29.                 )
30.                 (   (and
31.                         (= "" (vla-get-textstring at1))
32.                         (= "" (vla-get-textstring at2))
33.                     )
34.                     (princ "\nBoth attributes are empty.")
35.                 )
36.                 (   (setq ins (cdr (assoc 10 enx))
37.                           pnt (getpoint (trans ins ent 1) "\nPick leader endpoint <exit>: ")
38.                     )
39.                     (setq mld
40.                         (vlax-invoke
41.                             (vlax-get-property (LM:acdoc)
42.                                 (if (= 1 (getvar 'cvport))
43.                                     'paperspace
44.                                     'modelspace
45.                                 )
46.                             )
47.                             'addmleader
48.                             (append (trans ins ent 0) (trans pnt 1 0))
49.                             0
50.                         )
51.                     )
52.                     (vla-put-textstring mld
53.                         (strcat
54.                             (if (= "" (vla-get-textstring at1))
55.                                 ""
56.                                 (strcat
57.                                     "%<\\AcObjProp Object(%<\\_ObjId "
58.                                     (LM:ObjectID at1)
59.                                     ">%).TextString>%"
60.                                     (if (= "" (vla-get-textstring at2)) "" "\n")
61.                                 )
62.                             )
63.                             (if (= "" (vla-get-textstring at2))
64.                                 ""
65.                                 (strcat
66.                                     "%<\\AcObjProp Object(%<\\_ObjId "
67.                                     (LM:ObjectID at2)
68.                                     ">%).TextString>%"
69.                                 )
70.                             )
71.                         )
72.                     )
73.                     (vla-put-textrotation mld 0.0)
74.                     (if (<= (car pnt) (car (trans ins ent 1)))
75.                         (progn
76.                             (vla-setdoglegdirection mld 0 (vlax-3D-point (trans '(-1.0 0.0) 1 0 t)))
77.                             (vlax-invoke mld 'setleaderlinevertices 0 (append (trans ins ent 0) (trans pnt 1 0)))
78.                         )
79.                         (vla-setdoglegdirection mld 0 (vlax-3D-point (trans '(1.0 0.0) 1 0 t)))
80.                     )
81.                     (vla-regen (LM:acdoc) acactiveviewport)
82.                     t
83.                 )
84.             )
85.         )
86.     )
87.     (princ)
88. )
89.  
90. ;; ObjectID  -  Lee Mac
91. ;; Returns a string containing the ObjectID of a supplied VLA-Object
92. ;; Compatible with 32-bit & 64-bit systems
93.  
94. (defun LM:ObjectID ( obj )
95.     (eval
96.         (list 'defun 'LM:ObjectID '( obj )
97.             (if
98.                 (and
99.                     (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
100.                     (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
101.                 )
102.                 (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
103.                '(itoa (vla-get-objectid obj))
104.             )
105.         )
106.     )
107.     (LM:ObjectID obj)
108. )
109.  
110. ;; Active Document  -  Lee Mac
111. ;; Returns the VLA Active Document Object
112.  
113. (defun LM:acdoc nil
114.     (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
115.     (LM:acdoc)
116. )
117.  
118. (vl-load-com) (princ)

[linktf]

Might be because i am using two different version of this programs. I only modified line 24-25, the attribute field, and nothing else and maybe its isn't using the fields correctly or its trying to use the same fields? I'm not too sure exactly how fields work yet. Thanks all.

[nirav]

Hi all,

My name is Nirav and I am new to the swamp. I am a cad engineer (Mechanical) and mostly involved in 3D applications. At the moment, I am working on Autocad for some drawing requirements. I am totally new to visual lisp, so I am looking for some help and guidance. I want to make a lisp which would work exactly like multileader command. The only difference is that it will show any one object attribute (either TAG or PROMPT) instead of multitext. I have worked on Inventor with visual basic codes and have no idea about visual lisp.

Can anybody help me on this?
Well, I have tried to use sample codes off this forum but none of them seem to be working for me.

Thanks in advance.

Cheers,
Nirav

[migs_619]

Hello Lee,

I found this routine very useful. Just one tweak to make the Z placement of mleader to be the same as the block, my blocks have different elevations and it will make it more eye pleasing if the mleaders are together with the block. Can you help me please

[Lee Mac]

I found this routine very useful. Just one tweak to make the Z placement of mleader to be the same as the block, my blocks have different elevations and it will make it more eye pleasing if the mleaders are together with the block. Can you help me please

I'm glad that you found the program useful. 

I have found that supplying the ActiveX addmleader method with leader coordinates with non-zero z-component has no effect on the elevation of the resultant MLeader, and that the MLeader must be separately moved to the appropriate elevation - this is perhaps a bug with the addmleader method.

Please try the following:

Code - Auto/Visual Lisp: [Select]

1. (defun c:mlb2 ( / at1 at2 ent enx ins lst mld pnt )
2.     (while
3.         (progn
4.             (setvar 'errno 0)
5.             (setq ent (car (entsel "\nSelect block <exit>: ")))
6.             (cond
7.                 (   (= 7 (getvar 'errno))
8.                     (princ "\nMissed, try again.")
9.                 )
10.                 (   (null ent)
11.                     nil
12.                 )
13.                 (   (/= "INSERT" (cdr (assoc 0 (setq enx (entget ent)))))
14.                     (princ "\nObject is not a block.")
15.                 )
16.                 (   (/= 1 (cdr (assoc 66 enx)))
17.                     (princ "\nBlock is not attributed.")
18.                 )
19.                 (   (not
20.                         (and
21.                             (setq lst (vlax-invoke (vlax-ename->vla-object ent) 'getattributes)
22.                                   lst (mapcar '(lambda ( x ) (cons (strcase (vla-get-tagstring x)) x)) lst)
23.                             )
24.                             (setq at1 (cdr (assoc "LAND_FEAT" lst)))
25.                             (setq at2 (cdr (assoc "COMMENTS"  lst)))
26.                         )
27.                     )
28.                     (princ "\nBlock does not contain \"LAND_FEAT\" & \"COMMENTS\" attributes.")
29.                 )
30.                 (   (and
31.                         (= "" (vla-get-textstring at1))
32.                         (= "" (vla-get-textstring at2))
33.                     )
34.                     (princ "\nBoth attributes are empty.")
35.                 )
36.                 (   (setq ins (cdr (assoc 10 enx))
37.                           pnt (getpoint (trans ins ent 1) "\nPick leader endpoint <exit>: ")
38.                     )
39.                     (setq mld
40.                         (vlax-invoke
41.                             (vlax-get-property (LM:acdoc)
42.                                 (if (= 1 (getvar 'cvport))
43.                                     'paperspace
44.                                     'modelspace
45.                                 )
46.                             )
47.                             'addmleader
48.                             (append (trans ins ent 0) (trans pnt 1 0))
49.                             0
50.                         )
51.                     )
52.                     (vla-move mld
53.                         (vlax-3D-point 0 0 (caddr (vlax-invoke mld 'getleaderlinevertices 0)))
54.                         (vlax-3D-point 0 0 (caddr (trans ins ent 0)))
55.                     )
56.                     (vla-put-textstring mld
57.                         (strcat
58.                             (if (= "" (vla-get-textstring at1))
59.                                 ""
60.                                 (strcat
61.                                     "%<\\AcObjProp Object(%<\\_ObjId "
62.                                     (LM:ObjectID at1)
63.                                     ">%).TextString>%"
64.                                     (if (= "" (vla-get-textstring at2)) "" "\n")
65.                                 )
66.                             )
67.                             (if (= "" (vla-get-textstring at2))
68.                                 ""
69.                                 (strcat
70.                                     "%<\\AcObjProp Object(%<\\_ObjId "
71.                                     (LM:ObjectID at2)
72.                                     ">%).TextString>%"
73.                                 )
74.                             )
75.                         )
76.                     )
77.                     (vla-put-textrotation mld 0.0)
78.                     (if (<= (car pnt) (car (trans ins ent 1)))
79.                         (progn
80.                             (vla-setdoglegdirection mld 0 (vlax-3D-point (trans '(-1.0 0.0) 1 0 t)))
81.                             (vlax-invoke mld 'setleaderlinevertices 0 (append (trans ins ent 0) (trans pnt 1 0)))
82.                         )
83.                         (vla-setdoglegdirection mld 0 (vlax-3D-point (trans '(1.0 0.0) 1 0 t)))
84.                     )
85.                     (vla-regen (LM:acdoc) acactiveviewport)
86.                     t
87.                 )
88.             )
89.         )
90.     )
91.     (princ)
92. )
93.  
94. ;; ObjectID  -  Lee Mac
95. ;; Returns a string containing the ObjectID of a supplied VLA-Object
96. ;; Compatible with 32-bit & 64-bit systems
97.  
98. (defun LM:ObjectID ( obj )
99.     (eval
100.         (list 'defun 'LM:ObjectID '( obj )
101.             (if
102.                 (and
103.                     (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
104.                     (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
105.                 )
106.                 (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
107.                '(itoa (vla-get-objectid obj))
108.             )
109.         )
110.     )
111.     (LM:ObjectID obj)
112. )
113.  
114. ;; Active Document  -  Lee Mac
115. ;; Returns the VLA Active Document Object
116.  
117. (defun LM:acdoc nil
118.     (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
119.     (LM:acdoc)
120. )
121.  
122. (vl-load-com) (princ)

[jtm2020hyo]

I found this routine very useful. Just one tweak to make the Z placement of mleader to be the same as the block, my blocks have different elevations and it will make it more eye pleasing if the mleaders are together with the block. Can you help me please

I'm glad that you found the program useful. 

I have found that supplying the ActiveX addmleader method with leader coordinates with non-zero z-component has no effect on the elevation of the resultant MLeader, and that the MLeader must be separately moved to the appropriate elevation - this is perhaps a bug with the addmleader method.

Please try the following:

Code - Auto/Visual Lisp: [Select]

1. (defun c:mlb2 ( / at1 at2 ent enx ins lst mld pnt )
2.     (while
3.         (progn
4.             (setvar 'errno 0)
5.             (setq ent (car (entsel "\nSelect block <exit>: ")))
6.             (cond
7.                 (   (= 7 (getvar 'errno))
8.                     (princ "\nMissed, try again.")
9.                 )
10.                 (   (null ent)
11.                     nil
12.                 )
13.                 (   (/= "INSERT" (cdr (assoc 0 (setq enx (entget ent)))))
14.                     (princ "\nObject is not a block.")
15.                 )
16.                 (   (/= 1 (cdr (assoc 66 enx)))
17.                     (princ "\nBlock is not attributed.")
18.                 )
19.                 (   (not
20.                         (and
21.                             (setq lst (vlax-invoke (vlax-ename->vla-object ent) 'getattributes)
22.                                   lst (mapcar '(lambda ( x ) (cons (strcase (vla-get-tagstring x)) x)) lst)
23.                             )
24.                             (setq at1 (cdr (assoc "LAND_FEAT" lst)))
25.                             (setq at2 (cdr (assoc "COMMENTS"  lst)))
26.                         )
27.                     )
28.                     (princ "\nBlock does not contain \"LAND_FEAT\" & \"COMMENTS\" attributes.")
29.                 )
30.                 (   (and
31.                         (= "" (vla-get-textstring at1))
32.                         (= "" (vla-get-textstring at2))
33.                     )
34.                     (princ "\nBoth attributes are empty.")
35.                 )
36.                 (   (setq ins (cdr (assoc 10 enx))
37.                           pnt (getpoint (trans ins ent 1) "\nPick leader endpoint <exit>: ")
38.                     )
39.                     (setq mld
40.                         (vlax-invoke
41.                             (vlax-get-property (LM:acdoc)
42.                                 (if (= 1 (getvar 'cvport))
43.                                     'paperspace
44.                                     'modelspace
45.                                 )
46.                             )
47.                             'addmleader
48.                             (append (trans ins ent 0) (trans pnt 1 0))
49.                             0
50.                         )
51.                     )
52.                     (vla-move mld
53.                         (vlax-3D-point 0 0 (caddr (vlax-invoke mld 'getleaderlinevertices 0)))
54.                         (vlax-3D-point 0 0 (caddr (trans ins ent 0)))
55.                     )
56.                     (vla-put-textstring mld
57.                         (strcat
58.                             (if (= "" (vla-get-textstring at1))
59.                                 ""
60.                                 (strcat
61.                                     "%<\\AcObjProp Object(%<\\_ObjId "
62.                                     (LM:ObjectID at1)
63.                                     ">%).TextString>%"
64.                                     (if (= "" (vla-get-textstring at2)) "" "\n")
65.                                 )
66.                             )
67.                             (if (= "" (vla-get-textstring at2))
68.                                 ""
69.                                 (strcat
70.                                     "%<\\AcObjProp Object(%<\\_ObjId "
71.                                     (LM:ObjectID at2)
72.                                     ">%).TextString>%"
73.                                 )
74.                             )
75.                         )
76.                     )
77.                     (vla-put-textrotation mld 0.0)
78.                     (if (<= (car pnt) (car (trans ins ent 1)))
79.                         (progn
80.                             (vla-setdoglegdirection mld 0 (vlax-3D-point (trans '(-1.0 0.0) 1 0 t)))
81.                             (vlax-invoke mld 'setleaderlinevertices 0 (append (trans ins ent 0) (trans pnt 1 0)))
82.                         )
83.                         (vla-setdoglegdirection mld 0 (vlax-3D-point (trans '(1.0 0.0) 1 0 t)))
84.                     )
85.                     (vla-regen (LM:acdoc) acactiveviewport)
86.                     t
87.                 )
88.             )
89.         )
90.     )
91.     (princ)
92. )
93.  
94. ;; ObjectID  -  Lee Mac
95. ;; Returns a string containing the ObjectID of a supplied VLA-Object
96. ;; Compatible with 32-bit & 64-bit systems
97.  
98. (defun LM:ObjectID ( obj )
99.     (eval
100.         (list 'defun 'LM:ObjectID '( obj )
101.             (if
102.                 (and
103.                     (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
104.                     (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
105.                 )
106.                 (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
107.                '(itoa (vla-get-objectid obj))
108.             )
109.         )
110.     )
111.     (LM:ObjectID obj)
112. )
113.  
114. ;; Active Document  -  Lee Mac
115. ;; Returns the VLA Active Document Object
116.  
117. (defun LM:acdoc nil
118.     (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
119.     (LM:acdoc)
120. )
121.  
122. (vl-load-com) (princ)

it is possible to edit the lisp to work with multiple selected dynamic blocks and all attributes inside?, the mleader should repeat the position in of the first mleader.