- ;判断点是否在线段上:
- ; 设点为Q,线段为P1P2 ,判断点Q在该线段上的依据是:( Q - P1 ) × ( P2 - P1 ) = 0 且 Q 在以 P1,P2为对角顶点的矩形内。前者保证Q点在直线P1P2上,后者是保证Q点不在线段P1P2的延长线或反向延长线上,对于这一步骤的判断可以用以下过程实现:
- ; ON-SEGMENT(pi,pj,pk)
- ; if min(xi,xj) <= xk <= max(xi,xj)
- ; and min(yi,yj) <= yk <= max(yi,yj)
- ; then return true;
- ; else return false;
- ; 特别要注意的是,由于需要考虑水平线段和垂直线段两种特殊情况,min(xi,xj)<=xk<=max(xi,xj)和min(yi,yj)<=yk<=max(yi,yj)两个条件必须同时满足才能返回真值。
- (defun c:tt(/ p1 p2 px sspline ssline i n px10 px11 plpts pts plptsn ssdelline ssbkline ptlst ptmin ptmax angsub angsub2 el1 nlin)
- ;↓获取点表内部函数**********************************************************
- (defun massoc (lst key)
- (vl-remove-if '(lambda (x) (/= key (car x))) lst)
- )
- ;↑获取点表内部函数*********************************************************
- ;;;↓判断点是否在线段上******************************************************
- (defun nsk:IsPtOnLine (px pt1 pt2 fz)
- (and
- (numberp fz)
- (equal (distance pt1 pt2)
- (+ (distance pt1 px) (distance pt2 px))
- fz
- )
- )
- )
- ;;↓判断点是否与线共线。***************************************************************************
- ;;1 p1是否在p2 p3线上,返回0.0
- ;;p1 is a point;p2 and p3 are points that form a line segment;;returns 1 is p1 is on one side;;
- ;;-1 if on the other side
- ;; 0 if on the line
- (defun PT_side (p1 p2 p3 / a dx dx1 dy dy1)
- (setq dx (- (car p3) (car p2))
- dy (- (cadr p3) (cadr p2))
- dx1 (- (car p1) (car p2))
- dy1 (- (cadr p1) (cadr p2))
- ) ;setq
- (setq a (- (* dx dy1) (* dy dx1))
- a (rtos a 2 6)
- a (atof a)
- ) ;setq
- (if (equal 0.0 a 0.5)
- (setq a 0.0)
- ) ;setq
- (print "判定结果是:")
- (print a)
- a
- )
- ;;;↑判断点是否与线共线。**************************************************************************
- (defun 3pangle( p1 p2 px / p3-p1p2 p3-p2p1 YN);;;判断px是否与直线p1-p2共线。
- (setq px-p1p2 (- (angle p1 px) (angle p1 p2 ))
- px-p2p1 (- (angle p2 px) (angle p2 p1)))
- (if (or (equal 0.0 px-p1p2 0.1) (equal 0.0 px-p2p1 0.1))
- (setq yn "Y")
- (setq yn "N")
- )
- yn
- )
- ;;;程序主体******************************************************************************************
- (setq sspline (ssget '((0 . "*POLYLINE")))
- ssline (ssget '((0 . "line")))
- i 0
- ssdelline (ssadd)
- ssbkline 0 )
- (setvar "cmdecho" 0)
-
- (while (< i (sslength sspline)) ;;;①开始sspline循环
- (setq plpts (massoc (entget (ssname sspline i)) 10) ;;;获得第i个多段线的顶点坐标(含标识码10)
- plptsN 0
- )
- (repeat (length plpts) ;;;↓②开始第i根多段线顶点循环。
- (setq p1 (cdr (car plpts)) ;;;(1)循环结束后,将第一个点的坐标放到表plpts的最后,每次都都是取得后续连个点,
- p2 (cdr (cadr plpts)) ;;;(2)repeat的长度等于点数,是为了闭合多段线全部取到。
- p1 (reverse (cons 0.0 (reverse p1))) ;;;(3)此处用【cdr】是为了去掉元素中的标识码 10。
- p2 (reverse (cons 0.0 (reverse p2)))
- )
- ; (print p1)(print p2)
- (setq n 0) ;直线选择集起始值为0
- (repeat (sslength ssLine) ;;;↓③开始判断line线repeat。
- ;(print (strcat "第" (rtos n )"次循环"))
- (setq px10 (cdr (assoc 10 (entget (ssname ssLine n))))
- px11 (cdr (assoc 11 (entget (ssname ssLine n)))) ; (mapcar '(lambda (pt)(list (car pt) (cadr pt))) 3dplist)
- )
- (setq ptlst (list px10 px11 p1 p2))
- (if (or (equal "Y" (3pangle p1 p2 px10))(equal "Y" (3pangle p1 p2 px11))) ;;;↓④开始第n根line线判断。
- (progn
- (if (and (nsk:IsPtOnLine px10 P1 P2 1.0) (nsk:IsPtOnLine px11 P1 P2 1.0))
- (ssadd (ssname ssline n) ssdelline)
-
- (progn
- (if (or (nsk:IsPtOnLine px10 P1 P2 1.0) (nsk:IsPtOnLine px11 P1 P2 1.0))
- (progn
-
- (setq ptmin (list (apply 'min (mapcar 'car ptlst))(apply 'min (mapcar 'cadr ptlst)) '0.0))
- (setq ptmax (list (apply 'max (mapcar 'car ptlst))(apply 'max (mapcar 'cadr ptlst)) '0.0))
- (setq el1 (entget (ssname ssline n)))
-
- (cond
- ((and (equal ptmax p2 1) (equal ptmin px10 1)) (setq el1 (subst (cons 11 p1)(assoc 11 el1) el1)))
- ((and (equal ptmax p2 1) (equal ptmin px11 1)) (setq el1 (subst (cons 10 p1)(assoc 10 el1) el1)))
- ((and (equal ptmax p1 1) (equal ptmin px10 1)) (setq el1 (subst (cons 11 p2)(assoc 11 el1) el1)))
- ((and (equal ptmax p1 1) (equal ptmin px11 1)) (setq el1 (subst (cons 10 p2)(assoc 10 el1) el1)))
- ((and (equal ptmin p2 1) (equal ptmax px10 1)) (setq el1 (subst (cons 11 p1)(assoc 11 el1) el1)))
- ((and (equal ptmin p2 1) (equal ptmax px11 1)) (setq el1 (subst (cons 10 p1)(assoc 10 el1) el1)))
- ((and (equal ptmin p1 1) (equal ptmax px10 1)) (setq el1 (subst (cons 11 p2)(assoc 11 el1) el1)))
- ((and (equal ptmin p1 1) (equal ptmax px11 1)) (setq el1 (subst (cons 10 p2)(assoc 10 el1) el1)))
- )
- (entmod el1)
- (setq ssbkline (1+ ssbkline))
- )
- )
- )))
- ;(command "BREAK" (ssname ssline n) p1 p2)
- ;(setq ssbkline (1+ ssbkline)))
-
- );;; ↑④结束第n根line线判断。
- (setq n (1+ n)) ;;;控制③repeat循环不能动。
- ) ;;;↑③结束判断line线repeat。
- (setq plpts (reverse (cons (car plpts ) (reverse (cdr plpts)))))
- ) ;;↑②结束第i根多段线顶点循环。
-
- (setq i (1+ i))
- ) ;;结束while循环。
- (if (/= 0 (sslength ssdelline))
- (progn
- (print (strcat "***共删除"(rtos (sslength ssdelline)) "根线。***")) (command "._erase" ssdelline ""))
- (print (strcat "***共删除0根线***")))
- (print (strcat "***共截断"(rtos ssbkline) "根线。***"))
- (setq ssdelline nil)
- (setvar "cmdecho" 1)
- (princ)
- ) ;;结束defun。
- ;;;*******************************************************************************************************************
|