样条曲线转多线.lsp
(defun c:tt1 ()(defun *error* (msg)
(setq *error* nil) ;;设置空错误信息
;(princ msg) ;;打印错误信息
(setvar "osmode" _lch_old_os) ;;恢复捕捉
(setvar "blipmode" _lch_old_bmd) ;;恢复光标
(setvar "clayer" _lch_old_clayer) ;;恢复线型
(setvar "textstyle" _lch_old_text) ;;恢复字体
(setvar "highlight" _lch_old_hlt) ;;恢复对象亮显
(setvar "elevation" _lch_old_elev) ;;恢复当前UCS的当前标高
(setvar "plinewid" _lch_old_plwid) ;;恢复多段线宽度
(setvar "cecolor" _lch_old_cecolor) ;;恢复颜色
(command "_.undo" "end") ;;编程结束
(setvar "cmdecho" _lch_old_cmd) ;;恢复普通命令提示
(princ)
);end_de
(lch_cxks) ;程序开始
(setvar "osmode" _lch_old_os) ;;恢复捕捉
(setvar "osmode" 0) ;;关闭捕捉
(setq ss (ssget '((0 . "SPLINE"))))
(setq n 0)
(repeat (sslength ss)
(setq ptlst (lch:Massoc 11 (entget (ssname ss n))))
(lch:lwpolyline ptlst nil nil nil nil nil)
(setq n (1+ n))
)
(lch_cxjs) ;程序结束
);end_de
;;[功能] 多段线各顶点
;;示例 (lch:Massoc 10 (entget (car (entsel))))
;; 特别适合多段线各顶点
(defun lch:Massoc (key alist)
(apply
'append
(mapcar '(lambda (x)
(if (eq (car x) key)
(list (cdr x))
)
)
alist
)
)
)
;点表生成多段线
;线宽=nil，线宽为0
;是否闭合=nil，不闭合
;图层=nil，为当前图层
;颜色=nil，为当前图层颜色
;线型比例=nil，为1
;(lch:lwpolyline 点表 是否闭合 线宽 图层 颜色 线型比例)
;(lch:lwpolyline (list (1 2) (2 3)) T 2 "中心线" 6 5)
(defun lch:lwpolyline (lst dxf70 plwid lay lwplint lwplbili)
(entmake
(append
(list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 (length lst)) ;点表
(if (= dxf70 T)
(cons 70 1) ;闭合与不闭合
(cons 70 0)
);if
(if plwid
(cons 43 plwid) ;线宽
(cons 43 0)
);if
(if lay
(cons 8 lay) ;图层
(cons 8 (getvar "clayer"))
);if
(if lwplint
(cons 62 lwplint) ;颜色
(cons 62 256)
);if
(if lwplbili
(cons 48 lwplbili) ;线型比例
(cons 48 1.0)
);if
);end_list
(mapcar '(lambda (pt) (cons 10 pt)) lst )
);end_append
);end_entmake
);end_de
;;;通用程序开始
(defun lch_cxks ()
(setq _lch_old_cmd (getvar "cmdecho") ;;保存普通命令提示
_lch_old_os (getvar "osmode") ;;保存捕捉
_lch_old_bmd (getvar "blipmode") ;;保存光标
_lch_old_hlt (getvar "highlight") ;;保存对象亮显
_lch_old_elev (getvar "elevation") ;;保存当前UCS的当前标高
_lch_old_plwid (getvar "plinewid") ;;保存多段线宽度
_lch_old_ucsicon (getvar "ucsicon")
_lch_old_cecolor (getvar "cecolor") ;;保存颜色
_lch_old_clayer (getvar "clayer") ;;保存线型
_lch_old_text (getvar "textstyle") ;;保存字体
);end_setq
(setvar "cmdecho" 0) ;;设置普通命令不提示
(command "_.undo" "_be") ;;编程开始
(setvar "osmode" 0) ;;关闭捕捉
(setvar "blipmode" 0) ;;关闭光标
(setvar "elevation" 0) ;;关闭当前UCS的当前标高
(setvar "plinewid" 0) ;;设置多段线宽度
(setvar "pickstyle" 0)
(setvar "cecolor" "bylayer")
);end_de
;;通用程序结束
(defun lch_cxjs ()
(setvar "osmode" _lch_old_os) ;;恢复捕捉
(setvar "blipmode" _lch_old_bmd) ;;恢复光标
(setvar "clayer" _lch_old_clayer) ;;恢复线型
(setvar "textstyle" _lch_old_text) ;;恢复字体
(setvar "highlight" _lch_old_hlt) ;;恢复对象亮显
(setvar "elevation" _lch_old_elev) ;;恢复当前UCS的当前标高
(setvar "plinewid" _lch_old_plwid) ;;恢复多段线宽度
(setvar "cecolor" _lch_old_cecolor) ;;恢复颜色
(command "_.undo" "_end") ;;编程结束
(setvar "cmdecho" _lch_old_cmd) ;;恢复普通命令提示
(princ)
);end_de
页:
[1]