[autolisp] 有趣的trim和extend的结合.lsp

;;; 有趣的trim和extend的结合                               *
;;; 初始创意Stig Madsen                                    *
;;; 用途，选择一根直线，再选择其他直线段Line，             *
;;; 后选Line会自动延伸extend或者修剪trim                   *
;;; qjchen之修改，重写大部分代码，将边界线改为更多类型     *
;;; 之中使用了 xdcad 狂刀的求两物体交点的代码，谢谢狂刀兄  *
(defun C:q ( / edge ep i int line linename liness sp)
  (vl-load-com)
  (while (not edge)
    (setq edge (car (entsel "\n 请选择边界线:")))
    (redraw edge 3)
  )
  (prompt "\n 请选择需要extend或者trim的直线段: ")
  (if (setq i 0
            liness (ssget '((0 . "LINE")))
      )
    (repeat (sslength liness)
      (setq line (entget (ssname liness i))
            sp (cdr (assoc 10 line))
            ep (cdr (assoc 11 line))
      )
      (if (setq int (nth 0 (x_intlst edge (ssname liness i) acExtendOtherEntity)))
        (if (< (distance int sp) (distance int ep))
          (entmod (subst (cons 10 int)(assoc 10 line) line))
          (entmod (subst (cons 11 int) (assoc 11 line)line))
        )
      )
      (setq i (1+ i))
    )
    (princ "\n 没有找到需要被extend或者trim的直线段")
  )
  (redraw edge 4)
)
;;; by 狂刀 at xdcad
(defun x_intlst (obj1 obj2 param / intlst1 intlst2 ptlst)
  (if (= 'ENAME (type obj1))
    (setq obj1 (vlax-ename->vla-object obj1))
  )
  (if (= 'ENAME (type obj2))
    (setq obj2 (vlax-ename->vla-object obj2))
  )
  (setq intlst1 (vlax-variant-value (vla-intersectwith obj1 obj2 param)))
  (if (< 0 (vlax-safearray-get-u-bound intlst1 1))
    (progn
      (setq intlst2 (vlax-safearray->list intlst1))
      (while (> (length intlst2) 0)
        (setq ptlst (cons (list (car intlst2) (cadr intlst2) (caddr intlst2))
                          ptlst
                    )
              intlst2 (cdddr intlst2)
        )
      )
    )
  )
  ptlst
)

(princ "\n By [e-mail], 有趣的trim和extend的结合，命令名:q")
(princ)