树櫴希德
发表于 2014-6-11 20:40:28
73哥程序(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))
树櫴希德
发表于 2014-6-11 20:43:45
(defun c:tta ( / e i pts se ss x)
(setq ss (ssget '((0 . "LWPOLYLINE"))))
(repeat (setq i (sslength ss))
(setq e (ssname ss (setq i (1- i)))
pts (mapcar 'cdr(vl-remove-if-not '(lambda (x) (= (car x) 10))(entget e)))
se (ssget "cp" pts '((0 . "*text") (1 . "*填方*")))
)
(if se (Vlax-Put-Property (Vlax-Ename->Vla-Object e) 'Color 1 ))
)
)
q2院长程序
q3_2006
发表于 2014-6-11 21:16:33
树櫴希德 发表于 2014-6-11 20:43 static/image/common/back.gif
(defun c:tta ( / e i pts se ss x)
(setq ss (ssget '((0 . "LWPOLYLINE"))))
(repeat (setq i (sslengt ...
拜托不要加院长到我名后面....我很尊敬院长的...不要开这种玩笑呀....
wufengbo
发表于 2014-7-22 22:18:36
热心人好多啊,希望这贴被更多人看到。
chbddzx12
发表于 2015-2-2 23:00:31
很好~~~~~~~~~~~~~~~
wu112031853
发表于 2016-1-15 17:08:32
选择砖砼时,连砼2也选上啦!!!用的73哥的程序
wu112031853
发表于 2016-1-15 17:09:47
还有Automation 错误
wu112031853
发表于 2016-1-15 17:12:08
参数类型错误: lselsetp nil