Convert individual Entities to MLEADER?

[ILoveMadoka]

I have a large multi sheet drawing that someone has exploded everything.

All my many leaders are now individual arrowheads, line segments and text objects.

 

Does anyone know of an existing routine to convert such to an MLEADER?

 

(Pick the arrowhead, the leader line, the landing and the text)

 

Routines for converting just MTEXT to MLEADERS abound but I have been unable to find something for my situation.

 

Please advise

[BIGAL]

Sounds like just do leader but supply the text as a pre pick. Ie pick text 1st then start leader. Make sure correct osnaps are on like maybe only END. 

Edited July 8, 2023 by BIGAL

[devitg]

On 7/7/2023 at 10:34 AM, ILoveMadoka said:

I have a large multi sheet drawing that someone has exploded everything.

All my many leaders are now individual arrowheads, line segments and text objects.

 

Does anyone know of an existing routine to convert such to an MLEADER?

 

(Pick the arrowhead, the leader line, the landing and the text)

 

Routines for converting just MTEXT to MLEADERS abound but I have been unable to find something for my situation.

 

Please advise

@ILoveMadoka, please upload your sample.dwg

[Emmanuel Delay]

Sounds doable.

please upload your sample.dwg

So that we see which kind of arrow, kind of which style, ... 

[Steven P]

Not sure if this gets close to what you want?

 

This will make 1 mleader from a selection of its components - the 2 lines, the (solid) arrow head and the mtext. Be careful though, it deletes the selection so only select the mleader parts, nothing else

 

this will do it 1 mleader at a time rather than select the whole drawing and it just does it.

 

Happy for others to make suggestion and modifications 

 

