[分享]：[源码]region转pl 和 线转pl的程序

wkai

2. 
   
3. ;;;Written by WKAI @ XDCAD.NET________________
   
4. ;;;___________________________________________
   
5. (DEFUN c:region_to_pl (/ region_ent)
   
6. (PRINC "\n选择需要转换为PL的REGION:")
   
7. (SETVAR "cmdecho" 0)
   
8. (SETQ region_ent (SSGET '((0 . "REGION"))))
   
9. (IF region_ent
   
10.   (PROGN
    
11.    (COMMAND "._explode" region_ent)
    
12.    (COMMAND)
    
13.    (l_to_pl (SSGET "p"))
    
14.   )
    
15. )
    
16. )
    
17. (DEFUN l_to_pl (ssa / ss1 lines ent n)
    
18. (COMMAND "._undo" "be")
    
19. (SETQ ss1 (SSADD))
    
20. (REPEAT (SETQ n (SSLENGTH ssa))
    
21.   (SETQ ent (SSNAME ssa (SETQ n (1- n))))
    
22.   (IF (AND (ENTGET ent)
    
23.            (MEMBER (CDR (ASSOC 0 (ENTGET ent)))
    
24.                    '("LINE" "ARC" "POLYLINE" "LWPOLYLINE")
    
25.            )
    
26.       )
    
27.    (SETQ ss1 (SSADD ent ss1))
    
28.   )
    
29. )
    
30. (SETQ lines ss1)
    
31. (l_to_pl:main)
    
32. (COMMAND "._undo" "e")
    
33. )
    
34. (DEFUN l_to_pl:main (/ ent ss1 n)
    
35. (SETQ ent (SSNAME lines 0))
    
36. (IF (MEMBER (CDR (ASSOC 0 (ENTGET ent)))
    
37.              '("POLYLINE" "LWPOLYLINE")
    
38.      )
    
39.   (IF (/= 1 (LOGAND (CDR (ASSOC 70 (ENTGET ent))) 1))
    
40.    (COMMAND "._pedit" ent "j" lines "" "")
    
41.   )
    
42.   (COMMAND "._pedit" ent "y" "j" lines "" "")
    
43. )
    
44. (SETQ lines (SSDEL ent lines))
    
45. (SETQ ss1 (SSADD))
    
46. (REPEAT (SETQ n (SSLENGTH lines))
    
47.   (SETQ ent (SSNAME lines (SETQ n (1- n))))
    
48.   (IF (ENTGET ent)
    
49.    (SETQ ss1 (SSADD ent ss1))
    
50.   )
    
51. )
    
52. (SETQ lines ss1)
    
53. (WHILE (> (SSLENGTH lines) 0) (l_to_pl:main))
    
54. )
    
55. 
    

<br /> ;;;Written by WKAI @ XDCAD.NET________________<br /> ;;;___________________________________________<br /> (DEFUN c:region_to_pl (/ region_ent)<br /> (PRINC "\n选择需要转换为PL的REGION:")<br /> (SETVAR "cmdecho" 0)<br /> (SETQ region_ent (SSGET '((0 . "REGION"))))<br /> (IF region_ent<br />   (PROGN<br />    (COMMAND "._explode" region_ent)<br />    (COMMAND)<br />    (l_to_pl (SSGET "p"))<br />   )<br /> )<br /> )<br /> (DEFUN l_to_pl (ssa / ss1 lines ent n)<br /> (COMMAND "._undo" "be")<br /> (SETQ ss1 (SSADD))<br /> (REPEAT (SETQ n (SSLENGTH ssa))<br />   (SETQ ent (SSNAME ssa (SETQ n (1- n))))<br />   (IF (AND (ENTGET ent)<br />            (MEMBER (CDR (ASSOC 0 (ENTGET ent)))<br />                    '("LINE" "ARC" "POLYLINE" "LWPOLYLINE")<br />            )<br />       )<br />    (SETQ ss1 (SSADD ent ss1))<br />   )<br /> )<br /> (SETQ lines ss1)<br /> (l_to_pl:main)<br /> (COMMAND "._undo" "e")<br /> )<br /> (DEFUN l_to_pl:main (/ ent ss1 n)<br /> (SETQ ent (SSNAME lines 0))<br /> (IF (MEMBER (CDR (ASSOC 0 (ENTGET ent)))<br />              '("POLYLINE" "LWPOLYLINE")<br />      )<br />   (IF (/= 1 (LOGAND (CDR (ASSOC 70 (ENTGET ent))) 1))<br />    (COMMAND "._pedit" ent "j" lines "" "")<br />   )<br />   (COMMAND "._pedit" ent "y" "j" lines "" "")<br /> )<br /> (SETQ lines (SSDEL ent lines))<br /> (SETQ ss1 (SSADD))<br /> (REPEAT (SETQ n (SSLENGTH lines))<br />   (SETQ ent (SSNAME lines (SETQ n (1- n))))<br />   (IF (ENTGET ent)<br />    (SETQ ss1 (SSADD ent ss1))<br />   )<br /> )<br /> (SETQ lines ss1)<br /> (WHILE (> (SSLENGTH lines) 0) (l_to_pl:main))<br /> )<br /> <br />

qiaqiadeng

请说出程序的优点和使用方法。