;;TRIM 和 EXTEND 命令(用于cad 2004版,仿照2006的矩形选框)
;;根据 AutoCAD 版本判断是否加载
(if (< (atof (substr (getvar "acadver") 1 4)) 16.2)
(progn
(defun trim&extend (cmd / error error_end olderr ssget-g ssRedraw cm os ss1 ss2 lst)
(if cmd
(setq cmd "_.trim")
(setq cmd "_.extend")
)
(defun error (x) (error_end))
(defun error_end ()
(if ss1 (ss-Redraw ss1 4))
(if cm (setvar "cmdecho" cm))
(if os (setvar "osmode" os))
(setq *error* olderr)
)
(setq olderr *error* *error* error)
(defun ss-Redraw (ss mode)
(mapcar '(lambda (x) (redraw x mode))
(vl-remove-if-not '(lambda (x) (= (type x) 'ename)) (mapcar 'cadr (ssnamex ss)))
)
)
(setq cm (getvar "cmdecho")
os (getvar "osmode")
)
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(defun ssget-g (msg fit / p1 p2 ss)
(if (not msg) (setq msg "\n选择对象: "))
(setq p1 (getpoint msg))
(if p1
(progn
(setq p2 (getcorner p1 "指定对角点: "))
(while (not p2)
(if (not p2) (princ "窗口说明无效。"))
(setq p2 (getcorner p1 (strcat msg "指定对角点: ")))
)
(setq ss (ssget "_c" p1 p2 fit))
)
)
(list ss p1 p2)
)
(princ "\n选择剪切边或 <全部选择>... ")
(setq ss1 (ssget))
(while
(progn
(if ss1 (ss-redraw ss1 3))
(apply 'or (setq lst (cdr (setq ss2 (ssget-g "\n选择要修剪的对象: " nil)))))
)
(if (car ss2)
(progn
(setq lst (list (car lst)
(cons (caar lst) (cdadr lst))
(cadr lst)
(cons (caadr lst) (cdar lst))
(car lst)
)
)
(command cmd)
(if ss1 (command ss1 "") (command ""))
(command "_f")
(apply 'command lst)
(command "" "")
)
)
)
(error_end)
(princ)
)
(defun c:t () (trim&extend T))
(defun c:ex () (trim&extend nil))
(defun c:c () (command "copy" (ssget) "" "m"))
--------------------------------------------------
)
(princ)
)
这个怎么下不来???
谢谢楼主的分享!收藏备用。试了,很好用! 大神的YY函数在哪里下载?
页:
1
[2]