Author Topic: Lisp to read attribute and draw mleader with leader style  (Read 15442 times)

0 Members and 2 Guests are viewing this topic.

linktf

  • Guest
Lisp to read attribute and draw mleader with leader style
« on: October 24, 2013, 03:45:56 PM »
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

  • Needs a day job
  • Posts: 7527
Re: Lisp to read attribute and draw mleader with leader style
« Reply #1 on: October 24, 2013, 04:01:28 PM »
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)
)
« Last Edit: October 24, 2013, 04:04:46 PM by ronjonp »

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

WILL HATCH

  • Bull Frog
  • Posts: 450
Re: Lisp to read attribute and draw mleader with leader style
« Reply #2 on: October 24, 2013, 04:52:32 PM »
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.   (if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj)))
  41.   (if (= (type obj) 'VLA-OBJECT)
  42.     (if (> (vl-string-search "x64" (getvar "platform")) 0)
  43.       (vlax-invoke-method util "GetObjectIdString" obj :vlax-False)
  44.       (rtos (vla-get-objectid obj) 2 0)
  45.     )
  46.   )
  47. )

Lee Mac

  • Seagull
  • Posts: 12913
  • London, England
Re: Lisp to read attribute and draw mleader with leader style
« Reply #3 on: October 24, 2013, 06:25:22 PM »
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.     (LM:acdoc)
  97. )
  98.  

The above should also work in all UCS & Views.

WILL HATCH

  • Bull Frog
  • Posts: 450
Re: Lisp to read attribute and draw mleader with leader style
« Reply #4 on: October 25, 2013, 05:33:52 PM »
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

  • Seagull
  • Posts: 12913
  • London, England
Re: Lisp to read attribute and draw mleader with leader style
« Reply #5 on: October 26, 2013, 08:46:58 AM »
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

  • Guest
Re: Lisp to read attribute and draw mleader with leader style
« Reply #6 on: October 28, 2013, 10:57:20 AM »
 :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

  • Seagull
  • Posts: 12913
  • London, England
Re: Lisp to read attribute and draw mleader with leader style
« Reply #7 on: October 28, 2013, 11:10:45 AM »
: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]
  1. ">%).TextString>% - %<\\AcObjProp Object(%<\\_ObjId "
to:
Code - Auto/Visual Lisp: [Select]
  1. ">%).TextString>%\n%<\\AcObjProp Object(%<\\_ObjId "

linktf

  • Guest
Re: Lisp to read attribute and draw mleader with leader style
« Reply #8 on: October 29, 2013, 10:23:03 AM »
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

  • Seagull
  • Posts: 12913
  • London, England
Re: Lisp to read attribute and draw mleader with leader style
« Reply #9 on: October 29, 2013, 10:31:31 AM »
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

  • Guest
Re: Lisp to read attribute and draw mleader with leader style
« Reply #10 on: October 29, 2013, 10:45:10 AM »
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!  :-D

linktf

  • Guest
Re: Lisp to read attribute and draw mleader with leader style
« Reply #11 on: October 29, 2013, 01:24:50 PM »
What if the one of the attributes had no data. Can't draw leader, can it be changed to only insert the one attribute?
« Last Edit: October 29, 2013, 01:47:38 PM by linktf »

linktf

  • Guest
Re: Lisp to read attribute and draw mleader with leader style
« Reply #12 on: October 30, 2013, 01:28:19 PM »
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

  • Seagull
  • Posts: 12913
  • London, England
Re: Lisp to read attribute and draw mleader with leader style
« Reply #13 on: October 30, 2013, 06:53:18 PM »
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.     (LM:acdoc)
  115. )
  116.  

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

  • Guest
Re: Lisp to read attribute and draw mleader with leader style
« Reply #14 on: October 31, 2013, 11:48:30 AM »
still getting ############, even after re-running new mlb2