blockname lisp

[jim78b]

hello i want this lisp work in layout space. in my case don't work. if i select from a viewport a 3d model block, give me a leader with prompt text. i want give me the name of the block automatically.

 

; BlockLabel inserts mleader in pspace using selected block name as attribute value
; OP:
; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/block-name-to-multileader-user-block-attribute/m-p/12072574#M450763
(defun c:BlockLabel (/ attdia cmdecho ent entl nam obj)
(vl-load-com)
; save current settings
(setq attdia (getvar"attdia") cmdecho (getvar"cmdecho"))
; change settings
(setvar "cmdecho" 0)
(setvar "attdia" 0)
(command "_.Mspace")
(cond 
  ((not (setq ent (car (entsel "\nSelect block: ")))))
  ((not (eq (cdr (assoc 0 (entget ent))) "INSERT")) (princ "\nInvalid object!"))
  (progn 
   (setq obj (vlax-ename->vla-object ent)) ; convert entity to object
   (setq nam 
    (vlax-get-property obj
        (if (vlax-property-available-p obj 'effectivename)
            'effectivename
            'name
        )
    ) 
   )
   (command "_.Pspace") 
   (setq pt (getpoint "\nSpecify first point: "))
   (vl-cmdf "_.mleader" "_non" pt pause nam)
  )
 ) ; cond
; restore settings
(setvar "attdia" attdia)  
(setvar "cmdecho" cmdecho)
(princ)
) ; defun

 

[BIGAL]

Just a guess put your (setq ent (car (entsel "\nSelect block: "))) outside the cond I think it is exiting as yes its a "Insert". Not tested. You could use an If & progn rather than a cond.

[Tsuky]

My proposition...

(defun make_lead (obj pt txt / ptlst arr nw_obj)
  (setq
    ptlst (append pt (polar pt o_lead d_lead))
    arr (vlax-make-safearray vlax-vbdouble (cons 0 (- (length ptlst) 1)))
  )
  (vlax-safearray-fill arr ptlst)
  (setq nw_obj (vla-addMLeader Space (vlax-make-variant arr) 0))
  (vla-put-contenttype nw_obj acMTextContent)
  (vla-put-textstring
    nw_obj
    (strcat
      "\\fArial|b0|i0|c0|p34;"
      "%<\\AcObjProp Object(%<\\_ObjId "
      (itoa (vla-get-ObjectID obj))
      ">%).EffectiveName>%"
    )
  )
  (vla-put-layer nw_obj "Name-Block")
  (vla-put-ArrowheadSize nw_obj (* (getvar "TEXTSIZE") 0.5))
  (vla-put-DoglegLength nw_obj (getvar "TEXTSIZE"))
  (vla-put-LandingGap nw_obj (getvar "TEXTSIZE"))
  (vla-put-TextHeight nw_obj (getvar "TEXTSIZE"))
  (if (> (car (getvar "VIEWCTR")) (car pt_lead))
    (progn
      (vla-SetDogLegDirection nw_obj 0 (vlax-3D-point '(-1.0 0.0 0.0)))
      (vla-put-TextJustify nw_obj acAttachmentPointMiddleRight)
      (vla-setLeaderLineVertices nw_obj 0 (vlax-make-variant arr))
    )
    (vla-put-TextJustify nw_obj acAttachmentPointMiddleLeft)
  )
)
(defun c:lead_block-name ( / htx rtx pt_lead d_lead o_lead AcDoc Space ss n ename obj l_pr l_pt)
  (initget 6)
  (setq htx (getdist (getvar "VIEWCTR") (strcat "\nGive the height of field <" (rtos (getvar "TEXTSIZE")) ">: ")))
  (if htx (setvar "TEXTSIZE" htx))
  (if (not (setq rtx (getorient (getvar "VIEWCTR") "\nGive the orientation of field <0.0>: "))) (setq rtx 0.0))
  (setq rtx0 (+ (angle '(0 0 0) (getvar "UCSXDIR")) rtx))
  (initget 1)
  (setq pt_lead (getpoint (getvar "VIEWCTR") "\nGive the general orientation and distance for the guide: "))
  (setq d_lead (distance (getvar "VIEWCTR") pt_lead))
  (setq o_lead (angle (getvar "VIEWCTR") pt_lead))
  (setq
    AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
    Space
    (if (= 1 (getvar "CVPORT"))
      (vla-get-PaperSpace AcDoc)
      (vla-get-ModelSpace AcDoc)
    )
  )
  (vla-startundomark AcDoc)
  (princ "\nSelect blocks.")
  (setq ss (ssget '((0 . "INSERT"))))
  (cond
    (ss
      (cond
        ((null (tblsearch "Layer" "Name-Block"))
          (vlax-put (vla-add (vla-get-layers AcDoc) "Name-Block") 'color 174)
        )
      )
      (repeat (setq n (sslength ss))
        (setq
          ename (ssname ss (setq n (1- n)))
          obj (vlax-ename->vla-object ename)
          l_pr (list 'InsertionPoint 'EffectiveName)
        )
        (foreach e l_pr
          (if (vlax-property-available-p obj e)
            (if (eq e 'InsertionPoint)
              (setq l_pt (vlax-get obj e))
              (setq l_pt (cons (vlax-get obj e) l_pt))
            )
          )
        )
        (make_lead obj (cdr l_pt) (car l_pt))
      )
      (vla-regen AcDoc acactiveviewport)
    )
  )
  (vla-endundomark AcDoc)
  (prin1)
)

 

Edited Friday at 10:56 PM by Tsuky
Update because a bad translation

[jim78b]

Thanks for reply but i am not expert in lisp . 

[jim78b]

i tested not work sorry

[Steven P]

In paper space, Pspace you say, would his have anything to do with it:

(command "_.Mspace")

I wonder

 

[jim78b]

YES BUT when I start Lisp it selects the block but then it makes me write the text while it should put the name of the block

[Tsuky]

Please retry to reload code , a bad translation

 

[aridzv]

See attached code.

1. run the lisp in paper space.

2. the lisp prompt you to select a point on the block IN PAPER SPACE!! - click on the block.

3. click on the start point of the MLeader arrow - you are in paper space, no wories...

4. place the MLeader.

5. if you want to label another block go ahead.

6. to exit hit escape key or mouse right click.

 

EDIT: the lisp works in model space as well.

 

(defun c:MLeaderWBlname( / *error* temperr osnp tm tagname ptms ss ensel obj obj1 nam);ptps ptps1

    (setq temperr *error*);store *error*
    (setq *error* trap1);re-assign *error*

 (setq osnp (getvar "OSMODE"))
 (setvar "OSMODE" 0)
 (setq tm (getvar "TILEMODE"))
 
(princ "Select object in paper space,select start point of MLeader,exit with esc'")
 (while 1
  (if (= tm 0);if in paper space
   (progn
     (getpoint) ;;get point in paper space on the target object
     (command "._MSPACE")
     (setq ptms (cadr (grread t)));;get the point where the cursor is on the target object in model space
     (setq ss (ssget ptms));;selction set of the object crossing the ptms point
     (setq obj(ssname ss 0))
     (command "._PSPACE")
   );progn 
   (progn ;in model space  
     (setq ensel (entsel "\nSelect Block: ")) ;select the block object to copy
     (setq obj (car ensel)) ;set the block object to varaible
   );progn
  );if

  (setq obj1 (vlax-ename->vla-object obj)) 
  (setq nam 
   (vlax-get-property obj1
       (if (vlax-property-available-p obj1 'effectivename)
            'effectivename
            'name
       )
   ) 
  )
    
  (command "_mleader" "H" pause pause nam)
 );end while 

 (setq *error* temperr)

 (princ)
)

(defun trap1 (errmsg)
   (command "._PSPACE")
   (SETVAR "OSMODE" osnp)
   (princ)
)

 

Edited Saturday at 09:38 PM by aridzv

[jim78b]

  On 3/22/2025 at 9:11 PM, aridzv said:

See attached code.

1. run the lisp in paper space.

2. the lisp prompt you to select a point on the block IN PAPER SPACE!! - click on the block.

3. click on the start point of the MLeader arrow - you are in paper space, no wories...

4. place the MLeader.

5. if you want to label another block go ahead.

6. to exit hit escape key or mouse right click.

 

EDIT: the lisp works in model space as well.

 

(defun c:MLeaderWBlname( / *error* temperr osnp tm tagname ptms ss ensel obj obj1 nam);ptps ptps1

    (setq temperr *error*);store *error*
    (setq *error* trap1);re-assign *error*

 (setq osnp (getvar "OSMODE"))
 (setvar "OSMODE" 0)
 (setq tm (getvar "TILEMODE"))
 
(princ "Select object in paper space,select start point of MLeader,exit with esc'")
 (while 1
  (if (= tm 0);if in paper space
   (progn
     (getpoint) ;;get point in paper space on the target object
     (command "._MSPACE")
     (setq ptms (cadr (grread t)));;get the point where the cursor is on the target object in model space
     (setq ss (ssget ptms));;selction set of the object crossing the ptms point
     (setq obj(ssname ss 0))
     (command "._PSPACE")
   );progn 
   (progn ;in model space  
     (setq ensel (entsel "\nSelect Block: ")) ;select the block object to copy
     (setq obj (car ensel)) ;set the block object to varaible
   );progn
  );if

  (setq obj1 (vlax-ename->vla-object obj)) 
  (setq nam 
   (vlax-get-property obj1
       (if (vlax-property-available-p obj1 'effectivename)
            'effectivename
            'name
       )
   ) 
  )
    
  (command "_mleader" "H" pause pause nam)
 );end while 

 (setq *error* temperr)

 (princ)
)

(defun trap1 (errmsg)
   (command "._PSPACE")
   (SETVAR "OSMODE" osnp)
   (princ)
)

 

Expand  

THANKS A LOT! you are the best ! many thanks have a nice day

[Nikon]

Here is a similar code: Block name in text.

EFF_NAME.lspFetching info...

[jim78b]

sorry tested again today in the layout I select the block, but then it doesn't give me the name of the block but makes me write the text myself!

[jim78b]

don't work in layout

[jim78b]

i need  a mleader with a field in layout that update if the model change

[aridzv]

works for me...

see attached code (changed the condition on the WHILE loop so the error trap no longer needed on regular exit) and screenshot video.

(defun c:MLeaderWBlname( / *error* temperr osnp tm tagname ptms ss ensel obj obj1 nam);ptps ptps1

    (setq temperr *error*);store *error*
    (setq *error* trap1);re-assign *error*

 (setq osnp (getvar "OSMODE"))
 (setvar "OSMODE" 0)
 (setq tm (getvar "TILEMODE"))
 
(princ "Select object in paper space,select start point of MLeader,exit with esc'")
 (while (getpoint) ;;get point in paper space on the target object
  (if (= tm 0);if in paper space
   (progn
     (command "._MSPACE")
     (setq ptms (cadr (grread t)));;get the point where the cursor is on the target object in model space
     (setq ss (ssget ptms));;selction set of the object crossing the ptms point
     (setq obj(ssname ss 0))
     (command "._PSPACE")
   );progn 
   (progn ;in model space  
     (setq ensel (entsel "\nSelect Block: ")) ;select the block object to copy
     (setq obj (car ensel)) ;set the block object to varaible
   );progn
  );if

  (setq obj1 (vlax-ename->vla-object obj)) 
  (setq nam 
   (vlax-get-property obj1
       (if (vlax-property-available-p obj1 'effectivename)
            'effectivename
            'name
       )
   ) 
  )
    
  (command "_mleader" "H" pause pause nam)
 );end while 

 (setq *error* temperr)

 (princ)
)

(defun trap1 (errmsg)
   (command "._PSPACE")
   (SETVAR "OSMODE" osnp)
   (princ)
)

 

Edited 11 hours ago by aridzv

[jim78b]

I don't know why yesterday worked, today don't work.

 

Command: MLB
Select object in paper space,select start point of MLeader,exit with esc'._MSPACE
Command: ._PSPACE
Command:
Cannot invoke (command) from *error* without prior call to (*push-error-using-command*).
Converting (command) calls to (command-s) is recommended.

Edited 11 hours ago by jim78b

[aridzv]

use the last code I shared - it deals with the error issue.

if it dosn't work - stroke out all the error refrences in the code.

I didn't had any issues but if you think the error hadling give you problems than take it out....

 

edit:

in the error trap change 

(command "._PSPACE")

to 

(SETVAR "TILEMODE" 0)

 

it is not a command so mybe this will solve the issue.

Edited 10 hours ago by aridzv

[jim78b]

ok thanks ! has to do with arrow styles i think, because if i use standard it seem works!

 

I'm asking too much if it could be made associative? If I change the name of the block, does the name linked to the arrow automatically change? I can't find anything on the net

[aridzv]

1. the idea of using 

(SETVAR "TILEMODE" 0)

instand of 

(command "._PSPACE")

is not good,sorry for that.

 

2. I don't see any connection to the mleader being associative.

3. try run the lisp without any error hadling this way and check how it is:

(defun c:MLeaderWBlname( / osnp tm tagname ptms ss ensel obj obj1 nam)

 (setq osnp (getvar "OSMODE"))
 (setvar "OSMODE" 0)
 (setq tm (getvar "TILEMODE"))
 
(princ "Select object in paper space,select start point of MLeader,exit with esc'")
 (while (getpoint) ;;get point in paper space on the target object
  (if (= tm 0);if in paper space
   (progn
     (command "._MSPACE")
     (setq ptms (cadr (grread t)));;get the point where the cursor is on the target object in model space
     (setq ss (ssget ptms));;selction set of the object crossing the ptms point
     (setq obj(ssname ss 0))
     (command "._PSPACE")
   );progn 
   (progn ;in model space  
     (setq ensel (entsel "\nSelect Block: ")) ;select the block object to copy
     (setq obj (car ensel)) ;set the block object to varaible
   );progn
  );if

  (setq obj1 (vlax-ename->vla-object obj)) 
  (setq nam 
   (vlax-get-property obj1
       (if (vlax-property-available-p obj1 'effectivename)
            'effectivename
            'name
       )
   ) 
  )
    
  (command "_mleader" "H" pause pause nam)
 );end while 

 (command "._PSPACE")
 (SETVAR "OSMODE" osnp)

 (princ)
)

 

Edited 8 hours ago by aridzv

[jim78b]

SO what code should i use? however ALWAYS the code reset my osnap!! is possible?

Edited 7 hours ago by jim78b