读取LIST命令生成的多段线文件重新绘出多段线

newer

根据这个帖子的申请整理后提供个插件。http://bbs.xdcad.net/thread-704143-1-1.html

[sell=3]

1. (defun c:XDTB_PolyFileRead ( / bulge bulges clr clr1 cw e ews f ff fn isclosed lyr lyr1 new nums old px py sw sws x)
   
2.   (if (setq fn (xdrx_system_selectFiles "选取POLYLINE信息文件名" "" "txt" 0))
   
3.     (progn
   
4.       (setq ff nil
   
5.             bulges nil
   
6.             sws nil
   
7.             ews nil
   
8.       )
   
9.       (if (setq f (XD::List:FromFile (car fn)))
   
10.         (progn
    
11.           (setq nums 0)
    
12.           (mapcar
    
13.             '(lambda (x)
    
14.                (if (xdrx_string_find x "闭合")
    
15.                  (setq isclosed t)
    
16.                )
    
17.                (if (setq lyr (XD::String:MatchNumAfter x "图层:" nil))
    
18.                  (setq lyr1 (car lyr))
    
19.                )
    
20.                (if (setq clr (XD::String:MatchNumAfter x "颜色:" nil))
    
21.                  (setq clr1 (car clr))
    
22.                )
    
23.                (if (setq cw (XD::String:MatchNumAfter x "固定宽度" nil))
    
24.                  (setq cw (car cw))
    
25.                )
    
26.                (if (and
    
27.                      (xdrx_string_find x "于端点")
    
28.                      (setq px (XD::String:MatchNumAfter x "x=" nil))
    
29.                      (setq py (XD::String:MatchNumAfter x "y=" nil))
    
30.                    )
    
31.                  (setq ff (cons (list (atof (car px)) (atof (car py))) ff)
    
32.                        nums (1+ nums)
    
33.                  )
    
34.                )
    
35.                (if (setq sw (XD::String:MatchNumAfter x "起点宽度" nil))
    
36.                  (setq sws (cons (list (- nums 1) (atof (car sw))) sws))
    
37.                )
    
38.                (if (setq sw (XD::String:MatchNumAfter x "端点宽度" nil))
    
39.                  (progn
    
40.                    (setq old (assoc (- nums 1) sws)
    
41.                          new (append
    
42.                                old
    
43.                                (list (atof (car sw)))
    
44.                              )
    
45.                          sws (subst
    
46.                                new
    
47.                                old
    
48.                                sws
    
49.                              )
    
50.                    )
    
51.                  )
    
52.                )
    
53.                (if (setq bulge (XD::String:MatchNumAfter x "凸度" nil))
    
54.                  (setq bulges (cons (list (- nums 1) (atof (car bulge)))
    
55.                                     bulges
    
56.                               )
    
57.                  )
    
58.                )
    
59.              )
    
60.             f
    
61.           )
    
62.           (setq ff (reverse ff))
    
63.           (setq e (xdrx_polyline_make ff))
    
64.           (mapcar
    
65.             '(lambda (x)
    
66.                (xdrx_setpropertyvalue e "bulgeat" x)
    
67.              )
    
68.             bulges
    
69.           )
    
70.           (mapcar
    
71.             '(lambda (x)
    
72.                (xdrx_setpropertyvalue e "widthat" x)
    
73.              )
    
74.             sws
    
75.           )
    
76.           (if isclosed
    
77.             (xdrx_setpropertyvalue e "isclosed" t)
    
78.           )
    
79.           (if cw
    
80.             (xdrx_setpropertyvalue e "ConstantWidth" cw)
    
81.           )
    
82.           (xdrx_setpropertyvalue e "layer" lyr1)
    
83.           (xdrx_setpropertyvalue e "color" (atoi clr1))
    
84.         )
    
85.       )
    
86.     )
    
87.   )
    
88.   (princ)
    
89. )
    
90. 
    

(defun c:XDTB_PolyFileRead ( / bulge bulges clr clr1 cw e ews f ff fn isclosed lyr lyr1 new nums old px py sw sws x)<br />   (if (setq fn (xdrx_system_selectFiles "选取POLYLINE信息文件名" "" "txt" 0))<br />     (progn<br />       (setq ff nil<br />             bulges nil<br />             sws nil<br />             ews nil<br />       )<br />       (if (setq f (XD::List:FromFile (car fn)))<br />         (progn<br />           (setq nums 0)<br />           (mapcar<br />             '(lambda (x)<br />                (if (xdrx_string_find x "闭合")<br />                  (setq isclosed t)<br />                )<br />                (if (setq lyr (XD::String:MatchNumAfter x "图层:" nil))<br />                  (setq lyr1 (car lyr))<br />                )<br />                (if (setq clr (XD::String:MatchNumAfter x "颜色:" nil))<br />                  (setq clr1 (car clr))<br />                )<br />                (if (setq cw (XD::String:MatchNumAfter x "固定宽度" nil))<br />                  (setq cw (car cw))<br />                )<br />                (if (and<br />                      (xdrx_string_find x "于端点")<br />                      (setq px (XD::String:MatchNumAfter x "x=" nil))<br />                      (setq py (XD::String:MatchNumAfter x "y=" nil))<br />                    )<br />                  (setq ff (cons (list (atof (car px)) (atof (car py))) ff)<br />                        nums (1+ nums)<br />                  )<br />                )<br />                (if (setq sw (XD::String:MatchNumAfter x "起点宽度" nil))<br />                  (setq sws (cons (list (- nums 1) (atof (car sw))) sws))<br />                )<br />                (if (setq sw (XD::String:MatchNumAfter x "端点宽度" nil))<br />                  (progn<br />                    (setq old (assoc (- nums 1) sws)<br />                          new (append<br />                                old<br />                                (list (atof (car sw)))<br />                              )<br />                          sws (subst<br />                                new<br />                                old<br />                                sws<br />                              )<br />                    )<br />                  )<br />                )<br />                (if (setq bulge (XD::String:MatchNumAfter x "凸度" nil))<br />                  (setq bulges (cons (list (- nums 1) (atof (car bulge)))<br />                                     bulges<br />                               )<br />                  )<br />                )<br />              )<br />             f<br />           )<br />           (setq ff (reverse ff))<br />           (setq e (xdrx_polyline_make ff))<br />           (mapcar<br />             '(lambda (x)<br />                (xdrx_setpropertyvalue e "bulgeat" x)<br />              )<br />             bulges<br />           )<br />           (mapcar<br />             '(lambda (x)<br />                (xdrx_setpropertyvalue e "widthat" x)<br />              )<br />             sws<br />           )<br />           (if isclosed<br />             (xdrx_setpropertyvalue e "isclosed" t)<br />           )<br />           (if cw<br />             (xdrx_setpropertyvalue e "ConstantWidth" cw)<br />           )<br />           (xdrx_setpropertyvalue e "layer" lyr1)<br />           (xdrx_setpropertyvalue e "color" (atoi clr1))<br />         )<br />       )<br />     )<br />   )<br />   (princ)<br /> )<br /> <br />

[/sell]

AxueLJ

学习学习！！！！！

xcxjxh@sohu.com

学习学习！！！！！

qidisuifeng

如何购买？

liulisheng