本帖最后由 llsheng_73 于 2014-6-11 20:29 编辑
(defun poinpl(pt e / p e1 area area1 dist dist1)
(setq e(vlax-ename->vla-object e)dist(distance(reverse(cdr(reverse pt)))(vlax-curve-getclosestpointto e pt))area(vla-get-area e)
e1(car(vlax-safearray->list(vlax-variant-value(vla-offset e(* dist 1e-4)))))area1(vla-get-area e1)
dist1(distance(reverse(cdr(reverse pt)))(vlax-curve-getclosestpointto e1 pt)))(entdel(entlast))
(if(< dist 1e-6)0;;线上
(if(>(*(- area1 area)(- dist1 dist))0)1 -1)));1线内-1线外
(defun c:tt(/ s1 s2 p m n l)
(if(setq s1(ssget"X"(list'(0 . "TEXT")(cons 1 (strcat"*"(getstring"\n匹配内容")"*")))))
(progn(setq i -1)
(repeat(sslength s1)
(setq i(1+ i)e(entget(ssname s1 i))p(cons(if(equal(cdr(assoc 10 e))'(0 0 0))(cdr(assoc 11 e))(cdr(assoc 10 e)))p)))
(if(setq s1(ssget"X"'((0 . "*lyline")(-4 . "<OR")(70 . 1)(70 . 129)(-4 . "OR>"))))
(progn(setq i -1)
(repeat(sslength s1)
(setq i(1+ i)e(ssname s1 i)l(length p)m 0)
(while(< m l)
(if(and(>(vla-get-area(vlax-ename->vla-object e))1e-3) (=(poinpl(nth m p)e)1))
(entmod(setq p(vl-remove(nth m p)p)e(entget e)m l
e(if(assoc 62 e)(subst'(62 . 1)(assoc 62 e)e)
(append e'((62 . 1))))))
(setq m(1+ m)))))))))
(princ))
我的方法比较另类一点
73哥好厉害啊，佩服
; 错误: Automation 错误。未提供说明。
树櫴希德 发表于 2014-6-11 09:05 static/image/common/back.gif
; 错误: Automation 错误。未提供说明。
你那是线是三维的？
2维的，是LWPOLYLINE
LIST 找到 1 个
LWPOLYLINE图层: MJZJ
空间: 模型空间
颜色: BYLAYER 线型: CONTINUOUS
句柄 = 170b
闭合
固定宽度 0.0000
面积 16.8172
周长 20.3983
于端点X=45101.9951Y=15339.2654Z= 0.0000
于端点X=45100.7360Y=15331.4550Z= 0.0000
于端点X=45105.0911Y=15331.7571Z= 0.0000
(entget (car (entsel ""))) ((-1 . <图元名: 7e10a518>) (0 . "LWPOLYLINE")
(330 . <图元名: 7e10ecc0>) (5 . "106B") (100 . "AcDbEntity") (67 . 0) (410 .
"Model") (8 . "MJZJ") (6 . "Continuous") (100 . "AcDbPolyline") (90 . 3) (70 .
129) (43 . 0.0) (38 . 0.0) (39 . 0.0) (10 45127.1 15304.9) (40 . 0.0) (41 .
0.0) (42 . 0.0) (10 45124.5 15304.4) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10
45127.3 15303.2) (40 . 0.0) (41 . 0.0) (42 . 0.0) (210 0.0 0.0 1.0))
那你加上(vl-load-com)?
还是不行(vl-load-com)
(defun poinpl(pt e / p e1 area area1 dist dist1)
(setq e(vlax-ename->vla-object e)dist(distance pt(vlax-curve-getclosestpointto e pt))area(vla-get-area e)
e1(car(vlax-safearray->list(vlax-variant-value(vla-offset e(* dist 0.2)))))area1(vla-get-area e1)
dist1(distance pt(vlax-curve-getclosestpointto e1 pt)))
(entdel(entlast))
(if(< dist 1e-6)0;;线上
(if(>(*(- area1 area)(- dist1 dist))0)1 -1)));1线内-1线外
(defun c:tta(/ s1 s2 p m n l)
(if(setq s1(ssget"X"(list'(0 . "TEXT")(cons 1 (strcat"*"(getstring"\n匹配内容")"*")))))
(progn(setq i -1)
(repeat(sslength s1)
(setq i(1+ i)e(entget(ssname s1 i))p(cons(if(equal(cdr(assoc 10 e))'(0 0 0))(cdr(assoc 11 e))(cdr(assoc 10 e)))p)))
(if(setq s1(ssget"X"'((0 . "lwpolyline")(-4 . "<OR")(70 . 1)(70 . 129)(-4 . "OR>"))))
(progn(setq i -1)
(repeat(sslength s1)
(setq i(1+ i)e(ssname s1 i)l(length p)m 0)
(while(< m l)
(if(=(poinpl(nth m p)e)1)
(entmod(setq p(vl-remove(nth m p)p)e(entget e)m l
e(if(assoc 62 e)(subst'(62 . 1)(assoc 62 e)e)
(append e'((62 . 1))))))
(setq m(1+ m)))))))))
(princ))
奉上测试图，