Jump to content

Label layer w/ multileader


jonathann3891

Recommended Posts

I'm working on a lisp that will label an object's layer with a multileader and a field, but I've hit a wall.

 

I cannot get the field to populate.

 

What am I missing?

 

(defun C:TTT (/ ss sss)
 (and
   (setq SS (car (entsel "\nSelect item to label: ")))
   (setq SSS (tblsearch "layer" (cdr (assoc 8 (entget SS)))))
   (progn 
     (command "_.MLEADER")
     (while (= (logand (getvar 'cmdactive) 1) 1) (command pause)) ; this is required for multisegment mleader
     (vla-put-TextString (vlax-ename->vla-object (entlast))
       (strcat "%<\\AcObjProp Object(%<\\_ObjId "
	       (itoa (vla-get-ObjectId SS))
	       ">%).Layer>%")
       )
     (vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acActiveViewport)
   ); progn
 ); and
 (princ)
); defun 

 

Link to comment
Share on other sites

You need to convert the entity selected 'ss' to vla-object.

(vla-get-ObjectId (vlax-ename->vla-object SS))

Besides that, you don't the tablesearch expression that assigned to variable 'sss'

  • Like 2
Link to comment
Share on other sites

11 minutes ago, Tharwat said:

You need to convert the entity selected 'ss' to vla-object.

(vla-get-ObjectId (vlax-ename->vla-object SS))

Besides that, you don't the tablesearch expression that assigned to variable 'sss'

 

Thanks @Tharwat!

 

The last issue is this line of code doesn't appear to be working:

(vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acActiveViewport)

The field isn't updating unless I regen or select the multileader.

 

 

(defun c:ttt (/ ss)
  (vl-load-com)
  (setq SS (car (entsel "\nSelect item to label: ")))
  (progn
    (command "_.MLEADER")
    (while (= (logand (getvar 'cmdactive) 1) 1) (command pause)) ; this is required for multisegment mleader
    (vla-put-TextString (vlax-ename->vla-object (entlast))
      (strcat "%<\\AcObjProp Object(%<\\_ObjId "
	      (itoa (vla-get-ObjectId (vlax-ename->vla-object SS)))
	      ">%).Layer>%")
      );vla
    (vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acActiveViewport)
    );progn
  (princ)
  );defun

 

Link to comment
Share on other sites

That's due to While function and it does not stop right after the last vertice.

It would be much better to use your certain Mleader style then you know the number of vertices required to ask the user to specify in prior of setting the field value to it, otherwise  it would be much professional way to get the number of vertices that the current mleader style uses then you modify your codes and use something like repeat ( based on the number of vertices ) then finally set the text string < field > .

  • Like 1
Link to comment
Share on other sites

14 hours ago, Tharwat said:

That's due to While function and it does not stop right after the last vertice.

It would be much better to use your certain Mleader style then you know the number of vertices required to ask the user to specify in prior of setting the field value to it, otherwise  it would be much professional way to get the number of vertices that the current mleader style uses then you modify your codes and use something like repeat ( based on the number of vertices ) then finally set the text string < field > .

 

Unfortunately that's above my skill level

Link to comment
Share on other sites

This allows you to pick two points. so you don't need the while.

(command "_.MLEADER" pause pause)

 

Edited by mhupp
Link to comment
Share on other sites

33 minutes ago, mhupp said:

This allows you to pick two points. so you don't need the while.

(command "_.MLEADER" pause pause)

 

 

I just rewrote the whole thing and made it much simpler and without a field.

 

(defun c:ll (/ ss tStr)
  (vl-load-com)
  (setvar 'Cmdecho 0)
  (setq SS (car (entsel "\nSelect item to label: "))
	tStr (cdr (assoc 8 (entget SS)))
	oLayer (getvar 'clayer)
	);setq
  (if (tblsearch "layer" "c_gen_Text")
    (command "_layer" "s" "c_gen_Text" "c" "50" "" "lt" "continuous" "" "")
    (command "_layer" "m" "c_gen_Text" "c" "50" "" "lt" "continuous" "" "")
    );if
  (vl-cmdf "_.mleader" pause pause tStr)
  (setvar 'clayer olayer)
  (setvar 'Cmdecho 1)
  (princ)
  )

 

Edited by jonathann3891
  • Like 1
Link to comment
Share on other sites

Currently it will end if nothing is selected. How do I go about looping until anything is selected?

 

Link to comment
Share on other sites

this will loop until you don't select anything.

 

(defun c:ll (/ ent str)
  (setvar 'cmdecho 0)
  (setq oLayer (getvar 'clayer))
  (if (tblsearch "layer" "c_gen_Text")
    (setvar 'clayer "c_gen_Text") ;make layer current
    (command "_layer" "m" "c_gen_Text" "c" "50" "" "lt" "continuous" "" "")
  )      ;if
  (while (setq ent (car (entsel "\nSelect Entity: ")))
    (setq str (cdr (assoc 8 (entget ent))))
    (vl-cmdf "_.mleader" pause pause str)
  )
  (setvar 'clayer olayer)
  (setvar 'cmdecho 1)
  (princ)
)

 

--edit

this one uses the point of entsel in mleader so you have one less click

(defun c:ll (/ ent str)
  (setvar 'cmdecho 0)
  (setq oLayer (getvar 'clayer))
  (if (tblsearch "layer" "c_gen_Text")
    (setvar 'clayer "c_gen_Text") ;make layer current
    (command "_layer" "m" "c_gen_Text" "c" "50" "" "lt" "continuous" "" "")
  )      ;if
  (while (setq ent (entsel "\nSelect Entity: "))
    (setq pt (cdr ent))
    (setq str (cdr (assoc 8 (entget (car ent)))))
    (vl-cmdf "_.mleader" pt pause str)
  )
  (setvar 'clayer olayer)
  (setvar 'cmdecho 1)
  (princ)
)

 

Edited by mhupp
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...