lisp to correct the perpendicular intersection

[DOODLEANU]

In my drawing there are lines which are not perpendicular intersected. can lisp correct it with its reference main line (red)? dwg file attached 

[Kent1Cooper]

It looks like in some cases you kept the end of a white Line that is on the red Line, and moved the other end, but in others you kept the end away from the red Line in place, and moved the end that touches it.  But I can't tell for sure, because the red Lines in the before vs. after are different lengths.  What is the real intent?

[DOODLEANU]

I wish to keep the other end of the lines (the ones not touching the red line) as they are and adjust the ends on the red line to be perfectly perpendicular. That's just a preference—it doesn't matter even if they move slightly. The intent is to make the lines rotate to be 100% perpendicular to the red line (main line).

[Kent1Cooper]

---

@DOODLEANU wrote:

I wish to keep the other end of the lines (the ones not touching the red line) as they are and adjust the ends on the red line to be perfectly perpendicular. ....

---

... which means, in this situation:

that the new end of the adjusted Line [my dotted grey Line] ends up off the [original] end of the red Line.  In your "after" condition, those meet, so the red should be extended to meet the new end of the white, correct?

[Kent1Cooper]

This seems to do that, in very limited testing:

(defun C:FLP ; = Force Lines Perpendicular
  (/ esel RL RLdata orth ss n L Ldata Lstart Lend StartCloser LsC LeC)
  (if
    (and
      (setq esel (entsel "\nReference Line to make other(s) perpendicular to: "))
      (= (cdr (assoc 0 (setq RLdata (entget (setq RL (car esel)))))) "LINE")
    ); and
    (progn ; then
      (setq orth (getvar 'orthomode))
      (prompt "\nTo make other Line(s) perpendicular to it,")
      (if (setq ss (ssget "_:L" '((0 . "LINE"))))
        (progn ; then
          (setvar 'orthomode 0); turn off
          (repeat (setq n (sslength ss)); then
            (setq
              L (ssname ss (setq n (1- n)))
              Ldata (entget L)
              Lstart (cdr (assoc 10 Ldata))
              Lend (cdr (assoc 11 Ldata))
              StartCloser ; T/nil
                (<
                  (distance Lstart (setq LsC (vlax-curve-getClosestPointTo RL Lstart T)))
                  (distance Lend (setq LeC (vlax-curve-getClosestPointTo RL Lend T)))
                ); < & StartCloser
            ); setq
            (command "_.change" L "" "_non" (if StartCloser LeC LsC))
          ); repeat
          (setvar 'orthomode orth); reset
        ); progn [then]
        (prompt "\nNo unlocked Lines selected to make perpendicular to reference Line."); else
      ); if
    ); progn [then]
    (prompt "\nNo reference Line selectede."); else
  ); if
  (prin1)
); defun

It turns the left side here into the right side:

As you can see, it does not extend the reference Line if a changed Line ends up off the end [awaiting your reply to my earlier question], but it could be expanded to include that.  It works with Line entities only, but could be made to work with Polylines with certain limitations.

[It uses the CHANGE command that a lot of people today are unfamiliar with, probably because there's no icon for it in the ribbon.  Old-enough farts like me know it from way back, and it's still in there, at least into Acad2020 that I have here -- I'll test in 2025 later.  When applied to a Line, it takes the end closer to the given point to that point, but ORTHO affects the result, which is why this turns that off.  But it avoids the need to manipulate entity data or mess with options like (setpropertyvalue) or VLA objects, though those are other valid approaches.]

[DOODLEANU]

Thank you, @Kent1Cooper  !

You explained it like a school teacher, which is very helpful for someone like me to understand easily. The code you provided is working perfectly.

Additionally, I didn't answer the previous question:

"Reference Line if a changed Line ends up off the end [awaiting your reply to my earlier question]."

If possible, I would like to extend the red line till the branches intersection point to the first and last lines  if the red line is smaller.  if red line is  bigger keep as it is.

[Kent1Cooper · Accepted solution]

---

@DOODLEANU wrote:

....

"Reference Line if a changed Line ends up off the end ...."

If possible, I would like to extend the red line till the branches intersection point to the first and last lines  ....

---

Try this modification [again, minimally tested]:

(defun C:FLP ; = Force Lines Perpendicular
  (/ esel RL RLdata orth ss n L Ldata Lstart Lend StartCloser LsC LeC chpt)
  (if
    (and
      (setq esel (entsel "\nReference Line to make other(s) perpendicular to: "))
      (= (cdr (assoc 0 (setq RLdata (entget (setq RL (car esel)))))) "LINE")
    ); and
    (progn ; then
      (redraw RL 3); highlight
      (setq orth (getvar 'orthomode))
      (prompt "\nTo make other Line(s) perpendicular to it,")
      (if (setq ss (ssget "_:L" '((0 . "LINE"))))
        (progn ; then
          (setvar 'orthomode 0); turn off
          (repeat (setq n (sslength ss)); then
            (setq
              L (ssname ss (setq n (1- n)))
              Ldata (entget L)
              Lstart (cdr (assoc 10 Ldata))
              Lend (cdr (assoc 11 Ldata))
              StartCloser ; T/nil
                (<
                  (distance Lstart (setq LsC (vlax-curve-getClosestPointTo RL Lstart T)))
                  (distance Lend (setq LeC (vlax-curve-getClosestPointTo RL Lend T)))
                ); < & StartCloser
              chpt (if StartCloser LeC LsC); change point
            ); setq
            (command "_.change" L "" "_non" chpt)
            (if (not (vlax-curve-getDistAtPoint RL chpt)); it's not on Reference Line
              (command "_.change" RL "" "_non" chpt)
            ); if
          ); repeat
          (setvar 'orthomode orth); reset
          (redraw RL 4); un-highlight
        ); progn [then]
        (prompt "\nNo unlocked Lines selected to make perpendicular to reference Line."); else
      ); if
    ); progn [then]
    (prompt "\nNo reference Line selectede."); else
  ); if
  (prin1)
); defun

I added highlighting of the Reference Line when selected, so you know you got it.

It could also use *error* handling to ensure ORTHOMODE gets reset and to un-highlight the Reference Line if something goes wrong, and Undo begin/end wrapping so all the steps Undo together, and probably some other things.

[DOODLEANU]

Thank you so much its works perfectly.

[omarsvn]

@Kent1Cooper Is it possible to obtain the perpendicular line with respect to the reference but without modifying the line? I mean that the line to be aligned must maintain its length property. If the user selects the line at a point close to the start point, the line will rotate with respect to its start point, and if the user selects a point close to its end point, the line will rotate with respect to its end point.

[Sea-Haven]

This may be useful for pick an end  was cut from some code done yesterday for a task. May need to swap > for < depending on what answer your looking for.

(setq ent (entsel "\npick a line near end "))
(setq obj (vlax-ename->vla-object (car ent)))
(setq startpt (vlax-curve-getstartPoint obj))
(setq endpt (vlax-curve-getEndPoint obj))
(setq pt1 (cadr ent))
(setq d1 (distance pt1 startpt))
(setq d2 (distance pt1 endpt))
(if (> d1 d2)
   (setq tmp startpt
   startpt endpt
   endpt tmp)
)
(setq dist (distance startpt endpt))

[Kent1Cooper]

---

@omarsvn wrote:

.... If the user selects the line at a point close to the start point, the line will rotate with respect to its start point, and if the user selects a point close to its end point, the line will rotate with respect to its end point.

---

What about Lines picked by window/crossing/lasso selection?  Are you willing to be restricted to selecting only one at a time?