56216349网友请进
;;这样似乎更好用一些;;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:tr () (trim&extend T))
(defun c:ex () (trim&extend nil))
;;--------------------------------------------------
; )
(princ)
;)
<p>谢谢。</p><p>好用</p> <p>我现在在学VB，</p><p>不知老兄对这可有研究？</p><p>向你学习啊！</p><p>感谢你的热心帮助！</p> 不懂VB啊，我向你学习！！ <p>我也是刚开始学，</p><p>感觉自己不能老是玩啊，也该趁年轻多学点东西。</p><p>所以就学了,VB上手快点，LISP感觉很难，望而却步啊</p><p>也没甚么老师，就自己瞎摸索。还好网上有不少教程啊</p> <p>个个都那么历害..向你们学习..</p><p>楼主辛苦你了...多谢啊....</p> 强烈感激！！！！！！ <p>再次强烈感激ID为caoyin 的网友 ！真的是好人！ 有热心的呀！ 我找这个插件已经好几个月了！一直都没人知道或者说没人理会！ 最后也只自己编了个栏选的插件！ 今天终于遇见好人了！ 十分感激哦！ 这个论坛有你这样的德才兼备的人真是福气呀！ </p><p> 敬礼ING</p> 忍不住1回来再感激一下！ 真的是相当的好用！！ 德才兼备的人才 本帖最后由 wowan1314 于 2012-8-18 11:53 编辑
<p>发现此程序一个BUG ，执行命令后经常会把对象捕捉的设置清除！ 很苦恼！总是反复的重新设置对象捕捉！希望作者能给解决下这个问题！一般是在矩形选框太小时候就会把对象捕捉清除！ 另外可否象CAD2006一样点中曲线，单点剪切；点于空位就是矩形选框！ 希望作者能再改进下！</p>
页:
[1]
2