;;绘制三通 By Gu_xl 2013.04.12 (c:tt)
(defun c:tt (/      DXF    UPD    REVLINE       PERTOLINE     S0
             S1     S2     E1     E2     E3     E4     E5     E6
             P10    P11    P30    P31    PL     TMP    D      R
             ARC1   ARC2   ARC3   ARC4   P0     P1     *error*
             cmdecho
             )
  (defun *error* (s)
    (setvar 'cmdecho cmdecho)
    (if (= 8 (LOGAND (getvar "undoctl") 8))
      (command "_undo" "_end")
      )
    (princ)
    )
  ;;取得组码值
  (defun dxf (e i)
    (cdr (assoc i (entget e)))
    )
  ;;更新组码值
  (defun upd (e i v / a)
    (setq e (entget e))
    (if (setq a (assoc i e))
      (entmod (subst (cons i v) a e))
      )
    )
  ;;直线换向
  (defun revline (e / p0 p1)
    (setq p0 (dxf e 10)
          p1 (dxf e 11)
          )
    (setq e (entget e))
    (setq e (subst (cons 10 p1) (assoc 10 e) e)
          e (subst (cons 11 p0) (assoc 11 e) e)
          )
    (entmod e)
    )
  ;;计算pt到p1 p2 的垂足
  (defun PerToLine (pt p1 p2 / norm)
    (setq norm (mapcar '- p2 p1)
          p1   (trans p1 0 norm)
          pt   (trans pt 0 norm)
          )
    (trans (list (car p1) (cadr p1) (caddr pt)) norm 0)
    )
  (command "_undo" "_be")
  (setq cmdecho (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (while (not
           (progn
             (prompt "\n选择主管线:")
             (setq s0 (ssget ":L" '((0 . "line"))))
             (and s0
                  (= 2 (sslength s0))
                  )
             )
           )
    (princ "**选择错误**")
    )
  (setq e1 (ssname s0 0)
        e2 (ssname s0 1)
        )
  (redraw e1 3)
  (redraw e2 3)
  (while (not
           (progn
             (prompt "\n选择第一条支管线:")
             (setq s1 (ssget ":L" '((0 . "line"))))
             (and s1
                  (= 2 (sslength s1))
                  )
             )
           )
    (princ "**选择错误**")
    )
  (setq e3 (ssname s1 0)
        e4 (ssname s1 1)
        )
  (redraw e3 3)
  (redraw e4 3)
  (while (not
           (progn
             (prompt "\n选择第二条支管线:")
             (setq s2 (ssget ":L" '((0 . "line"))))
             (and s2
                  (= 2 (sslength s2))
                  )
             )
           )
    (princ "**选择错误**")
    )
  (setq e5 (ssname s2 0)
        e6 (ssname s2 1)
        )
  (redraw e3 3)
  (redraw e4 3)
  (setq p10 (dxf e1 10)
        p11 (dxf e1 11)
        p30 (dxf e3 10)
        p31 (dxf e3 11)
        )
  ;;计算e1 和e3最近的两个端点
  (setq pl
         (car
           (vl-sort
             (list (list p10 p30)
                   (list p10 p31)
                   (list p11 p30)
                   (list p11 p31)
                   )
             '(lambda (a b) (< (apply 'distance a) (apply 'distance b)))
             )
           )
        )
  ;;e1换向
  (if (not (equal (car pl) p10 1e-6))
    (revline e1)
    )
  ;;e3换向
  (if (not (equal (cadr pl) p30 1e-6))
    (revline e3)
    )
  ;;e4换向
  (if (> (distance (dxf e1 10) (dxf e4 10))
         (distance (dxf e1 10) (dxf e4 11))
         )
    (revline e4)
    )
  ;;e2换向
  (if (> (distance (dxf e1 10) (dxf e2 10))
         (distance (dxf e1 10) (dxf e2 11))
         )
    (revline e2)
    )
  ;;e5换向
  (if (> (distance (dxf e1 10) (dxf e5 10))
         (distance (dxf e1 10) (dxf e5 11))
         )
    (revline e5)
    )
  ;;e6换向
  (if (> (distance (dxf e1 10) (dxf e6 10))
         (distance (dxf e1 10) (dxf e6 11))
         )
    (revline e6)
    )
  ;;e1 e2 交换
  (if (> (distance (dxf e1 10) (dxf e3 10))
         (distance (dxf e2 10) (dxf e3 10))
         )
    (setq tmp e1
          e1  e2
          e2  tmp
          )
    )
  ;; e3 e4 交换
  (if (> (distance (dxf e1 10) (dxf e3 10))
         (distance (dxf e1 10) (dxf e4 10))
         )
    (setq tmp e3
          e3  e4
          e4  tmp
          )
    )
  ;; e5 e6 交换
  (if (> (distance (dxf e2 10) (dxf e5 10))
         (distance (dxf e2 10) (dxf e6 10))
         )
    (setq tmp e5
          e5  e6
          e6  tmp
          )
    )
  ;;主管内径
  (setq d (distance (dxf e1 10) (dxf e2 10))
        r (/ d 3)
        )
  (command "_fillet"
           "r"
           r
           "_fillet"
           (list e1 (trans (dxf e1 11) 0 1))
           (list e3 (trans (dxf e3 11) 0 1))
           )
  (setq arc1 (entlast))
  (command "_fillet"
           (list e2 (trans (dxf e2 11) 0 1))
           (list e5 (trans (dxf e5 11) 0 1))
           )
  (setq arc2 (entlast))
  (setq p0 (inters (setq p0 (dxf e3 10))
                   (polar p0 (+ (* 0.5 pi) (angle p0 (dxf e3 11))) 10)
                   (dxf e4 10)
                   (dxf e4 11)
                   nil
                   )
        )  
  (upd e4 10 p0)
  (command "_offset" "t" arc1 (trans p0 0 1) "")
  (setq arc3 (entlast))
  (setq p0 (inters (setq p0 (dxf e5 10))
                   (polar p0 (+ (* 0.5 pi) (angle p0 (dxf e5 11))) 10)
                   (dxf e6 10)
                   (dxf e6 11)
                   nil
                   )
        )
  (upd e6 10 p0)
  (command "_offset" "t" arc2 (trans p0 0 1) "")
  (setq arc4 (entlast))
  (setq
    p0 (if (equal (dxf e4 10) (vlax-curve-getStartPoint arc3) 1e-6)
         (vlax-curve-getendPoint arc3)
         (vlax-curve-getStartPoint arc3)
         )
    ) ;_ arc3 远端端点

  (setq
    p1 (if (equal (dxf e6 10) (vlax-curve-getStartPoint arc4) 1e-6)
         (vlax-curve-getendPoint arc4)
         (vlax-curve-getStartPoint arc4)
         )
    ) ;_ arc4 远端端点
  (command "_trim" arc3 "" (list arc4 (trans p1 0 1)) "")
  (command "_trim" arc4 "" (list arc3 (trans p0 0 1)) "")
  (entmake
    (list '(0 . "line")
          (cons 10 (dxf e3 10))
          (cons 11 (dxf e4 10))
          )
    )
  (entmake
    (list '(0 . "line")
          (cons 10 (dxf e5 10))
          (cons 11 (dxf e6 10))
          )
    )
  
  (setq pt (PerToLine (setq p0 (dxf e1 10)) (setq p1 (dxf e2 10)) (setq p2 (dxf e2 11))))
  (if (equal (distance p1 p2) (+ (distance pt p1) (distance pt p2)) 1e-6)
    (entmake
      (list '(0 . "line")
            (cons 10 p0)
            (cons 11 pt)
            )
      )
    (entmake
      (list '(0 . "line")
            (cons 10 p1)
            (cons 11 (vlax-curve-getclosestpointto e1 p1))
            )
      )
    )
  (setvar 'cmdecho cmdecho)
  (command "_undo" "_end")
  (princ)
  )