56216349网友请进

caoyin

2. ;;这样似乎更好用一些
3. ;;TRIM 和 EXTEND 命令（用于cad 2004版，仿照2006的矩形选框）
4. ;;根据 AutoCAD 版本判断是否加载
5. ;(if (< (atof (substr (getvar "acadver") 1 4)) 16.2)
6. ; (progn
7. ;;--------------------------------------------------
8. (defun trim&extend (cmd / error error_end olderr ssget-g ssRedraw cm os ss1 ss2 lst)
9.   (if cmd
10.     (setq cmd "_.trim")
11.     (setq cmd "_.extend")
12.   )
13.   (defun error (x) (error_end))
14.   (defun error_end ()
15.     (if ss1 (ss-Redraw ss1 4))
16.     (if cm (setvar "cmdecho" cm))
17.     (if os (setvar "osmode" os))
18.     (setq *error* olderr)
19.   )
20.   (setq olderr *error* *error* error)
21.   (defun ss-Redraw (ss mode)
22.     (mapcar '(lambda (x) (redraw x mode))
23.             (vl-remove-if-not '(lambda (x) (= (type x) 'ename)) (mapcar 'cadr (ssnamex ss)))
24.     )
25.   )
26.   (setq cm (getvar "cmdecho")
27.         os (getvar "osmode")
28.   )
29.   (setvar "cmdecho" 0)
30.   (setvar "osmode" 0)
31.   (defun ssget-g (msg fit / p1 p2 ss)
32.     (if (not msg) (setq msg "\n选择对象: "))
33.     (setq p1 (getpoint msg))
34.     (if p1
35.       (progn
36.         (setq p2 (getcorner p1 "指定对角点: "))
37.         (while (not p2)
38.           (if (not p2) (princ "窗口说明无效。"))
39.           (setq p2 (getcorner p1 (strcat msg "指定对角点: ")))
40.         )
41.         (setq ss (ssget "_c" p1 p2 fit))
42.       )
43.     )
44.     (list ss p1 p2)
45.   )
46.   (princ "\n选择剪切边或 <全部选择>... ")
47.   (setq ss1 (ssget))
48.   (while
49.     (progn
50.       (if ss1 (ss-redraw ss1 3))
51.       (apply 'or (setq lst (cdr (setq ss2 (ssget-g "\n选择要修剪的对象: " nil)))))
52.     )
53.     (if (car ss2)
54.       (progn
55.         (setq lst (list (car lst)
56.                         (cons (caar lst) (cdadr lst))
57.                         (cadr lst)
58.                         (cons (caadr lst) (cdar lst))
59.                         (car lst)
60.                   )
61.         )
62.         (command cmd)
63.         (if ss1 (command ss1 "") (command ""))
64.         (command "_f")
65.         (apply 'command lst)
66.         (command "" "")
67.       )
68.     )
69.   )
70.   (error_end)
71.   (princ)
72. )
73. (defun c:tr () (trim&extend T))
74. (defun c:ex () (trim&extend nil))
75. ;;--------------------------------------------------
76. ; )
77.   (princ)
78. ;)

;;这样似乎更好用一些 ;;TRIM 和 EXTEND 命令（用于cad 2004版，仿照2006的矩形选框） ;;根据 <a href="http://bbs.mjtd.com/forum-41-1.html" target="_blank" class="relatedlink">AutoCAD</a> 版本判断是否加载 ;(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) ;)

56216349

谢谢。

好用

56216349

我现在在学VB，

不知老兄对这可有研究？

向你学习啊！

感谢你的热心帮助！

caoyin

不懂VB啊，我向你学习！！

56216349

我也是刚开始学，

感觉自己不能老是玩啊，也该趁年轻多学点东西。

所以就学了,VB上手快点，LISP感觉很难，望而却步啊

也没甚么老师，就自己瞎摸索。还好网上有不少教程啊

zxlwinno1

个个都那么历害..向你们学习..

楼主辛苦你了...多谢啊....

wowan1314

强烈感激！！！！！！

wowan1314

再次强烈感激ID为caoyin  的网友 ！真的是好人！ 有热心的呀！ 我找这个插件已经好几个月了！一直都没人知道或者说没人理会！ 最后也只自己编了个栏选的插件！ 今天终于遇见好人了！ 十分感激哦！ 这个论坛有你这样的德才兼备的人真是福气呀！    

                                           敬礼ING

wowan1314

忍不住1回来再感激一下！ 真的是相当的好用！！ 德才兼备的人才

wowan1314

<p>发现此程序一个BUG ，执行命令后经常会把对象捕捉的设置清除！ 很苦恼！总是反复的重新设置对象捕捉！希望作者能给解决下这个问题！一般是在矩形选框太小时候就会把对象捕捉清除！ 另外可否象CAD2006一样点中曲线，单点剪切；点于空位就是矩形选框！&nbsp; 希望作者能再改进下！</p>