TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Marc'Antonio Alessi on November 06, 2022, 06:26:27 AM

Title: Stretch MultiLeader segments through midpoint as Polylines
Post by: Marc'Antonio Alessi on November 06, 2022, 06:26:27 AM
Multileader does not have the midpoint grip, how to stretch without selecting the two grips with shift button?
Or update the MultiLeader after stretch to have orthogonal segments? (see image)
Title: Re: Stretch MultiLeader segments through midpoint as Polylines
Post by: Tharwat on November 06, 2022, 10:39:32 AM
I always use stretch command even with polylines.
Title: Re: Stretch MultiLeader segments through midpoint as Polylines
Post by: It's Alive! on November 06, 2022, 05:04:28 PM
it may be possible to add this grip via GripOverrule, unfortunately, probably not in lisp
Title: Re: Stretch MultiLeader segments through midpoint as Polylines
Post by: Marc'Antonio Alessi on November 07, 2022, 06:18:40 AM
it may be possible to add this grip via GripOverrule, unfortunately, probably not in lisp
Thanks, I have only Lisp in my hand…
Is it possible to activate the two grips of the segment and do the stretch with a single click? (instead of 3 clicks)
Title: Re: Stretch MultiLeader segments through midpoint as Polylines
Post by: ronjonp on November 07, 2022, 11:10:06 AM
I always use stretch command even with polylines.
Same here.
Title: Re: Stretch MultiLeader segments through midpoint as Polylines
Post by: Marc'Antonio Alessi on November 07, 2022, 01:21:41 PM
I always use stretch command even with polylines.
Same here.
Stretch need 3 click and osnap Off maybe...
Title: Re: Stretch MultiLeader segments through midpoint as Polylines
Post by: BIGAL on November 07, 2022, 07:32:28 PM
A dumpit reveals.

Coordinates = (158.0 220.0 0.0 234.0 220.0 0.0 234.0 310.0 0.0 284.0 310.0 0.0)

So just a guess use entsel this gives a pick point, you can then find the segment so pick next point rework out the co-ords of the 2 adjacent points and update the leader co-ordinates.

Will have a play but some one else jump in if you have something.  I have some where pick pline segment which is needed.
Title: Re: Stretch MultiLeader segments through midpoint as Polylines
Post by: Marc'Antonio Alessi on November 09, 2022, 12:08:36 PM
...must be optimized… wait to see...
Title: Re: Stretch MultiLeader segments through midpoint as Polylines
Post by: Marc'Antonio Alessi on November 10, 2022, 02:56:08 AM
Code: [Select]
(defun C:ALE_Edit_StretchMLeaderVtx ( / SelLst Pnt001 Pnt002 RotAng VtxLst Ss_Str CurOrt)
  ; 20221109 > Ortho LEADER_LINEs
  (and (zerop (getvar 'ORTHOMODE)) (setq CurOrt (setvar 'ORTHOMODE 1)))
  (while
    (and
      (setq SelLst (ALE_N-EntSelEntity "Select Multileader" 'entsel "MULTILEADER"))
      (setq Pnt001 (osnap (cadr SelLst) "_END"))
      (setq VtxLst (vlax-invoke (vlax-ename->vla-object (car SelLst)) 'getleaderlinevertices 0))
      (progn
        (while VtxLst
          (if (equal Pnt001 (list (car VtxLst) (cadr VtxLst) (caddr VtxLst)) 1e-8)
            (if (cadddr VtxLst)
              (setq Pnt002 (list (cadddr VtxLst) (nth 4 VtxLst) (nth 5 VtxLst))  VtxLst nil)
              (setq VtxLst nil)
            )
            (setq VtxLst (cdddr VtxLst))
          )
        )
        Pnt002
      )
      (setq RotAng (angle Pnt002 Pnt001))
      (setq Pnt001 (polar (polar Pnt001 RotAng 1) (+ RotAng (/ pi 2)) 1))
      (setq RotAng (+ pi RotAng))
      (setq Pnt002 (polar (polar Pnt002 RotAng 1) (+ RotAng (/ pi 2)) 1))
      (setq Ss_Str (ssget "_C" Pnt001 Pnt002 '((0 . "MULTILEADER"))))
    ); and
    (setvar "SNAPANG" RotAng)
    (vl-cmdf "_.STRETCH" Ss_Str "" "_NONE" (cadr SelLst))
    (princ "\nNew position: ") (vl-cmdf "\\")
  )
  (and CurOrt (setvar 'ORTHOMODE 0))
  (setvar "SNAPANG" 0)
  (princ)
)

(defun ALE_N-EntSelEntity (PrmStr SelTyp WcMStr / FlgSlt SelLst)
    (setvar "ERRNO" 0)
    (princ "\n_ ")
    (setq PrmStr (strcat "\n" PrmStr ": "))
    (if
      (while (not FlgSlt)
        (if
          (and
            (setq SelLst ((eval SelTyp) PrmStr))
            (wcmatch (DXF 0 (entget (car SelLst))) (strcase WcMStr))
          )
          (not (setq FlgSlt T))
          (if (= 52 (getvar "ERRNO"))
            (setq FlgSlt T)
            (princ (strcat "\nNo entity selected or it is not a: " WcMStr "!"))
          )
        )
      )
      (not (princ "\nFunction cancelled.  "))
      SelLst
    )
)