样条曲线转多线.lsp

admin

1. (defun c:tt1 ()
   
2.   (defun *error* (msg)
   
3.     (setq *error* nil)                    ;;设置空错误信息
   
4.     ;(princ msg)                          ;;打印错误信息
   
5.     (setvar "osmode" _lch_old_os)         ;;恢复捕捉
   
6.     (setvar "blipmode" _lch_old_bmd)      ;;恢复光标
   
7.     (setvar "clayer" _lch_old_clayer)     ;;恢复线型
   
8.     (setvar "textstyle" _lch_old_text)    ;;恢复字体
   
9.     (setvar "highlight" _lch_old_hlt)     ;;恢复对象亮显
   
10.     (setvar "elevation" _lch_old_elev)    ;;恢复当前UCS的当前标高
    
11.     (setvar "plinewid" _lch_old_plwid)    ;;恢复多段线宽度
    
12.     (setvar "cecolor" _lch_old_cecolor)   ;;恢复颜色
    
13.     (command "_.undo" "end")              ;;编程结束
    
14.     (setvar "cmdecho" _lch_old_cmd)       ;;恢复普通命令提示
    
15.     (princ)
    
16.   );end_de
    
17.   (lch_cxks) ;程序开始
    
18.   
    
19.   (setvar "osmode" _lch_old_os)         ;;恢复捕捉
    
20.   (setvar "osmode" 0)            ;;关闭捕捉
    
21.   
    
22.         (setq ss (ssget '((0 . "SPLINE"))))
    
23.         (setq n 0)
    
24.         (repeat (sslength ss)
    
25.                 (setq ptlst (lch:Massoc 11 (entget (ssname ss n))))
    
26.                 (lch:lwpolyline ptlst nil nil nil nil nil)
    
27.                 (setq n (1+ n))
    
28.         )
    
29.        
    
30.   (lch_cxjs) ;程序结束
    
31. );end_de
    
32. 
    
33. ;;[功能] 多段线各顶点
    
34. ;;示例 (lch:Massoc 10 (entget (car (entsel))))
    
35. ;; 特别适合多段线各顶点
    
36. (defun lch:Massoc (key alist)
    
37.   (apply
    
38.     'append
    
39.     (mapcar '(lambda (x)
    
40.          (if (eq (car x) key)
    
41.      (list (cdr x))
    
42.          )
    
43.        )
    
44.       alist
    
45.     )
    
46.   )
    
47. )
    
48. 
    
49. ;点表生成多段线
    
50. ;线宽=nil，线宽为0
    
51. ;是否闭合=nil，不闭合
    
52. ;图层=nil，为当前图层
    
53. ;颜色=nil，为当前图层颜色
    
54. ;线型比例=nil，为1
    
55. ;(lch:lwpolyline 点表 是否闭合 线宽 图层 颜色 线型比例)
    
56. ;(lch:lwpolyline (list (1 2) (2 3)) T 2 "中心线" 6 5)
    
57. (defun lch:lwpolyline (lst dxf70 plwid lay lwplint lwplbili)
    
58.   (entmake
    
59.     (append
    
60.       (list
    
61.         '(0 . "LWPOLYLINE")
    
62.         '(100 . "AcDbEntity")
    
63.         '(100 . "AcDbPolyline")
    
64.         (cons 90 (length lst)) ;点表
    
65.         (if (= dxf70 T)
    
66.           (cons 70 1)          ;闭合与不闭合
    
67.           (cons 70 0)
    
68.         );if
    
69.         (if plwid
    
70.           (cons 43 plwid)      ;线宽
    
71.           (cons 43 0)
    
72.         );if
    
73.         (if lay
    
74.           (cons 8 lay)         ;图层
    
75.           (cons 8 (getvar "clayer"))
    
76.         );if
    
77.         (if lwplint
    
78.           (cons 62 lwplint)    ;颜色
    
79.           (cons 62 256)
    
80.         );if
    
81.         (if lwplbili
    
82.           (cons 48 lwplbili)   ;线型比例
    
83.           (cons 48 1.0)
    
84.         );if
    
85.       );end_list
    
86.       (mapcar '(lambda (pt) (cons 10 pt)) lst )
    
87.     );end_append
    
88.   );end_entmake
    
89. );end_de
    
90. 
    
91. ;;;通用程序开始
    
92. (defun lch_cxks ()
    
93.   (setq _lch_old_cmd (getvar "cmdecho")      ;;保存普通命令提示
    
94.     _lch_old_os (getvar "osmode")            ;;保存捕捉
    
95.     _lch_old_bmd (getvar "blipmode")         ;;保存光标
    
96.     _lch_old_hlt (getvar "highlight")        ;;保存对象亮显
    
97.     _lch_old_elev (getvar "elevation")       ;;保存当前UCS的当前标高
    
98.     _lch_old_plwid (getvar "plinewid")       ;;保存多段线宽度
    
99.     _lch_old_ucsicon (getvar "ucsicon")
    
100.     _lch_old_cecolor (getvar "cecolor")      ;;保存颜色
     
101.     _lch_old_clayer (getvar "clayer")        ;;保存线型
     
102.     _lch_old_text (getvar "textstyle")       ;;保存字体
     
103.   );end_setq
     
104.   (setvar "cmdecho" 0)           ;;设置普通命令不提示
     
105.   (command "_.undo" "_be")       ;;编程开始
     
106.   (setvar "osmode" 0)            ;;关闭捕捉
     
107.   (setvar "blipmode" 0)          ;;关闭光标
     
108.   (setvar "elevation" 0)         ;;关闭当前UCS的当前标高
     
109.   (setvar "plinewid" 0)          ;;设置多段线宽度
     
110.   (setvar "pickstyle" 0)
     
111.   (setvar "cecolor" "bylayer")
     
112. );end_de
     
113. 
     
114. ;;通用程序结束
     
115. (defun lch_cxjs ()
     
116.   (setvar "osmode" _lch_old_os)         ;;恢复捕捉
     
117.   (setvar "blipmode" _lch_old_bmd)      ;;恢复光标
     
118.   (setvar "clayer" _lch_old_clayer)     ;;恢复线型
     
119.   (setvar "textstyle" _lch_old_text)    ;;恢复字体
     
120.   (setvar "highlight" _lch_old_hlt)     ;;恢复对象亮显
     
121.   (setvar "elevation" _lch_old_elev)    ;;恢复当前UCS的当前标高
     
122.   (setvar "plinewid" _lch_old_plwid)    ;;恢复多段线宽度
     
123.   (setvar "cecolor" _lch_old_cecolor)   ;;恢复颜色
     
124.   (command "_.undo" "_end")             ;;编程结束
     
125.   (setvar "cmdecho" _lch_old_cmd)       ;;恢复普通命令提示
     
126.   (princ)
     
127. );end_de

复制代码