下面是一个关于参考CAD2006中剪切与延伸框选的功能的LISP，但是存在BUG：在使用不当情况下会将对象捕捉的设置清除！本人已被苦恼很久！ 希望有人能帮忙改下！ 另外本LISP无法实现象CAD2006一样选择对象时候是个小框形式而是一个十字形状进行框选的！ 如果能一并解决那这个LISP将是最完美的了！ 望高手指教19162203@qq.com
下面是此LISP：
;(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:w () (trim&extend T))
(defun c:z () (trim&extend nil))

;;--------------------------------------------------
; )
(princ)
;)