检查cad检查线压盖lisp_lisp编程：请问，CAD中图形如何检查闭合

展开全部

;函数功能：找出封闭线

(defun c:tes ( / &jd1 &k1 &k2 &p1 &ss1 &ss2 &ss3 &ss5 x y)

(setvar "cmdecho" 0)

(setvar "blipmode" 0)

(if (null vlax-dump-object) (vl-load-com) )

(setq &jd1 1.0)

(if (setq &ss1 (a1611131));选择不封闭的对象

(progn

(setq &ss2 '())

(while (and (setq &k1 (car &ss1)) (setq &ss1 (cdr &ss1)))

(setq &p1 (vlax-curve-getStartPoint &k1) &ss5 (list &k1))

(setq &ss3 (a1611132 &ss1 &p1 &jd1) &k2 (car &ss3) &ss1 (cadr &ss3))

(while &k2

(setq &ss5 (cons &k2 &ss5))

(if &ss1

(progn;;2

(setq &p1 (cadar (vl-sort

(mapcar '(lambda (x) (list (distance &p1 x) x))

(list (vlax-curve-getStartPoint &k2) (vlax-curve-getEndPoint &k2)))

'(lambda (x y) (> (car x) (car y))))

))

(setq &ss3 (a1611132 &ss1 &p1 &jd1) &k2 (car &ss3) &ss1 (cadr &ss3))

);progn;2

(setq &k2 nil)

);if;2

);while;2

(setq &p1 (vlax-curve-getEndPoint &k1) &ss5 (reverse &ss5))

(setq &ss3 (a1611132 &ss1 &p1 &jd1) &k2 (car &ss3) &ss1 (cadr &ss3))

(while &k2

(setq &ss5 (cons &k2 &ss5))

(if &ss1

(progn;;3

(setq &p1 (cadar (vl-sort

(mapcar '(lambda (x) (list (distance &p1 x) x))

(list (vlax-curve-getStartPoint &k2) (vlax-curve-getEndPoint &k2)))

'(lambda (x y) (> (car x) (car y))))

))

(setq &ss3 (a1611132 &ss1 &p1 &jd1) &k2 (car &ss3) &ss1 (cadr &ss3))

);progn;3

(setq &k2 nil)

);if;3

);while;3

(if (cadr &ss5) (a1611133 &ss5 &jd1) )

);while

)

)

(princ)

)

;函数功能：计算坐e68a84e8a2ad3231313335323631343130323136353331333363383362标

(defun a1611135 (obj @p5 / @p5 obj)

(if (= (cadr @p5) 1)

(list (vlax-curve-getStartPoint obj) (vlax-curve-getEndPoint obj))

(list (vlax-curve-getEndPoint obj) (vlax-curve-getStartPoint obj))

)

)

;函数功能：判断起点与端点

(defun a1611134 (obj @p1 / @p1 obj x y)

(setq @p1 (caddr @p1))

(cdar (vl-sort

(mapcar '(lambda (x) (cons (distance @p1 (car x)) x))

(list (list (vlax-curve-getStartPoint obj) 1 (vlax-curve-getEndPoint obj)) (list (vlax-curve-getEndPoint obj) 2 (vlax-curve-getStartPoint obj))))

'(lambda (x y) (

)

;函数功能：分析坐标

(defun a1611133 (&ss5 cd1 / &k1 &k2 &p1 &p2 &p3 &p4 &p5 &ss2 &ss5 cd1 x y)

(setq &k1 (car &ss5) &k2 (cadr &ss5)

&p1 (vlax-curve-getStartPoint &k1) &p2 (vlax-curve-getEndPoint &k1)

&p3 (vlax-curve-getStartPoint &k2) &p4 (vlax-curve-getEndPoint &k2)

&p5 (cdar (vl-sort

(mapcar '(lambda (x) (list (distance (car x) (cadr x)) (car x) (caddr x) (cadddr x)))

(list (list &p1 &p3 2 &p3) (list &p1 &p4 2 &p4) (list &p2 &p3 1 &p3) (list &p2 &p4 1 &p4)))

'(lambda (x y) (

)

(setq &p1 (car (a1611135 &k1 &p5)) &ss2 (cdr &ss5))

(setq &p2 (cadr (last (mapcar '(lambda (x) (a1611135 x (setq &p5 (a1611134 x &p5)))) &ss2))))

(if (

)

;函数功能：计算距离

(defun a1611132 (&ss1 @p1 cd1 / &ss1 &ss2 @p1 cd1 x)

(setq &ss1 (mapcar '(lambda (x) (list (distance @p1 (vlax-curve-getStartPoint x)) (distance @p1 (vlax-curve-getEndPoint x)) x)) &ss1))

(if (and (setq &ss2 (mapcar 'caddr (vl-remove-if-not '(lambda (x) (or ( (length &ss2) 1)) (setq &ss2 '()) )

(setq &ss1 (mapcar 'caddr (vl-remove-if '(lambda (x) (or (

(list (car &ss2) &ss1)

)

;函数功能：选择不封闭对象;封闭对象改变颜色

(defun a1611131 ( / &k1 &kw1 &ss1 &ss2 i x)

(setq &ss1 '() &ss2 '())

(princ "\n请选择曲线")

(if (setq &kw1 (ssget '((0 . "*LINE,CIRCLE,ARC,HELIX,ELLIPSE"))))

(progn

(setq i -1.0)

(while (setq &k1 (ssname &kw1 (setq i (1+ i))))

(if (vlax-curve-isClosed (setq &k1 (vlax-ename->vla-object &k1))) (setq &ss1 (cons &k1 &ss1)) (setq &ss2 (cons &k1 &ss2)) )

);while

(if (car &ss2) (mapcar '(lambda (x) (vla-put-color x 1)) &ss2) )

(if (car &ss1) (mapcar '(lambda (x) (vla-put-color x 7)) &ss1) )

)

)

(if (car &ss2) &ss2 nil)

)

如果对象封闭，颜色为7【白色】，如果不封闭，颜色为1【红色】。