blockname lisp

March 20

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

March 20

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.

March 21

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 March 21 by Tsuky
Update because a bad translation

March 21

Thanks for reply but i am not expert in lisp .

March 21

i tested not work sorry

March 21

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

(command "_.Mspace")

I wonder

March 21

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

March 21

Please retry to reload code , a bad translation

March 22

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 March 22 by aridzv

March 23

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

March 23

Here is a similar code: Block name in text.

EFF_NAME.lspFetching info...

Wednesday at 09:46 AM

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!

Wednesday at 09:49 AM

don't work in layout

Wednesday at 09:50 AM

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

Wednesday at 10:11 AM

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 Wednesday at 10:25 AM by aridzv

Wednesday at 10:42 AM

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 Wednesday at 10:44 AM by jim78b

Wednesday at 11:26 AM

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 Wednesday at 11:35 AM by aridzv

Wednesday at 01:34 PM

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

Wednesday at 01:45 PM

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 Wednesday at 01:46 PM by aridzv

Wednesday at 02:07 PM

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

Edited Wednesday at 02:39 PM by jim78b

Sign In

blockname lisp

Recommended Posts

jim78b

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

aridzv

jim78b

Nikon

Posted Images

BIGAL

Tsuky

jim78b

jim78b

Steven P

jim78b

Tsuky

aridzv

jim78b

Nikon

jim78b

jim78b

jim78b

aridzv

jim78b

aridzv

jim78b

aridzv

jim78b

Join the conversation

aridzv

jim78b

Nikon

Tutorials

Forums

Activity