如何根据闭合多段线内文字改多段线颜色

树櫴希德 · 发表于 2014-6-11 20:40

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

(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 ))
)
)
[q3_2006]q2院长程序

q3_2006 · 发表于 2014-6-11 21:16

树櫴希德发表于 2014-6-11 20:43
(defun c:tta ( / e i pts se ss x)
(setq ss (ssget '((0 . "LWPOLYLINE"))))
(repeat (setq i (sslengt ...

拜托不要加院长到我名后面....我很尊敬院长的...不要开这种玩笑呀....

wufengbo · 发表于 2014-7-22 22:18

热心人好多啊，希望这贴被更多人看到。

chbddzx12 · 发表于 2015-2-2 23:00

很好~~~~~~~~~~~~~~~

wu112031853 · 发表于 2016-1-15 17:08

选择砖砼时，连砼2也选上啦！！！用的73哥的程序

wu112031853 · 发表于 2016-1-15 17:09

还有Automation 错误

wu112031853 · 发表于 2016-1-15 17:12

参数类型错误: lselsetp nil

账号		自动登录	找回密码
密码			注册