填充源码小程序，看看对大家有用没
本帖最后由 HGHG011 于 2015-1-28 14:37 编辑代替原来的bh填充命令
本人菜鸟一枚，程序写得不好勿怪
;;;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;;;;;说明
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;1.填充命令 bh （输入命令后 1左键直接指定多段线内部点填充,
; 2 右键选择需要填充的对象）
;2.设置填充 sbh （选择填充体）
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;说明
;;;----------------------------------------------------------------------
;;;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;;;;;主程序
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:bh ( / *error*)
(defun *error* (msg)
(setvar "osmode" os)
(setvar "clayer" dqtc)
(princ "出错: ")
(princ msg)
(princ)
)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setq dqtc (getvar "clayer"))
(if tatc
(command "layer""s"tatc "")
)
(if (= tuan nil)
(setq
tuan "SOLID"
tabl 100
tajd 0
)
)
(if (= tuan "SOLID" )
(progn
(setq pt (getpoint))
(command "-hatch""p" "SOLID" pt)
(while (> (getvar "CMDACTIVE") 0) (command PAUSE))
(ifpt
(princ)
(command "-hatch""p" "SOLID" "s" (setq ss (ssget)) "" "")
)
)
(progn
(setq pt (getpoint))
(command "-hatch""p" tuan tabl tajd pt)
(while (> (getvar "CMDACTIVE") 0) (command PAUSE))
(if pt
(princ)
(command "-hatch""p" tuan tabl tajd "s" (setq ss (ssget)) "" "")
)
)
)
(setvar "clayer" dqtc)
(setvar "osmode" os)
(princ)
)
(defun c:sbh( / ss )
(setq tuan (cdr (assoc 2 (entget (car (setq ss (entsel) ))))));提取属性
(if (= tuan "SOLID")
(setq tatc (cdr (assoc 8 (entget (car ss)))))
(progn
(setq tabl (cdr (assoc 41 (entget (car ss)))))
(setq tatc (cdr (assoc 8 (entget (car ss)))))
(setq tajd (angtos (cdr (assoc 52 (entget (car ss))))0 4) )
)
)
;(setq tajd (cdr (assoc 41 (entget (car ss)))))
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;主程序
;;;----------------------------------------------------------------------
2015-1-28 改 有待验证，先支持一下
页:
[1]