square off two parallel lines and trim corner lisp help

[mosadelewa]

can anyone help modifyin this routine so when i select polyline it will go directly to fillet commenad.

this lisp will draw line from the end point of selecte two parallel lines even if not both lines are not equal distance.

and the theose lines are not parallel it wil use the fillet "0" to trim them at the intersection.

so i need it to work on polylines. or at lest use the fillet "0"

right now it doesn't

(defun c:tc (/ l1 l2 s1 s2
p10 p11 p20 p21 e1 e2 p1 p2 em1 em2 la
sp ep sa ea mp ra pt1 pt2 pp1 pp2 zl pe1 pe2
)
(setq ccl (getvar "CECOLOR"))
(setq clt (getvar "CELTYPE"))
(setq cla (getvar "clayer"))
; (princ "\nSelect 2 Parallel Lines")
(while (not l1)
(while (not s1)
(setq s1 (entsel "\nSelect 1st Line: ")))
(setq p1 (nth 1 s1)
ep (car s1))
(if (= "LINE" (cdr (assoc 0 (entget ep))))
(setq l1 ep)))
(setq pe1 (osnap p1 "end"))
(redraw l1 3)

(while (not l2)
(while (not s2)
(setq s2 (entsel "\nSelect 2nd Line: ")))
(setq p2 (nth 1 s2)
ep (car s2))
(if (= "LINE" (cdr (assoc 0 (entget ep))))
(setq l2 ep)))
(setq pe2 (osnap p2 "end"))
(redraw l2 3)

(setq e1 (entget l1)
e2 (entget l2)
p10 (cdr (assoc 10 e1))
p11 (cdr (assoc 11 e1))
p20 (cdr (assoc 10 e2))
p21 (cdr (assoc 11 e2)))

;;;COMPARE LINE ANGLES
(if (not (or (equal (angle p10 p11) (angle p20 p21) 1e-8)
(equal (angle p10 p11) (angle p21 p20) 1e-8)))
(progn
;(alert "Lines Are Not Parallel")

(command "fillet" s1 s2) (exit)))

;;;COMPARE LINE ELEVATIONS
(setq zl (mapcar 'caddr (list p10 p11 p20 p21)))
(if (apply '/= zl)
(progn
(alert "Lines Are Not Equal Elevation")
(exit)))

;;;COMPARE LINE UCS
(if (not (equal (cdr (assoc 210 e1)) (cdr (assoc 210 e2)) 1e-8))
(alert "Lines Are Not Same UCS - Be Careful"))

;;;CLOSEST ENDS TO 1ST PICK POINT
(if (> (distance p10 p1) (distance p11 p1))
(setq pt1 p10 em1 10 la (angle p11 p10))
(setq pt1 p11 em1 11 la (angle p10 p11)))
(if (> (distance p20 pt1) (distance p21 pt1))
(setq pt2 p20 em2 10)
(setq pt2 p21 em2 11))
(grdraw pt1 pt2 3 0)

;;;PERPINDICULAR POINTS
(setq pp1 (inters p10 p11 pt2 (polar pt2 (+ (angle p10 p11) (* pi 0.5)) 1) nil))
(setq pp2 (inters p20 p21 pt1 (polar pt1 (+ (angle p10 p11) (* pi 0.5)) 1) nil))
(grdraw pt1 pp2 1 0)
(grdraw pt2 pp1 2 0)

(setq mp (mapcar '(lambda (a b) (* (+ a b) 0.5)) pt1 pt2)
ra (* (distance pt1 pp2) 0.5)
sa (angle pt1 pp2)
ea (+ sa pi)
sp (polar mp sa ra)
ep (polar mp ea ra))

;**********************************

(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq ent (car s1))
(setq edata (entget ent))
(setq etype (cdr (assoc 0 edata)))
(setq c (cdr (assoc 62 edata)))
(setq lt (cdr (assoc 6 edata)))
(setq l (cdr (assoc 8 edata)))
(setq lts (cdr (assoc 48 edata)))
(if (not lts) (setq lts 1))
(progn
(if (= lt nil) (setq lt "BYLAYER"))
(if (= c nil) (setq c "BYLAYER"))
)

(command "_color" c)
(command "_linetype" "s" lt "")
(command "_layer" "set" l "")
(setvar "celtscale" lts)
;****************

(command "line" pp1 pt2 "")
(command "lengthen" "dy" s1 pp1 "")
(command "lengthen" "dy" s2 pp1 "")
(command "regen")
(setvar "CECOLOR" ccl)
(setvar "CELTYPE" clt)
(setvar "clayer" cla)
(redraw)

(prin1))

[stevor]

My guess is that the:

  (apply '/= zl)

does not work right.

Someone will provide a better way.

[Kent1Cooper]

---

@mosadelewa wrote:

.....

so i need it to work on polylines. or at lest use the fillet "0"

right now it doesn't

....

---

Do you mean that you want to select two Polylines, presumably open-ended ones, and have it do the same thing(s) that it does with Lines?  Could it be two segments of one Polyline?  Do you want to select one Polyline only once and have it fillet-"0" all of it that it can?  A sample drawing or image would be helpful.

By the way, @stevor is correct about:

  (apply '/= zl)

not being a reliable way to test what you want.  If any two in a row of the Z coordinates of the Lines' endpoints are the same, that will return nil, the same as if all of them are the same [read about (/=) in Help].  But because the (=) function applied to a list requires all of them to be the same to return T, I believe this will work correctly:

  (not (apply '= zl))

Also, what you are calling the comparison of the UCS's of the Lines is not that, but is only a comparison of their extrusion directions, which is not the same thing.  A Line drawn in the WCS can have different Z coordinates at its ends, but will still have the WCS's extrusion direction (210 0.0 0.0 1.0), so the routine will think it can Fillet it with a Line that lies in the WCS plane, but they will not be co-planar, resulting in a Filleting error.  And two Lines that are "flat" [in or parallel to the same UCS] can be at different elevations and therefore not co-planar, while still having the same extrusion direction.  I think you can ignore their UCS's, but need to compare the elevations of their endpoints relative to the current UCS, something like this [untested]:

(if

  (not

    (apply

      '=

      (list ; endpoint Z coordinates in current UCS

        (trans (caddr p10) 0 1)

        (trans (caddr p11) 0 1)

        (trans (caddr p20) 0 1)

        (trans (caddr p21) 0 1)

      ); list

    ); apply

  ); not

  (progn ; then
    (alert "Lines Are Not Coplar.")

    (quit)

  ); progn
); if

[mosadelewa]

Kent,

thanks for replying, simply this lisp is to draw line from an end point  of two selected parallel lines and if one shorter or longer than the other  it will lengthen the first selected line to the second selected line and draw the line.

if the lines are not parallel it will trim them at the intersection like if you use the fillet command with 0 radius.

here is the issue, it works fine with lines only, but not Polylines (open ends).

all i need add to it is ( if the selected are Polylines is to go to the commend fillet with 0 radius.)

i found this lisp on line and made some adjustment to it to work for what i want, so you are welcome to make any necessary modifications.

thanks again.