Lisp Point at Multileader vertex

Lisp Point at Multileader vertex

rjames94
Enthusiast Enthusiast
1,022 Views
11 Replies
Message 1 of 12

Lisp Point at Multileader vertex

rjames94
Enthusiast
Enthusiast

How would I modify this lisp routine to add elevations to the points created. I would need the point z value set to the multileader content field. Attaching example file as well.

 

(defun LM:mleadervertices ( ent )
    (mapcar '(lambda ( x ) (massoc 10 x))
        (massoc "LEADER_LINE{"
            (cdr
                (assoc "LEADER{"
                    (cdr
                        (assoc "CONTEXT_DATA{"
                            (parsedxfdata (entget ent))
                        )
                    )
                )
            )
        )
    )
)
(defun massoc ( k l )
    (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= k (car x))) l))
)
(defun parsedxfdata ( l / foo )
    (defun foo ( / x )
        (setq x (car l)
              l (cdr l)
        )
        (cond
            (   (or (null x) (= "}" (cdr x)))
                nil
            )
            (   (and (= 'str (type (cdr x))) (wcmatch (cdr x) "*{*"))
                (cons (cons (cdr x) (foo)) (foo))
            )
            (   (cons x (foo)))
        )
    )
    (foo)
)

(defun c:test ( / c e )
    (if
        (and
            (setq e (car (entsel "\nSelect mleader: ")))
            (= "MULTILEADER" (cdr (assoc 0 (entget e))))
            (setq c 1)
        )
        (foreach l (LM:mleadervertices e)
            (foreach v l
                (entmake (list '(0 . "POINT") (cons 10 v) (cons 62 c)))
            )
            (setq c (1+ (rem c 255)))
        )
    )
)

 

0 Likes
Accepted solutions (2)
1,023 Views
11 Replies
Replies (11)
Message 2 of 12

hosneyalaa
Advisor
Advisor
Accepted solution

@rjames94 

 

try



(defun LM:mleadervertices ( ent )
    (mapcar '(lambda ( x ) (massoc 10 x))
        (massoc "LEADER_LINE{"
            (cdr
                (assoc "LEADER{"
                    (cdr
                        (assoc "CONTEXT_DATA{"
                            (parsedxfdata (entget ent))
                        )
                    )
                )
            )
        )
    )
)


(defun massoc ( k l )
    (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= k (car x))) l))
)


(defun parsedxfdata ( l / foo )
    (defun foo ( / x )
        (setq x (car l)
              l (cdr l)
        )
        (cond
            (   (or (null x) (= "}" (cdr x)))
                nil
            )
            (   (and (= 'str (type (cdr x))) (wcmatch (cdr x) "*{*"))
                (cons (cons (cdr x) (foo)) (foo))
            )
            (   (cons x (foo)))
        )
    )
    (foo)
)

(defun c:test ( / c e )
    (if
        (and
            (setq e (car (entsel "\nSelect mleader: ")))
            (= "MULTILEADER" (cdr (assoc 0 (entget e))))
            (setq c 1) 
	    
        )
        (foreach l (LM:mleadervertices e)
            (foreach v l
                (entmake (list '(0 . "POINT") (cons 10 (list (car v) (cadr v) (atof (vlax-get (vlax-ename->vla-object e) 'textstring)))) (cons 62 c))) 
            )
            (setq c (1+ (rem c 255)))
        )
    )
)

7.gif

0 Likes
Message 3 of 12

rjames94
Enthusiast
Enthusiast

Works well, thank you. is there anyway to do this for multiple mleaders at a time?

 

Also some of the multi leaders result in an error. My guess is mleaders that have styles/expressions in the content field.

 

rjames94_0-1713272381765.png

 

0 Likes
Message 4 of 12

hippe013
Advisor
Advisor

Run Strip MText Lisp Prior to running code provided by @hosneyalaa 

 

 

0 Likes
Message 5 of 12

rjames94
Enthusiast
Enthusiast
Thanks that solved that issue!
0 Likes
Message 6 of 12

rjames94
Enthusiast
Enthusiast

When trying to modify the test function to grab a selection of objects (ssget) i get lenentityp errors. Any ideas to get the functions to all multiple objects to loop through instead of one object at a time?

0 Likes
Message 7 of 12

hippe013
Advisor
Advisor

Create a selection set using a filter. Then use SSNAME to return the entity from the selectionset. Something like this: 

(defun c:test( / ss n c e)
  (setq ss (ssget '(( 0 . "MULTILEADER"))))
  (if ss
    (progn
      (setq n 0)
      (repeat (sslength ss)
	(setq ent (ssname ss n))
	(foreach l (LM:mleadervertices ent)
            (foreach v l
                (entmake (list '(0 . "POINT") (cons 10 (list (car v) (cadr v) (atof (vlax-get (vlax-ename->vla-object e) 'textstring)))) (cons 62 c))) 
            )
            (setq c (1+ (rem c 255)))
        )
	(setq n (+ n 1))
	)
      )
    )
  (princ)
  )
Message 8 of 12

rjames94
Enthusiast
Enthusiast

I'm getting this
; error: bad argument type: lentityp nil

 

Is it because the other functions are using entget instead ssget,sslength,ssname etc. Do entget and ssget work together? Or should I convert the other functions to use ssget as well?

0 Likes
Message 9 of 12

hippe013
Advisor
Advisor

No. It is because in the version I posted I renamed the variable from "e" to "ent". Switching it back to "e" should solve the error.

 

 

(defun c:test( / ss n c e)
  (setq ss (ssget '(( 0 . "MULTILEADER"))))
  (if ss
    (progn
      (setq n 0)
      (repeat (sslength ss)
        (setq e(ssname ss n))
        (foreach l (LM:mleadervertices e)
          (foreach v l
            (entmake (list '(0 . "POINT") (cons 10 (list (car v) (cadr v) (atof (vlax-get (vlax-ename->vla-object e) 'textstring)))) (cons 62 c))) 
            )
            (setq c (1+ (rem c 255)))
            )
	(setq n (+ n 1))
	)
      )
    )
  (princ)
  )

 

0 Likes
Message 10 of 12

rjames94
Enthusiast
Enthusiast
I got this error. ; error: bad DXF group: (62)
Removing "(cons 62 c)" solved that. But now i'm getting ; error: bad argument type: numberp: nil
0 Likes
Message 11 of 12

hippe013
Advisor
Advisor
Accepted solution

Well. Removed entmake all together and removed the color index vaiable "c". 

(defun c:test( / ss n c e)
  (setq ss (ssget '(( 0 . "MULTILEADER"))))
  (if ss
    (progn
      (setq ms (vlax-get-property (vlax-get-property (vlax-get-acad-object) 'ActiveDocument) 'ModelSpace))
      (setq n 0)
      (repeat (sslength ss)
	(setq e (ssname ss n))
	(foreach l (LM:mleadervertices e)
	  (foreach v l
	    (setq elev (atof (setq str (vlax-get (vlax-ename->vla-object e) 'TextString))))
	    (vlax-invoke-method ms 'AddPoint (vlax-3d-point (car v) (cadr v) elev))
            )
	  )
	(setq n (+ n 1))
	)
      )
    )
  (princ "\nDone.")
  (princ)
  )

I tested this code to make sure that it works.  

Message 12 of 12

rjames94
Enthusiast
Enthusiast
Thank you! Everything working as expected