样条曲线转多线.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
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. )
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
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
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

复制代码