(defun c:MTtoL ( / ss acount MyEnt GetEnt EntType )
  (defun RtD (r) (* 180.0 (/ r pi)))
  (defun DtR (d) (* pi (/ d 180.0)))

  (if (setq ss (ssget '((0 . "*TEXT,*LINE,SOLID"))) )
  (progn
  (setq acount 0)
  (while (< acount (sslength ss))
    (setq MyEnt (ssname ss acount))
    (setq GetEnt (entget MyEnt))
    (setq EntType (cdr (assoc 0 GetEnt)))
    (cond
      ((= EntType "SOLID")
        (setq MLeaderPoint (cdr (assoc 11 GetEnt))) ; 1st point for MLEADER
      ) ;end cond Solid
      ((= EntType "MTEXT")
        (setq MyText (cdr (assoc 1 GetEnt))) ; Text
      ) ;end cond MText
      ((= EntType "LINE")
        (setq Knee (cdr (assoc 10 GetEnt))) ; Line Knee point
        (setq LineAngle (rtd (angle Knee (cdr (assoc 11 GetEnt))) )) ; Not sure how to implement this yet
      ) ;end cond Line
    ) ; end cond
    (setq acount (+ acount 1))
  ) ; end while

  (command "_MLEADER" MLeaderPoint Knee MyText)
  (command "erase" ss "" )

  )) ; end progn, end if ss

) ; end defun

 

[ILoveMadoka]

Here is a drawing with what I have (typically)

Exploded Leaders.dwg

[ILoveMadoka]

The routine above "works" partially

 

Original text objects (the text is TEXT not MTEXT

 

 

After the routine

 

 

After dragging the end of the leader out

 

 

The leader start point moves.

In my testing, the value of the text is very often changed to a previously selected text string too..

 

I changed the first line

 

(defun c:L2ml ( / ss acount MyEnt GetEnt EntType MyText Knee LineAngle)

 

and got this result (IF) I selected the objects one at a time L to R

 

 

A selection window gets me this result

 

 

When I drag that leader out I get this result

 

 

Changing the first line to this

 

(defun c:L2ml ()

 

e

 

If I convert the TEXT to MTEXT first then select one at a time I get the best result

 

 

If I change these lines

 

(defun c:L2ml ( / ss acount MyEnt GetEnt EntType MyText Knee LineAngle)

 

 ((= EntType "TEXT")

 

and select one at a time I get this result

 

 

 

 

 

[Steven P]

I'll have a look and see what I did wrong, 

[ILoveMadoka]

This change allows it to work on both

 

      ((= EntType "TEXT")
        (setq MyText (cdr (assoc 1 GetEnt))) ; Text
      ) ;end cond Text
      ((= EntType "MTEXT")
        (setq MyText (cdr (assoc 1 GetEnt))) ; Text
      ) ;end cond MText

 

I know you can do an OR COND statement but cant remember the syntax off hand

 

[ILoveMadoka]

Your modified code will work enough that I could get by with it...

 

I appreciate it VERY much!! 

 

 

But better code is better code

[Steven P]

Thanks, I think when I exploded the Mleader in testing I only exploded it once and not twice, so I was getting mtext and not text, and 1 line and 1 polyline - so got a little thinking to change that about

 

For the text I was going to do it with an 'OR'. Are all your text single lines of text by the way, else will have to combine them I tihnk

 

 

      ((or (= EntType "MTEXT")(= EntType "TEXT"))
        (setq MyText (cdr (assoc 1 GetEnt))) ; Text
      ) ;end cond MText

 

[Steven P]

4 minutes ago, ILoveMadoka said:

But better code is better code

 

 

Well, yes, of course!!

 

 

 

(no point not saving this away for myself either and it would only annoy me if it didn't work rght)

[ILoveMadoka]

I'm just concerned that my other users will not take the time to select the objects in the correct order
and will end up saying "it doesn't work!"

[ILoveMadoka]

The drawing I'm working on only has single lines of text.
I'll have to remember to change multi-line to MText first, when I encounter it..

 

 

[Steven P]

How annoying 'they' want me to do some actual work,,,,,,

 

Try this as a slight improvement: Got to work out the lines so you can select all the exploded mleader parts and to work out what to do if the text is multiple lines

 

EDITTED BELOW

I think I have sorted the lines so that MLeader can be exploded a few times. User has to just select the MLeader parts and it is made up according to the current mleader style. Note if not all the items are selected then those not selected will remain in the drawing

 

 

;;Tested for mleaders with arrows
(defun c:L2ml ( / ss acount MyEnt GetEnt EntType MyText Knee LineAngle Dist1 Dist2 Pt10 Pt11 fuzz)
  (defun RtD (r) (* 180.0 (/ r pi)))
  (defun DtR (d) (* pi (/ d 180.0)))

  (setq fuzz 0.001)

  (if (setq ss (ssget '((0 . "*TEXT,*LINE,SOLID"))) )
  (progn
  (setq acount 0)
  (while (< acount (sslength ss))
    (setq MyEnt (ssname ss acount))
    (setq GetEnt (entget MyEnt))
    (setq EntType (cdr (assoc 0 GetEnt)))
    (cond
      ((= EntType "SOLID")
        ;; work out arrow point
        (setq Dist1 (distance (cdr (assoc 11 GetEnt)) (cdr (assoc 10 GetEnt)) ))
        (setq Dist2 (distance (cdr (assoc 12 GetEnt)) (cdr (assoc 10 GetEnt)) ))
        (if (> Dist1 Dist2)
          (setq MLeaderPoint (cdr (assoc 11 GetEnt))) ; 1st point for MLEADER
          (setq MLeaderPoint (cdr (assoc 12 GetEnt))) ; 1st point for MLEADER
        )
      ) ;end cond Solid
      ((or (= EntType "MTEXT")(= EntType "TEXT"))
        (setq MyText (cdr (assoc 1 GetEnt))) ; Text
      ) ;end cond MText
      ((= EntType "LINE")
        (if (= knee nil) ; if no other lines assessed yet
          (setq
            Knee (cdr (assoc 10 GetEnt))
            Pt10 (cdr (assoc 10 GetEnt))
            Pt11 (cdr (assoc 11 GetEnt))
          ) ; Line Knee point
          (progn
            (cond ; find line intersections. Do this way since don't know entity selection order
              (( equal (cdr (assoc 10 GetEnt)) PT10 fuzz) (setq Knee PT10)) ; include fuzz factor
              (( equal (cdr (assoc 11 GetEnt)) PT10 fuzz) (setq Knee PT10))
              (( equal (cdr (assoc 10 GetEnt)) PT11 fuzz) (setq Knee PT11))
              (( equal (cdr (assoc 11 GetEnt)) PT11 fuzz) (setq Knee PT11))
            ) ; end cond
          ) ; end progn
        ) ; end if
        (setq LineAngle (rtd (angle Knee (cdr (assoc 11 GetEnt))) )) ; Not sure how to implement this yet
      ) ;end cond Line
    ) ; end cond
    (setq acount (+ acount 1))
  ) ; end while

  (command "_MLEADER" MLeaderPoint Knee MyText)
  (command "erase" ss "" )

  )) ; end progn, end if ss

)

 

Edited July 10, 2023 by Steven P

[ILoveMadoka]

You ROCK!!

That is one awesome routine!!

 

(It doesn't like if you pick/select sometimes but works great otherwise!)

 

Thank you so very much!!

This will get some use!!

[Steven P]

6 minutes ago, ILoveMadoka said:

You ROCK!!

That is one awesome routine!!

 

(It doesn't like if you pick/select sometimes but works great otherwise!)

 

Thank you so very much!!

This will get some use!!

 

 

I'll get it closer after lunch

 

[ILoveMadoka]

Keeps getting better....
Thanks again.

Multiple lines of text will make this a commercially viable product!!

 

you're my my favorite person today!!

[Steven P]

Aha! That will be a nice mug of tea you owe me then....

 

This was giving me a problem if the mleader had several lines on top of each other, different lengths or whatever so fixed that I think. The fix was to only look at the horizontal lines and take the extreme X coordinates - however I think that could be written a bit better but it looks like it works and could also look at the other angles (0, 15, 30....)

 

The text will turn to an MText, in the order top downwards

 

 

Anyway try it and let me know,

 

 

So what I have now is it will recreate mleaders on selection of mleader components - tested on a mleader with an arrow and a horizontal 'landing'

 

EDITED to add in if there is no arrow selected

 

 

;;Tested with MLeaders + arrows. Updated for other arrow types - not fully tested
(defun c:L2ml ( / thisdrawing fuzz ss acount MyEnt GetEnt EntType Dist1 Dist2 MLeaderPoint MyText TxtY Pt10 Pt11 Knee DistPt10 DistPt11 LLine)

;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-to-join-multiple-lines-together/td-p/4353198
;;Get furthest apart points
  (defun LM:furthestapart ( lst / di1 di2 pt1 rtn )
    (setq di1 0.0)
    (while (setq pt1 (car lst))
        (foreach pt2 (setq lst (cdr lst))
            (if (< di1 (setq di2 (distance pt1 pt2)))
                (setq di1 di2
                      rtn (list pt1 pt2)
                )
            )
        )
    )
    rtn
  )


;;Set Undo Mark
  (Setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark thisdrawing)

  (setq fuzz 0.001)                                   ; fuzz distance

  (if (setq ss (ssget '((0 . "*TEXT,*LINE,SOLID,INSERT"))) ) ; select leader parts
    (progn
      (setq acount 0)
      (while (< acount (sslength ss))                 ; Loop through selection set
        (setq MyEnt (ssname ss acount))               ; get entity definition
        (setq GetEnt (entget MyEnt))
        (setq EntType (cdr (assoc 0 GetEnt)))

        (cond                                         ; Condition for entity types

          ((= EntType "SOLID")                        ; Get arrow coordinates (standard)
            ;; work out arrow point
            (setq Dist1 (distance (cdr (assoc 11 GetEnt)) (cdr (assoc 10 GetEnt)) ))
            (setq Dist2 (distance (cdr (assoc 12 GetEnt)) (cdr (assoc 10 GetEnt)) ))
            (if (> Dist1 Dist2)                            ; Find point on longest edge
              (setq MLeaderPoint (cdr (assoc 11 GetEnt)) ) ; 1st point for MLEADER
              (setq MLeaderPoint (cdr (assoc 12 GetEnt)) ) ; 1st point for MLEADER
            ) ; end if
          )   ; end cond Solid

          ((= Enttype "INSERT")                       ; Or for other arrow types
            (setq MLeaderPoint (cdr (assoc 10 GetEnt)) )
          ) ; end Cond Insert

          ((or (= EntType "MTEXT")(= EntType "TEXT"))   ; get Text definitions
            (if (= MyText nil)                          ; No text assessed
              (progn
                (setq MyText (cdr (assoc 1 GetEnt)))    ; Record the first text in the selection
                (setq TxtY (car (cdr (assoc 10 GetEnt))))  ; Record its Y coordinate
              ) ; end orogn
              (progn                                    ; 2nd or more text in selection set
                (if (< TxtY (car (cdr (assoc 10 GetEnt))) ) ; text positioned above or below previous text
                  (progn                                ; Suffix new text to original text
                    (setq MyText (strcat Mytext "\\P" (cdr (assoc 1 GetEnt)) ))
                  ) ; end progn
                  (progn                                ; Prefix new text, set a new upper Y coordinate
                    (setq MyText (strcat (cdr (assoc 1 GetEnt)) "\\P" Mytext ))
                    (setq TxtY (car (cdr (assoc 10 GetEnt))))
                  ) ; end progn
                ) ; end if
              ) ; end progn
            ) ; end if
          ) ;end cond MText

          ((= EntType "LINE")                           ; Get line definitions
            (setq Pt10 (cdr (assoc 10 GetEnt)) )        ; Line end A and end B
            (setq Pt11 (cdr (assoc 11 GetEnt)) )
            (if (equal (cdr Pt10) (cdr Pt11) fuzz)      ; For horizontal lines
              (progn
                (if (= Knee nil) (setq Knee (list Pt11 Pt10))) ; if knee point not specified
                (if (< (car Pt11)(car (car Knee)))(setq Knee (list Pt11 (cdr Knee)))) ; set extents
                (if (> (car Pt10)(cdr (cdr Knee)))(setq Knee (list (car Knee) Pt10)))
              )
              (progn                                   ; angled lines ;;need to work on this.
                (if (= LLine nil) (setq LLine (list Pt10 Pt11))) ; if line not assessed
                (setq LLine (LM:furthestapart (list (cadr LLine) (car LLine) Pt11 Pt10)))
              ) ; end progn
            ) ; end if Horizpntal line
          ) ;end cond Line

        ) ; end conds
        (setq acount (+ acount 1))
      ) ; end while                                        ; End loop through selection set

      (if (= MLeaderPoint nil) ; if no arrow selected, use angled line. Have to lengthen to arrow length?
        (if (< (distance (car LLine) (car Knee) ) (distance (cadr LLine) (car Knee) ))
          (setq MLeaderPoint (cadr LLine))
          (setq MLeaderPoint (car LLine))
        ) ; end if
      ) ;end if

      (if (< (distance MLeaderPoint (nth 0 Knee)) (distance MLeaderPoint (nth 1 Knee)))
        (setq Knee (nth 0 Knee))
        (setq Knee (nth 1 Knee))
      )

      (command "_MLEADER" MLeaderPoint Knee MyText)      ; Draw Leader
      (command "erase" ss "" )                           ; Delete old objects
  )) ; end progn, end if ss


;;End Undo Mark
  (vla-endundomark thisdrawing) ; end undo mark
  (princ) ; end quietly
)

 

Edited July 13, 2023 by Steven P

[ILoveMadoka]

That works perfectly!

I cannot ask for anything more...

well one thing....

 

(just kidding!)

 

I cannot THANK YOU enough!!!

That is some incredible code (to me)

 

Thank you very much Sir!