Author Topic: Calling 2 Lisps in sequnce via macro  (Read 3413 times)

0 Members and 1 Guest are viewing this topic.

MSTG007

  • Gator
  • Posts: 2606
  • I can't remeber what I already asked! I need help!
Calling 2 Lisps in sequnce via macro
« on: October 04, 2016, 01:43:02 PM »
 :idiot2: I am trying to sequence two lisp routines via a macro button and not having any luck. I have the first routine that takes Text Lines and combines them into a Mtext. The other routine would then convert that Mtext to a MLeader. How can I get these to where I select the text then converts the it to a mtext and then finally pick a point for the mleader.


By the way, Ron, great routine!

Code: [Select]
;;; AUTHOR
;;; Copyright© 2010 Ron Perez (ronperez@gmail.com)
;;; 11.02.2010 added grouping text by X values

;;;; http://www.theswamp.org/index.php?topic=35382.msg407916#msg407916


(defun c:t2mt (/   rjp-removextraspaces rjp-ent2obj       rjp-getbbwdth
       rjp-getbbtlc      rjp-dxf d    doc       elst hgt
       i   n      nxt obj    otxt       out pt
       ss   txt      w x    x_sort     y
      )
  (defun rjp-removextraspaces (txt)
    (while (vl-string-search "  " txt) (setq txt (vl-string-subst " " "  " txt)))
    txt
  )
  (defun rjp-ent2obj (ent)
    (if (= (type ent) 'ename)
      (vlax-ename->vla-object ent)
      ent
    )
  )
  (defun rjp-dxf (code ent)
    (if (and ent (= (type ent) 'ename))
      (cdr (assoc code (entget ent)))
    )
  )
  (defun rjp-getbb (ent / ll ur)
    (vla-getboundingbox (rjp-ent2obj ent) 'll 'ur)
    (mapcar 'vlax-safearray->list (list ll ur))
  )
  (defun rjp-getbbwdth (ent / out)
    (setq out (mapcar 'car (rjp-getbb (rjp-ent2obj ent))))
    (abs (- (car out) (cadr out)))
  )
  (defun rjp-getbbtlc (ent / out)
    (setq out (rjp-getbb (rjp-ent2obj ent)))
    (list (caar out) (cadr (last out)) 0.0)
  )
  (if (and (setq ss (ssget ":L" (list '(0 . "text"))))
   (setq doc (vla-get-activedocument (vlax-get-acad-object)))
   ;;list as X Y TEXT ENAME
   (setq elst (mapcar '(lambda (x)
(list (car (rjp-dxf 10 x))
       (cadr (rjp-dxf 10 x))
       (strcat (rjp-removextraspaces (rjp-dxf 1 x)) " ")
       x
)
       )
      (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
      )
   )
      )
    (progn
      ;;Sort top to bottom
      (setq elst (vl-sort elst '(lambda (y1 y2) (> (cadr y1) (cadr y2)))))
      ;;Group by x values using text height as fuzz value
      (while (setq i (car elst))
(setq y (vl-remove-if-not '(lambda (x) (equal (car i) (car x) (rjp-dxf 40 (last i)))) elst))
(mapcar '(lambda (x) (setq elst (vl-remove x elst))) y)
(setq x_sort (cons y x_sort))
      )
      (foreach item x_sort
(setq ;;Get widest piece of text to set mtext width
      w    (* 1.0125 (car (vl-sort (mapcar 'rjp-getbbwdth (mapcar 'last item)) '>)))
      hgt  (rjp-dxf 40 (last (car item)))
      pt   (rjp-getbbtlc (last (car item)))
      ;;Grab top text to pull properties from
      otxt (vlax-ename->vla-object (last (car item)))
)
;;Puts hard returns for text spaced greater than (* 2. hgt)
(setq n 0)
(foreach x item
  (if (setq nxt (nth (setq n (1+ n)) item))
    (if (>= (setq d (abs (- (cadr x) (cadr nxt)))) (* 2. hgt))
      (setq out (cons (strcat (caddr x) "\\P\\P") out))
      (setq out (cons (caddr x) out))
    )
    (setq out (cons (caddr x) out))
  )
)
;;Join the text into one string
(setq txt (apply 'strcat (reverse out)))
;;Insert mtext
(setq obj (vla-addmtext
    (if (= (getvar 'cvport) 1)
      (vla-get-paperspace doc)
      (vla-get-modelspace doc)
    )
    (vlax-3d-point pt)
    w
    txt
  )
      txt nil
      out nil
)
;;Match properties from top text object
(vla-put-height obj (vla-get-height otxt))
(vla-put-attachmentpoint obj actopleft)
(vlax-put obj 'insertionpoint pt)
(vla-put-rotation obj 0.0)
(vla-put-layer obj (vla-get-layer otxt))
(vla-put-stylename obj (vla-get-stylename otxt))
;;Delete selected single line text
(mapcar 'entdel (mapcar 'last item))
      )
    )
  )
  (princ)
)



Code: [Select]
(defun c:mt2ml ( / oobj nobj nstrg)
  (vl-load-com)
  (setq oobj (vlax-ename->vla-object (car (nentsel "\nSelect source text: "))))
  (if (= (vlax-get-property oobj 'ObjectName) "AcDbMText")
    (setq nstrg (vlax-get-property oobj 'TextString))
    (exit)    
    )
  (command "_MLEADER")
  (while (= 1 (logand (getvar "CMDACTIVE") 1)) (command PAUSE))
  (setq nobj (vlax-ename->vla-object (entlast)))
  (if (= (vlax-get-property nobj 'ObjectName) "AcDbMLeader")
    (vlax-put-property nobj 'TextString nstrg)
    (exit)    
    )
  (entdel (vlax-vla-object->ename oobj))
  (princ)
)

Thanks for any advice on this.
Civil3D 2020

steve.carson

  • Newt
  • Posts: 108
Re: Calling 2 Lisps in sequnce via macro
« Reply #1 on: October 04, 2016, 02:56:37 PM »
I think they way I would approach it is to modify both routines to be subfunctions (removing the "C:" from the defun), then make a new function that calls them. For example, I would modify Ron's routine so it returns the mtext it creates, and modify the mt2ml function to take a single argument (the mtext object). Then your new routine could be something like:

Code: [Select]
(defun C:NewFunc ( / )
(mt2ml (t2mt))
)

And your macro button would point to this new function.

Since you're modifying somebody elses code, it's respectful to add something to the header indicating that you modified it. And since it's posted here at theswamp, it's also a good idea to include a link to this thread, like what Ron did in his code.

Let me know if you aren't sure how to modify the mt2ml code to take an argument instead of prompting for mtext, it's not overly complicated.



Steve

MSTG007

  • Gator
  • Posts: 2606
  • I can't remeber what I already asked! I need help!
Re: Calling 2 Lisps in sequnce via macro
« Reply #2 on: October 04, 2016, 03:33:02 PM »
Awesome, thank you for the guidance. This is kinda where I am at with it...

Code: [Select]
(defun C:NewFunc ( / )
;;;;https://www.theswamp.org/index.php?topic=52095.0
(mt2ml (t2mt))
)


(defun mt2ml ( / oobj nobj nstrg)
;;;;https://autocadtips1.com/2012/03/12/add-leader-to-text-make-multileader/
  (vl-load-com)
  (setq oobj (vlax-ename->vla-object (car (nentsel "\nSelect source text: "))))
  (if (= (vlax-get-property oobj 'ObjectName) "AcDbMText")
    (setq nstrg (vlax-get-property oobj 'TextString))
    (exit)    
    )
  (command "_MLEADER")
  (while (= 1 (logand (getvar "CMDACTIVE") 1)) (command PAUSE))
  (setq nobj (vlax-ename->vla-object (entlast)))
  (if (= (vlax-get-property nobj 'ObjectName) "AcDbMLeader")
    (vlax-put-property nobj 'TextString nstrg)
    (exit)    
    )
  (entdel (vlax-vla-object->ename oobj))
  (princ)
)



;;; AUTHOR
;;; Copyright© 2010 Ron Perez (ronperez@gmail.com)
;;; 11.02.2010 added grouping text by X values
;;;; http://www.theswamp.org/index.php?topic=35382.msg407916#msg407916
(defun t2mt (/   rjp-removextraspaces rjp-ent2obj       rjp-getbbwdth
       rjp-getbbtlc      rjp-dxf d    doc       elst hgt
       i   n      nxt obj    otxt       out pt
       ss   txt      w x    x_sort     y
      )
  (defun rjp-removextraspaces (txt)
    (while (vl-string-search "  " txt) (setq txt (vl-string-subst " " "  " txt)))
    txt
  )
  (defun rjp-ent2obj (ent)
    (if (= (type ent) 'ename)
      (vlax-ename->vla-object ent)
      ent
    )
  )
  (defun rjp-dxf (code ent)
    (if (and ent (= (type ent) 'ename))
      (cdr (assoc code (entget ent)))
    )
  )
  (defun rjp-getbb (ent / ll ur)
    (vla-getboundingbox (rjp-ent2obj ent) 'll 'ur)
    (mapcar 'vlax-safearray->list (list ll ur))
  )
  (defun rjp-getbbwdth (ent / out)
    (setq out (mapcar 'car (rjp-getbb (rjp-ent2obj ent))))
    (abs (- (car out) (cadr out)))
  )
  (defun rjp-getbbtlc (ent / out)
    (setq out (rjp-getbb (rjp-ent2obj ent)))
    (list (caar out) (cadr (last out)) 0.0)
  )
  (if (and (setq ss (ssget ":L" (list '(0 . "text"))))
   (setq doc (vla-get-activedocument (vlax-get-acad-object)))
   ;;list as X Y TEXT ENAME
   (setq elst (mapcar '(lambda (x)
(list (car (rjp-dxf 10 x))
       (cadr (rjp-dxf 10 x))
       (strcat (rjp-removextraspaces (rjp-dxf 1 x)) " ")
       x
)
       )
      (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
      )
   )
      )
    (progn
      ;;Sort top to bottom
      (setq elst (vl-sort elst '(lambda (y1 y2) (> (cadr y1) (cadr y2)))))
      ;;Group by x values using text height as fuzz value
      (while (setq i (car elst))
(setq y (vl-remove-if-not '(lambda (x) (equal (car i) (car x) (rjp-dxf 40 (last i)))) elst))
(mapcar '(lambda (x) (setq elst (vl-remove x elst))) y)
(setq x_sort (cons y x_sort))
      )
      (foreach item x_sort
(setq ;;Get widest piece of text to set mtext width
      w    (* 1.0125 (car (vl-sort (mapcar 'rjp-getbbwdth (mapcar 'last item)) '>)))
      hgt  (rjp-dxf 40 (last (car item)))
      pt   (rjp-getbbtlc (last (car item)))
      ;;Grab top text to pull properties from
      otxt (vlax-ename->vla-object (last (car item)))
)
;;Puts hard returns for text spaced greater than (* 2. hgt)
(setq n 0)
(foreach x item
  (if (setq nxt (nth (setq n (1+ n)) item))
    (if (>= (setq d (abs (- (cadr x) (cadr nxt)))) (* 2. hgt))
      (setq out (cons (strcat (caddr x) "\\P\\P") out))
      (setq out (cons (caddr x) out))
    )
    (setq out (cons (caddr x) out))
  )
)
;;Join the text into one string
(setq txt (apply 'strcat (reverse out)))
;;Insert mtext
(setq obj (vla-addmtext
    (if (= (getvar 'cvport) 1)
      (vla-get-paperspace doc)
      (vla-get-modelspace doc)
    )
    (vlax-3d-point pt)
    w
    txt
  )
      txt nil
      out nil
)
;;Match properties from top text object
(vla-put-height obj (vla-get-height otxt))
(vla-put-attachmentpoint obj actopleft)
(vlax-put obj 'insertionpoint pt)
(vla-put-rotation obj 0.0)
(vla-put-layer obj (vla-get-layer otxt))
(vla-put-stylename obj (vla-get-stylename otxt))
;;Delete selected single line text
(mapcar 'entdel (mapcar 'last item))
      )
    )
  )
  (princ)
)

Civil3D 2020

steve.carson

  • Newt
  • Posts: 108
Re: Calling 2 Lisps in sequnce via macro
« Reply #3 on: October 04, 2016, 03:57:19 PM »
OK, so if you look near the bottom of Ron's code, you'll see where he adds the mtext object with "vla-addmtext" and he stores this in a variable called "obj". Then he does a bunch of stuff to the mtext (setting the height, insertion point, rotation, etc.), then ends the program with a (princ). That's how you exit a program cleanly. In your case we don't want it to exit cleanly, we want it to spit out the mtext object it created. So you can simply replace the "(princ)" with "obj". No parenthesis, or it will think it's a function.

You can test if this works by loading the modified function and typing this at the command line:

(t2mt)

After it runs, it should say something like "#<VLA-OBJECT IAcadMText 0000000053728a68>" at the command line.

This is just to make sure it's returning what you are expecting it to return. Once you get this working post back and I'll run through the argument part.



MSTG007

  • Gator
  • Posts: 2606
  • I can't remeber what I already asked! I need help!
Re: Calling 2 Lisps in sequnce via macro
« Reply #4 on: October 04, 2016, 04:12:13 PM »
I am getting a t2mt Unknow command "T2MT". Press F1 .. . .

Code: [Select]
(vla-put-layer obj (vla-get-layer otxt))
(vla-put-stylename obj (vla-get-stylename otxt))
;;Delete selected single line text
(mapcar 'entdel (mapcar 'last item))
      )
    )
  )
  obj
)
Civil3D 2020

steve.carson

  • Newt
  • Posts: 108
Re: Calling 2 Lisps in sequnce via macro
« Reply #5 on: October 04, 2016, 04:23:10 PM »
Hmm, it worked for me when I tested it. You loaded the whole thing right? So right now your code looks like this:

Code: [Select]

(defun C:NewFunc ( / )
;;;;https://www.theswamp.org/index.php?topic=52095.0
(mt2ml (t2mt))
)


(defun mt2ml ( / oobj nobj nstrg)
;;;;https://autocadtips1.com/2012/03/12/add-leader-to-text-make-multileader/
  (vl-load-com)
  (setq oobj (vlax-ename->vla-object (car (nentsel "\nSelect source text: "))))
  (if (= (vlax-get-property oobj 'ObjectName) "AcDbMText")
    (setq nstrg (vlax-get-property oobj 'TextString))
    (exit)    
    )
  (command "_MLEADER")
  (while (= 1 (logand (getvar "CMDACTIVE") 1)) (command PAUSE))
  (setq nobj (vlax-ename->vla-object (entlast)))
  (if (= (vlax-get-property nobj 'ObjectName) "AcDbMLeader")
    (vlax-put-property nobj 'TextString nstrg)
    (exit)    
    )
  (entdel (vlax-vla-object->ename oobj))
  (princ)
)



;;; AUTHOR
;;; Copyright© 2010 Ron Perez (ronperez@gmail.com)
;;; 11.02.2010 added grouping text by X values
;;;; http://www.theswamp.org/index.php?topic=35382.msg407916#msg407916
(defun t2mt (/   rjp-removextraspaces rjp-ent2obj       rjp-getbbwdth
       rjp-getbbtlc      rjp-dxf d    doc       elst hgt
       i   n      nxt obj    otxt       out pt
       ss   txt      w x    x_sort     y
      )
  (defun rjp-removextraspaces (txt)
    (while (vl-string-search "  " txt) (setq txt (vl-string-subst " " "  " txt)))
    txt
  )
  (defun rjp-ent2obj (ent)
    (if (= (type ent) 'ename)
      (vlax-ename->vla-object ent)
      ent
    )
  )
  (defun rjp-dxf (code ent)
    (if (and ent (= (type ent) 'ename))
      (cdr (assoc code (entget ent)))
    )
  )
  (defun rjp-getbb (ent / ll ur)
    (vla-getboundingbox (rjp-ent2obj ent) 'll 'ur)
    (mapcar 'vlax-safearray->list (list ll ur))
  )
  (defun rjp-getbbwdth (ent / out)
    (setq out (mapcar 'car (rjp-getbb (rjp-ent2obj ent))))
    (abs (- (car out) (cadr out)))
  )
  (defun rjp-getbbtlc (ent / out)
    (setq out (rjp-getbb (rjp-ent2obj ent)))
    (list (caar out) (cadr (last out)) 0.0)
  )
  (if (and (setq ss (ssget ":L" (list '(0 . "text"))))
   (setq doc (vla-get-activedocument (vlax-get-acad-object)))
   ;;list as X Y TEXT ENAME
   (setq elst (mapcar '(lambda (x)
(list (car (rjp-dxf 10 x))
       (cadr (rjp-dxf 10 x))
       (strcat (rjp-removextraspaces (rjp-dxf 1 x)) " ")
       x
)
       )
      (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
      )
   )
      )
    (progn
      ;;Sort top to bottom
      (setq elst (vl-sort elst '(lambda (y1 y2) (> (cadr y1) (cadr y2)))))
      ;;Group by x values using text height as fuzz value
      (while (setq i (car elst))
(setq y (vl-remove-if-not '(lambda (x) (equal (car i) (car x) (rjp-dxf 40 (last i)))) elst))
(mapcar '(lambda (x) (setq elst (vl-remove x elst))) y)
(setq x_sort (cons y x_sort))
      )
      (foreach item x_sort
(setq ;;Get widest piece of text to set mtext width
      w    (* 1.0125 (car (vl-sort (mapcar 'rjp-getbbwdth (mapcar 'last item)) '>)))
      hgt  (rjp-dxf 40 (last (car item)))
      pt   (rjp-getbbtlc (last (car item)))
      ;;Grab top text to pull properties from
      otxt (vlax-ename->vla-object (last (car item)))
)
;;Puts hard returns for text spaced greater than (* 2. hgt)
(setq n 0)
(foreach x item
  (if (setq nxt (nth (setq n (1+ n)) item))
    (if (>= (setq d (abs (- (cadr x) (cadr nxt)))) (* 2. hgt))
      (setq out (cons (strcat (caddr x) "\\P\\P") out))
      (setq out (cons (caddr x) out))
    )
    (setq out (cons (caddr x) out))
  )
)
;;Join the text into one string
(setq txt (apply 'strcat (reverse out)))
;;Insert mtext
(setq obj (vla-addmtext
    (if (= (getvar 'cvport) 1)
      (vla-get-paperspace doc)
      (vla-get-modelspace doc)
    )
    (vlax-3d-point pt)
    w
    txt
  )
      txt nil
      out nil
)
;;Match properties from top text object
(vla-put-height obj (vla-get-height otxt))
(vla-put-attachmentpoint obj actopleft)
(vlax-put obj 'insertionpoint pt)
(vla-put-rotation obj 0.0)
(vla-put-layer obj (vla-get-layer otxt))
(vla-put-stylename obj (vla-get-stylename otxt))
;;Delete selected single line text
(mapcar 'entdel (mapcar 'last item))
      )
    )
  )
  obj
)

MSTG007

  • Gator
  • Posts: 2606
  • I can't remeber what I already asked! I need help!
Re: Calling 2 Lisps in sequnce via macro
« Reply #6 on: October 04, 2016, 04:26:37 PM »
Before I go Emotio and stuff, yours truly forgot to add the "("")" around the t2mt. Yes it does work. Sorry!
Civil3D 2020

steve.carson

  • Newt
  • Posts: 108
Re: Calling 2 Lisps in sequnce via macro
« Reply #7 on: October 04, 2016, 04:52:37 PM »
No problem, happens to me all the time.

So first, a brief explanation of how arguments work. A lisp file is put together like this:
Code: [Select]
(defun FunctionName (Arguments / Local Variables)

    (Things to do)

)
In basic programs, you may be used to running the program, having it ask you for input, then performing some tasks. For example, you run a program called "MakeLayer" and it asks you to "Enter the Name", then "Specify a color", then makes a layer. But, sometimes you want the input to come programmatically. In this case, the input is called an "argument" and is listed before the "/" above. Within the code, the arguments act like variables that are already set. For example, the MakeLayer function might look like:
Code: [Select]
(defun MakeLayer (name color / )

    (if (and (= (type name) 'STR)
             (= (type color) 'INT)
        )
        (entmake (list '(0 . "LAYER")
                       '(100 . "AcDbSymbolTableRecord")
                       '(100 . "AcDbLayerTableRecord")
                        (cons 2 name)
                       '(70 . 0)
                        (cons 62 color)
                 )
        )
        (princ "\nName must be a string and color must be an integer!")
    )
(princ)
)
"name" and "color" are the arguments to the function and have to be included when you call the function. So if you wanted to make a layer that's a certain color you could type (MakeLayer "Steel" 2) at the command line (or in a button). This would make a layer called "Steel" thats color 2. Notice how I called the function. First there's the "(MakeLayer" part. That's obviously the function name. Then after that is "Steel". This is the first argument, and is assigned "name" in the program. The next part is "2" (but without quotes). That's the second argument and is assigned "color" in the program.


What you want to do is modify the mt2ml function to take an argument (that is the mtext object returned by Ron's function) instead of prompting the user for it. So if you examine the mt2ml function, you will see this line:

(setq oobj (vlax-ename->vla-object (car (nentsel "\nSelect source text: "))))

This is where the original program is asking the user to select the source text, then converts it to a vla object, and assigns it to a variable called "oobj". So the simplest thing to do is to make the first argument be called "oobj", and remove the (setq oobj (vlax... blah blah blah) line. In other words, you don't need to setq the oobj variable in the code, because you are passing the oobj to the code from the arguments. So add an argument called oobj and comment out the setq line. I'm going to let you try it first and report back if it doesn't work. It's always more satisfying that way.

MSTG007

  • Gator
  • Posts: 2606
  • I can't remeber what I already asked! I need help!
Re: Calling 2 Lisps in sequnce via macro
« Reply #8 on: October 04, 2016, 05:05:41 PM »
Still alittle lost. This is what I have so far,

Code: [Select]

(defun C:NewFunc ( / )

;;;;https://www.theswamp.org/index.php?topic=52095.0


(mt2ml (t2mt))

)


(defun mt2ml ( / oobj nobj nstrg)
;;;;https://autocadtips1.com/2012/03/12/add-leader-to-text-make-multileader/
  (vl-load-com)
;;;  (setq oobj (vlax-ename->vla-object (car (nentsel "\nSelect source text: "))))
  (setq oobj)
  (if (= (vlax-get-property oobj 'ObjectName) "AcDbMText")
    (setq nstrg (vlax-get-property oobj 'TextString))
    (exit)    
    )
  (command "_MLEADER")
  (while (= 1 (logand (getvar "CMDACTIVE") 1)) (command PAUSE))
  (setq nobj (vlax-ename->vla-object (entlast)))
  (if (= (vlax-get-property nobj 'ObjectName) "AcDbMLeader")
    (vlax-put-property nobj 'TextString nstrg)
    (exit)    
    )
  (entdel (vlax-vla-object->ename oobj))
  (princ)
)



;;; AUTHOR
;;; Copyright© 2010 Ron Perez (ronperez@gmail.com)
;;; 11.02.2010 added grouping text by X values
;;;; http://www.theswamp.org/index.php?topic=35382.msg407916#msg407916
(defun t2mt (/   rjp-removextraspaces rjp-ent2obj       rjp-getbbwdth
       rjp-getbbtlc      rjp-dxf d    doc       elst hgt
       i   n      nxt obj    otxt       out pt
       ss   txt      w x    x_sort     y
      )
  (defun rjp-removextraspaces (txt)
    (while (vl-string-search "  " txt) (setq txt (vl-string-subst " " "  " txt)))
    txt
  )
  (defun rjp-ent2obj (ent)
    (if (= (type ent) 'ename)
      (vlax-ename->vla-object ent)
      ent
    )
  )
  (defun rjp-dxf (code ent)
    (if (and ent (= (type ent) 'ename))
      (cdr (assoc code (entget ent)))
    )
  )
  (defun rjp-getbb (ent / ll ur)
    (vla-getboundingbox (rjp-ent2obj ent) 'll 'ur)
    (mapcar 'vlax-safearray->list (list ll ur))
  )
  (defun rjp-getbbwdth (ent / out)
    (setq out (mapcar 'car (rjp-getbb (rjp-ent2obj ent))))
    (abs (- (car out) (cadr out)))
  )
  (defun rjp-getbbtlc (ent / out)
    (setq out (rjp-getbb (rjp-ent2obj ent)))
    (list (caar out) (cadr (last out)) 0.0)
  )
  (if (and (setq ss (ssget ":L" (list '(0 . "text"))))
   (setq doc (vla-get-activedocument (vlax-get-acad-object)))
   ;;list as X Y TEXT ENAME
   (setq elst (mapcar '(lambda (x)
(list (car (rjp-dxf 10 x))
       (cadr (rjp-dxf 10 x))
       (strcat (rjp-removextraspaces (rjp-dxf 1 x)) " ")
       x
)
       )
      (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
      )
   )
      )
    (progn
      ;;Sort top to bottom
      (setq elst (vl-sort elst '(lambda (y1 y2) (> (cadr y1) (cadr y2)))))
      ;;Group by x values using text height as fuzz value
      (while (setq i (car elst))
(setq y (vl-remove-if-not '(lambda (x) (equal (car i) (car x) (rjp-dxf 40 (last i)))) elst))
(mapcar '(lambda (x) (setq elst (vl-remove x elst))) y)
(setq x_sort (cons y x_sort))
      )
      (foreach item x_sort
(setq ;;Get widest piece of text to set mtext width
      w    (* 1.0125 (car (vl-sort (mapcar 'rjp-getbbwdth (mapcar 'last item)) '>)))
      hgt  (rjp-dxf 40 (last (car item)))
      pt   (rjp-getbbtlc (last (car item)))
      ;;Grab top text to pull properties from
      otxt (vlax-ename->vla-object (last (car item)))
)
;;Puts hard returns for text spaced greater than (* 2. hgt)
(setq n 0)
(foreach x item
  (if (setq nxt (nth (setq n (1+ n)) item))
    (if (>= (setq d (abs (- (cadr x) (cadr nxt)))) (* 2. hgt))
      (setq out (cons (strcat (caddr x) "\\P\\P") out))
      (setq out (cons (caddr x) out))
    )
    (setq out (cons (caddr x) out))
  )
)
;;Join the text into one string
(setq txt (apply 'strcat (reverse out)))
;;Insert mtext
(setq obj (vla-addmtext
    (if (= (getvar 'cvport) 1)
      (vla-get-paperspace doc)
      (vla-get-modelspace doc)
    )
    (vlax-3d-point pt)
    w
    txt
  )
      txt nil
      out nil
)
;;Match properties from top text object
(vla-put-height obj (vla-get-height otxt))
(vla-put-attachmentpoint obj actopleft)
(vlax-put obj 'insertionpoint pt)
(vla-put-rotation obj 0.0)
(vla-put-layer obj (vla-get-layer otxt))
(vla-put-stylename obj (vla-get-stylename otxt))
;;Delete selected single line text
(mapcar 'entdel (mapcar 'last item))
      )
    )
  )
  obj
)

Civil3D 2020

steve.carson

  • Newt
  • Posts: 108
Re: Calling 2 Lisps in sequnce via macro
« Reply #9 on: October 04, 2016, 05:27:51 PM »
That's OK, you just need to add an argument to the mt2ml function. It looks like you attempted to do that with the (setq oobj) line, but that won't work. It needs to be in the arguments section, so the first line of the mt2ml function should be:

(defun mt2ml (oobj / nobj nstrg)

and you can delete the (setq oobj) line.

Notice how oobj is before the "/"? that means it's an argument. We will be getting the value of oobj from what is returned by the t2mt function once we run NewFunc.  It's a little bit confusing, but once it clicks, you'll get it. That's the way it was for me anyway. I didn't get it at first, but then it just clicked.




MSTG007

  • Gator
  • Posts: 2606
  • I can't remeber what I already asked! I need help!
Re: Calling 2 Lisps in sequnce via macro
« Reply #10 on: October 04, 2016, 06:31:20 PM »
Geesh... totally missed that! Hey I'm out for the night could we finish tomorrow if you don't mind?
Civil3D 2020

steve.carson

  • Newt
  • Posts: 108
Re: Calling 2 Lisps in sequnce via macro
« Reply #11 on: October 04, 2016, 06:34:28 PM »
Sure thing.

MSTG007

  • Gator
  • Posts: 2606
  • I can't remeber what I already asked! I need help!
Re: Calling 2 Lisps in sequnce via macro
« Reply #12 on: October 05, 2016, 07:23:54 AM »
Got it.

Code: [Select]

(defun C:NewFunc ( / )

;;;;https://www.theswamp.org/index.php?topic=52095.0


(mt2ml (t2mt))

)


(defun mt2ml (oobj / nobj nstrg)
;;;;https://autocadtips1.com/2012/03/12/add-leader-to-text-make-multileader/
  (vl-load-com)
  (setq oobj (vlax-ename->vla-object (car (nentsel "\nSelect source text: "))))
  (if (= (vlax-get-property oobj 'ObjectName) "AcDbMText")
    (setq nstrg (vlax-get-property oobj 'TextString))
    (exit)    
    )
  (command "_MLEADER")
  (while (= 1 (logand (getvar "CMDACTIVE") 1)) (command PAUSE))
  (setq nobj (vlax-ename->vla-object (entlast)))
  (if (= (vlax-get-property nobj 'ObjectName) "AcDbMLeader")
    (vlax-put-property nobj 'TextString nstrg)
    (exit)    
    )
  (entdel (vlax-vla-object->ename oobj))
  (princ)
)



;;; AUTHOR
;;; Copyright© 2010 Ron Perez (ronperez@gmail.com)
;;; 11.02.2010 added grouping text by X values
;;;; http://www.theswamp.org/index.php?topic=35382.msg407916#msg407916
(defun t2mt (/   rjp-removextraspaces rjp-ent2obj       rjp-getbbwdth
       rjp-getbbtlc      rjp-dxf d    doc       elst hgt
       i   n      nxt obj    otxt       out pt
       ss   txt      w x    x_sort     y
      )
  (defun rjp-removextraspaces (txt)
    (while (vl-string-search "  " txt) (setq txt (vl-string-subst " " "  " txt)))
    txt
  )
  (defun rjp-ent2obj (ent)
    (if (= (type ent) 'ename)
      (vlax-ename->vla-object ent)
      ent
    )
  )
  (defun rjp-dxf (code ent)
    (if (and ent (= (type ent) 'ename))
      (cdr (assoc code (entget ent)))
    )
  )
  (defun rjp-getbb (ent / ll ur)
    (vla-getboundingbox (rjp-ent2obj ent) 'll 'ur)
    (mapcar 'vlax-safearray->list (list ll ur))
  )
  (defun rjp-getbbwdth (ent / out)
    (setq out (mapcar 'car (rjp-getbb (rjp-ent2obj ent))))
    (abs (- (car out) (cadr out)))
  )
  (defun rjp-getbbtlc (ent / out)
    (setq out (rjp-getbb (rjp-ent2obj ent)))
    (list (caar out) (cadr (last out)) 0.0)
  )
  (if (and (setq ss (ssget ":L" (list '(0 . "text"))))
   (setq doc (vla-get-activedocument (vlax-get-acad-object)))
   ;;list as X Y TEXT ENAME
   (setq elst (mapcar '(lambda (x)
(list (car (rjp-dxf 10 x))
       (cadr (rjp-dxf 10 x))
       (strcat (rjp-removextraspaces (rjp-dxf 1 x)) " ")
       x
)
       )
      (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
      )
   )
      )
    (progn
      ;;Sort top to bottom
      (setq elst (vl-sort elst '(lambda (y1 y2) (> (cadr y1) (cadr y2)))))
      ;;Group by x values using text height as fuzz value
      (while (setq i (car elst))
(setq y (vl-remove-if-not '(lambda (x) (equal (car i) (car x) (rjp-dxf 40 (last i)))) elst))
(mapcar '(lambda (x) (setq elst (vl-remove x elst))) y)
(setq x_sort (cons y x_sort))
      )
      (foreach item x_sort
(setq ;;Get widest piece of text to set mtext width
      w    (* 1.0125 (car (vl-sort (mapcar 'rjp-getbbwdth (mapcar 'last item)) '>)))
      hgt  (rjp-dxf 40 (last (car item)))
      pt   (rjp-getbbtlc (last (car item)))
      ;;Grab top text to pull properties from
      otxt (vlax-ename->vla-object (last (car item)))
)
;;Puts hard returns for text spaced greater than (* 2. hgt)
(setq n 0)
(foreach x item
  (if (setq nxt (nth (setq n (1+ n)) item))
    (if (>= (setq d (abs (- (cadr x) (cadr nxt)))) (* 2. hgt))
      (setq out (cons (strcat (caddr x) "\\P\\P") out))
      (setq out (cons (caddr x) out))
    )
    (setq out (cons (caddr x) out))
  )
)
;;Join the text into one string
(setq txt (apply 'strcat (reverse out)))
;;Insert mtext
(setq obj (vla-addmtext
    (if (= (getvar 'cvport) 1)
      (vla-get-paperspace doc)
      (vla-get-modelspace doc)
    )
    (vlax-3d-point pt)
    w
    txt
  )
      txt nil
      out nil
)
;;Match properties from top text object
(vla-put-height obj (vla-get-height otxt))
(vla-put-attachmentpoint obj actopleft)
(vlax-put obj 'insertionpoint pt)
(vla-put-rotation obj 0.0)
(vla-put-layer obj (vla-get-layer otxt))
(vla-put-stylename obj (vla-get-stylename otxt))
;;Delete selected single line text
(mapcar 'entdel (mapcar 'last item))
      )
    )
  )
  obj
)

Civil3D 2020

steve.carson

  • Newt
  • Posts: 108
Re: Calling 2 Lisps in sequnce via macro
« Reply #13 on: October 05, 2016, 11:41:39 AM »
Almost... You still want to comment out the (setq oobj (... line.

MSTG007

  • Gator
  • Posts: 2606
  • I can't remeber what I already asked! I need help!
Re: Calling 2 Lisps in sequnce via macro
« Reply #14 on: October 05, 2016, 11:46:35 AM »
Ok. Gotcha.

Code: [Select]

(defun C:NewFunc ( / )

;;;;https://www.theswamp.org/index.php?topic=52095.0


(mt2ml (t2mt))

)


(defun mt2ml (oobj / nobj nstrg)

;;;;https://autocadtips1.com/2012/03/12/add-leader-to-text-make-multileader/

  (vl-load-com)

;;;; (setq oobj (vlax-ename->vla-object (car (nentsel "\nSelect source text: "))))

  (setq oobj)

  (if (= (vlax-get-property oobj 'ObjectName) "AcDbMText")
    (setq nstrg (vlax-get-property oobj 'TextString))
    (exit)    
    )
  (command "_MLEADER")
  (while (= 1 (logand (getvar "CMDACTIVE") 1)) (command PAUSE))
  (setq nobj (vlax-ename->vla-object (entlast)))
  (if (= (vlax-get-property nobj 'ObjectName) "AcDbMLeader")
    (vlax-put-property nobj 'TextString nstrg)
    (exit)    
    )
  (entdel (vlax-vla-object->ename oobj))
  (princ)
)



;;; AUTHOR
;;; Copyright© 2010 Ron Perez (ronperez@gmail.com)
;;; 11.02.2010 added grouping text by X values
;;;; http://www.theswamp.org/index.php?topic=35382.msg407916#msg407916
(defun t2mt (/   rjp-removextraspaces rjp-ent2obj       rjp-getbbwdth
       rjp-getbbtlc      rjp-dxf d    doc       elst hgt
       i   n      nxt obj    otxt       out pt
       ss   txt      w x    x_sort     y
      )
  (defun rjp-removextraspaces (txt)
    (while (vl-string-search "  " txt) (setq txt (vl-string-subst " " "  " txt)))
    txt
  )
  (defun rjp-ent2obj (ent)
    (if (= (type ent) 'ename)
      (vlax-ename->vla-object ent)
      ent
    )
  )
  (defun rjp-dxf (code ent)
    (if (and ent (= (type ent) 'ename))
      (cdr (assoc code (entget ent)))
    )
  )
  (defun rjp-getbb (ent / ll ur)
    (vla-getboundingbox (rjp-ent2obj ent) 'll 'ur)
    (mapcar 'vlax-safearray->list (list ll ur))
  )
  (defun rjp-getbbwdth (ent / out)
    (setq out (mapcar 'car (rjp-getbb (rjp-ent2obj ent))))
    (abs (- (car out) (cadr out)))
  )
  (defun rjp-getbbtlc (ent / out)
    (setq out (rjp-getbb (rjp-ent2obj ent)))
    (list (caar out) (cadr (last out)) 0.0)
  )
  (if (and (setq ss (ssget ":L" (list '(0 . "text"))))
   (setq doc (vla-get-activedocument (vlax-get-acad-object)))
   ;;list as X Y TEXT ENAME
   (setq elst (mapcar '(lambda (x)
(list (car (rjp-dxf 10 x))
       (cadr (rjp-dxf 10 x))
       (strcat (rjp-removextraspaces (rjp-dxf 1 x)) " ")
       x
)
       )
      (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
      )
   )
      )
    (progn
      ;;Sort top to bottom
      (setq elst (vl-sort elst '(lambda (y1 y2) (> (cadr y1) (cadr y2)))))
      ;;Group by x values using text height as fuzz value
      (while (setq i (car elst))
(setq y (vl-remove-if-not '(lambda (x) (equal (car i) (car x) (rjp-dxf 40 (last i)))) elst))
(mapcar '(lambda (x) (setq elst (vl-remove x elst))) y)
(setq x_sort (cons y x_sort))
      )
      (foreach item x_sort
(setq ;;Get widest piece of text to set mtext width
      w    (* 1.0125 (car (vl-sort (mapcar 'rjp-getbbwdth (mapcar 'last item)) '>)))
      hgt  (rjp-dxf 40 (last (car item)))
      pt   (rjp-getbbtlc (last (car item)))
      ;;Grab top text to pull properties from
      otxt (vlax-ename->vla-object (last (car item)))
)
;;Puts hard returns for text spaced greater than (* 2. hgt)
(setq n 0)
(foreach x item
  (if (setq nxt (nth (setq n (1+ n)) item))
    (if (>= (setq d (abs (- (cadr x) (cadr nxt)))) (* 2. hgt))
      (setq out (cons (strcat (caddr x) "\\P\\P") out))
      (setq out (cons (caddr x) out))
    )
    (setq out (cons (caddr x) out))
  )
)
;;Join the text into one string
(setq txt (apply 'strcat (reverse out)))
;;Insert mtext
(setq obj (vla-addmtext
    (if (= (getvar 'cvport) 1)
      (vla-get-paperspace doc)
      (vla-get-modelspace doc)
    )
    (vlax-3d-point pt)
    w
    txt
  )
      txt nil
      out nil
)
;;Match properties from top text object
(vla-put-height obj (vla-get-height otxt))
(vla-put-attachmentpoint obj actopleft)
(vlax-put obj 'insertionpoint pt)
(vla-put-rotation obj 0.0)
(vla-put-layer obj (vla-get-layer otxt))
(vla-put-stylename obj (vla-get-stylename otxt))
;;Delete selected single line text
(mapcar 'entdel (mapcar 'last item))
      )
    )
  )
  obj
)

Civil3D 2020