土木在线论坛 \ 建筑设计 \ CAD下载及教程 \ 高手请来修改下这个LISP中的BUG

高手请来修改下这个LISP中的BUG

发布于:2007-09-14 22:36:14 来自:建筑设计/CAD下载及教程 [复制转发]
下面是一个关于参考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)
;)

这个家伙什么也没有留下。。。

CAD下载及教程

返回版块

52.08 万条内容 · 666 人订阅

猜你喜欢

阅读下一篇

帮忙修改LISP中的BUG并使之完美

下面是一个关于参考CAD2006中剪切与延伸框选的功能的LISP,但是存在BUG:在使用不当情况下会将对象捕捉的设置清除!本人已被苦恼很久! 希望有人能帮忙改下! 另外本LISP无法实现象CAD2006一样选择对象时候是个小框形式而是一个十字形状进行框选的! 如果能一并解决那这个LISP将是最完美的了! 望高手指教19162203@qq.com下面是此LISP:;(if (< (atof (substr (getvar "acadver") 1 4)) 16.2)

回帖成功

经验值 +10