;**************  Alex  Chiang   89' 1,20   Update

(defun C:ext ( / sset ssn a ent p0 temp1 temp2 ln11 ln12 p4 p5 dist1 dist2 temp c r x3 y3)
     (setvar "cmdecho" 0)
     (setvar "flatland" 1)
     (prompt "\nSelect object to extend (trim) :")
;     (command "select" pause)
;     (setq sset (ssget "p"))
      (setq sset (ssget))
     (setq ssn (sslength sset))
     (setq temp1 (getpoint "\nEeter the first destination :"))
     (setq temp2 (getpoint "\nEeter the second destination :"))
     (setq a 0)
     (while (< a ssn)
     (setq p0  (entget (ssname sset a)))
     (setq ent (cdr (assoc 0 p0 )))
     (vp temp1)  ; virtual point
     (if (/= temp2 nil)(progn
     (vp temp2)
      (cond
       ( (= ent "LINE") (perp temp1 p0 ) (setq p4 (list x3 y3))
         (perp temp2 p0 ) (setq p5 (list x3 y3))
         (setq p0 (subst (cons 10 p4) (assoc 10 p0) p0))
         (setq p0 (subst (cons 11 p5) (assoc 11 p0) p0))
         (entmod p0)
       )
       ((= ent "ARC")
         (setq c (cdr (assoc 10 p0 )))
         (setq r (cdr (assoc 40 p0 )))
         (if (equal temp1 temp2) (progn (entdel (ssname sset a))
             (command "circle" c r)))
         (id c temp1 r)(setq p4 (list x3 y3))
         (setq p4 (angle c p4))
         (id c temp2 r)  (setq p5 (list x3 y3))
         (setq p5 (angle c p5))
         (setq p0 (subst (cons 50 p4) (assoc 50 p0) p0))
         (setq p0 (subst (cons 51 p5) (assoc 51 p0) p0))
         (entmod p0)
       )
       ( (= ent "CIRCLE")
         (setq c (cdr (assoc 10 p0 )))
         (setq r (cdr (assoc 40 p0 )))
         (id c temp1 r) (setq p4 (list x3 y3))
         (id c temp2 r) (setq p5 (list x3 y3))
         (command "break" p5 p4 )
       )
       (T  (terpri) (princ (chr 7))
       (princ "********No entities be selected !!! (must be line, arc, circle) ") (terpri))
      )
     )

    (progn
     (cond
        ((= ent "LINE")
          (setq ln11 (cdr (assoc 10 p0 )))
          (setq ln12 (cdr (assoc 11 p0 )))
          (setq dist1 (distance temp1 ln11))
          (setq dist2 (distance temp1 ln12))
          (if (> dist2 dist1)
          (progn
           (setq temp ln11)
            (setq ln11 ln12)
             (setq ln12 temp)
          )
          )
         (perp temp1 p0 ) (setq p4 (list x3 y3))
         (setq p0 (subst (cons 10 ln11) (assoc 10 p0) p0))
         (setq p0 (subst (cons 11 p4) (assoc 11 p0) p0))
         (entmod p0)
       )
       ((= ent "ARC")
         (setq c (cdr (assoc 10 p0 )))
         (setq r (cdr (assoc 40 p0 )))
          (setq ln11 (polar c (cdr (assoc 50 p0 )) r))
          (setq ln12 (polar c (cdr (assoc 51 p0 )) r))
          (setq dist1 (distance temp1 ln11))
          (setq dist2 (distance temp1 ln12))
          (if (> dist2 dist1)
          (progn
           (id c temp1 r) (setq p4 (list x3 y3))
           (setq p4 (angle c p4))
           (setq p0 (subst (cons 50 p4) (assoc 50 p0) p0))
          )
         (progn
         (id c temp1 r) (setq p5 (list x3 y3))
         (setq p5 (angle c p5))
         (setq p0 (subst (cons 51 p5) (assoc 51 p0) p0))
         )
         )
         (entmod p0)
       )
       ((= ent "CIRCLE")
          (while  (= temp2 nil)(terpri)
          (princ "******* must have two points for the circle to trim !!!")
          (princ (chr 7))
          (setq temp2 (getpoint "\nEeter the second destination :"))
          )
          (setq c (cdr (assoc 10 p0 )))
          (setq r (cdr (assoc 40 p0 )))
          (id c temp1 r) (setq p4 (list x3 y3))
          (id c temp2 r) (setq p5 (list x3 y3))
          (command "break" p5 p4 )
       )
       (T  (terpri)(princ (chr 7))
       (princ "********No entities be selected !!! (must be line, arc, circle) ") (terpri))
     )
    )
    )
     (setq a (+ a 1))
    (setvar "cmdecho" 1)
    (setvar "flatland" 0)
   )
)

;---------------------- vp ------------------
;
(defun vp (cen / arm l r b t)                     ;Virtual Point
;
;variable :
;
;   1. cen    : point center
;
    (setq arm (/ (getvar "viewsize") 200.0))
    (setq l (list (- (car cen) arm) (cadr cen)))
    (setq r (list (+ (car cen) arm) (cadr cen)))
    (setq b (list (car cen) (- (cadr cen) arm)))
    (setq t (list (car cen) (+ (cadr cen) arm)))
    (grdraw l r -1)
    (grdraw b t -1)
)

(defun id ( p1 p2 d /  )
        (setq x3 (+ (car p1) (/ (* (- (car p2) (car p1)) d) (distance p1 p2))))
        (setq y3 (+ (cadr p1) (/ (* (- (cadr p2) (cadr p1)) d) (distance p1 p2))))
)

(defun perp (p1 p0 / pd ps temp2 temp ln21 ln22 theta x1 x2
              y1 y2 dist1 dist2 s c ln2x ln2y )
    (setq temp2 p0)
    (setq ln21 (cdr (assoc 10 temp2)))
    (setq ln22 (cdr (assoc 11 temp2)))
    (setq ln2x ln21)
    (setq ln2y ln22)
    (setq slen (distance ln21 ln22))
    (setq dist1 (distance p1 ln21))
    (setq dist2 (distance p1 ln22))
    (if (> dist2 dist1)
    (progn
        (setq temp ln21)
        (setq ln21 ln22)
        (setq ln22 temp)
    )
    )
    (setq x1 (- (car p1) (car ln21)))
    (setq y1 (- (cadr p1) (cadr ln21)))
    (setq x2 (- (car ln22) (car ln21)))
    (setq y2 (- (cadr ln22) (cadr ln21)))
   (setq s (- (* x1 y2) (* x2 y1)))
   (setq c (+ (* x1 x2) (* y1 y2)))
   (if (= c 0.0)
    (setq theta (/ pi 2))
    (progn
        (setq theta (/ s c))
        (setq theta (abs (atan theta)))
    )
   )
   (setq dist1 (* (sin theta) (distance p1 ln21)))

   (if (= c 0.0)
    (progn
    (setq x3 (car ln21))
    (setq y3 (cadr ln21))
    )
    (progn
    (setq dist2 (* (cos theta) (distance p1 ln21)))
    (setq x3 (+ (* (/ x2 slen) dist2) (car ln21)))
    (setq y3 (+ (* (/ y2 slen) dist2) (cadr ln21)))
    )
   )
)

