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

llsheng_73

1. (defun poinpl(pt e / p e1 area area1 dist dist1)
   
2.    (setq e(vlax-ename->vla-object e)dist(distance(reverse(cdr(reverse pt)))(vlax-curve-getclosestpointto e pt))area(vla-get-area e)
   
3.          e1(car(vlax-safearray->list(vlax-variant-value(vla-offset e(* dist 1e-4)))))area1(vla-get-area e1)
   
4.          dist1(distance(reverse(cdr(reverse pt)))(vlax-curve-getclosestpointto e1 pt)))  (entdel(entlast))
   
5.    (if(< dist 1e-6)0;;线上
   
6.      (if(>(*(- area1 area)(- dist1 dist))0)1 -1)));1线内-1线外
   
7. (defun c:tt(/ s1 s2 p m n l)
   
8.   (if(setq s1(ssget"X"(list'(0 . "TEXT")(cons 1 (strcat"*"(getstring"\n匹配内容")"*")))))
   
9.     (progn(setq i -1)
   
10.       (repeat(sslength s1)
    
11.         (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)))
    
12.       (if(setq s1(ssget"X"'((0 . "*lyline")(-4 . "<OR")(70 . 1)(70 . 129)(-4 . "OR>"))))
    
13.         (progn(setq i -1)
    
14.           (repeat(sslength s1)
    
15.             (setq i(1+ i)e(ssname s1 i)l(length p)m 0)
    
16.             (while(< m l)
    
17.               (if(and(>(vla-get-area(vlax-ename->vla-object e))1e-3) (=(poinpl(nth m p)e)1))
    
18.                 (entmod(setq p(vl-remove(nth m p)p)e(entget e)m l
    
19.                              e(if(assoc 62 e)(subst'(62 . 1)(assoc 62 e)e)
    
20.                                 (append e'((62 . 1))))))
    
21.                 (setq m(1+ m)))))))))
    
22.   (princ))

(defun poinpl(pt e / p e1 area area1 dist dist1)<br />    (setq e(vlax-ename->vla-object e)dist(distance(reverse(cdr(reverse pt)))(vlax-curve-getclosestpointto e pt))area(vla-get-area e)<br />          e1(car(vlax-safearray->list(vlax-variant-value(vla-offset e(* dist 1e-4)))))area1(vla-get-area e1)<br />          dist1(distance(reverse(cdr(reverse pt)))(vlax-curve-getclosestpointto e1 pt)))  (entdel(entlast))<br />    (if(< dist 1e-6)0;;线上<br />      (if(>(*(- area1 area)(- dist1 dist))0)1 -1)));1线内-1线外<br /> (defun c:tt(/ s1 s2 p m n l)<br />   (if(setq s1(ssget"X"(list'(0 . "TEXT")(cons 1 (strcat"*"(getstring"\n匹配内容")"*")))))<br />     (progn(setq i -1)<br />       (repeat(sslength s1)<br />         (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)))<br />       (if(setq s1(ssget"X"'((0 . "*lyline")(-4 . "<OR")(70 . 1)(70 . 129)(-4 . "OR>"))))<br />         (progn(setq i -1)<br />           (repeat(sslength s1)<br />             (setq i(1+ i)e(ssname s1 i)l(length p)m 0)<br />             (while(< m l)<br />               (if(and(>(vla-get-area(vlax-ename->vla-object e))1e-3) (=(poinpl(nth m p)e)1))<br />                 (entmod(setq p(vl-remove(nth m p)p)e(entget e)m l<br />                              e(if(assoc 62 e)(subst'(62 . 1)(assoc 62 e)e)<br />                                 (append e'((62 . 1))))))<br />                 (setq m(1+ m)))))))))<br />   (princ))

我的方法比较另类一点

树櫴希德

73哥好厉害啊，佩服

树櫴希德

; 错误: Automation 错误。未提供说明。

llsheng_73

树櫴希德 发表于 2014-6-11 09:05
; 错误: Automation 错误。未提供说明。

你那是线是三维的？

树櫴希德

2维的，是LWPOLYLINE

树櫴希德

LIST 找到 1 个

                  LWPOLYLINE  图层: MJZJ
                            空间: 模型空间
                   颜色: BYLAYER    线型: CONTINUOUS
                   句柄 = 170b
            闭合
    固定宽度    0.0000
              面积   16.8172
         周长   20.3983

          于端点  X=45101.9951  Y=15339.2654  Z=   0.0000
          于端点  X=45100.7360  Y=15331.4550  Z=   0.0000
          于端点  X=45105.0911  Y=15331.7571  Z=   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))

llsheng_73

那你加上(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))

树櫴希德

奉上测试图，