[原创]：别开生面的TRIM

LUCAS

2. 
   
3. ;;BY LUCAS
   
4. ;;改了TRIM的寫法
   
5. (defun C:XXX (/ PTLIST0 PT SS CMDECHO OSMODE)
   
6.   (setq        CMDECHO        (getvar "cmdecho")
   
7.         OSMODE        (getvar "osmode")
   
8.   )
   
9.   (setvar "cmdecho" 0)
   
10.   (setvar "osmode" 0)
    
11.   (while (and (setq PTLIST0 (GETPOINT_LIST))
    
12.               (> (length PTLIST0) 1)
    
13.          )
    
14.     (command "_.trim" "a" "" "f")
    
15.     (foreach PT        PTLIST0
    
16.       (command PT)
    
17.     )
    
18.     (command "" "")
    
19.     ;;樓主的程序剪不掉就刪除!!
    
20.     (if        (setq SS (ssget "f" PTLIST0))
    
21.       (command "erase" SS "")
    
22.     )
    
23.   )
    
24.   (setvar "osmode" OSMODE)
    
25.   (setvar "cmdecho" CMDECHO)
    
26.   (princ)
    
27. )
    

<br /> ;;BY LUCAS<br /> ;;改了TRIM的寫法<br /> (defun C:XXX (/ PTLIST0 PT SS CMDECHO OSMODE)<br />   (setq        CMDECHO        (getvar "cmdecho")<br />         OSMODE        (getvar "osmode")<br />   )<br />   (setvar "cmdecho" 0)<br />   (setvar "osmode" 0)<br />   (while (and (setq PTLIST0 (GETPOINT_LIST))<br />               (> (length PTLIST0) 1)<br />          )<br />     (command "_.trim" "a" "" "f")<br />     (foreach PT        PTLIST0<br />       (command PT)<br />     )<br />     (command "" "")<br />     ;;樓主的程序剪不掉就刪除!!<br />     (if        (setq SS (ssget "f" PTLIST0))<br />       (command "erase" SS "")<br />     )<br />   )<br />   (setvar "osmode" OSMODE)<br />   (setvar "cmdecho" CMDECHO)<br />   (princ)<br /> )<br />

武陵山人

最初由 LUCAS 发布
[B][CODE]
;;BY LUCAS
;;改了TRIM的寫法
(defun C:XXX (/ PTLIST0 PT SS CMDECHO OSMODE)
  (setq        CMDECHO        (getvar "cmdecho")
        OSMODE        (getvar "osmode")
  )
  (setvar "cmdecho" 0)
  (setvar "osmode" 0)
... [/B]

程序不完整。
no function definition: GETPOINT_LIST

lijiao

最初由 LUCAS 发布
[B][CODE]
;;BY LUCAS
;;改了TRIM的寫法
(defun C:XXX (/ PTLIST0 PT SS CMDECHO OSMODE)
  (setq        CMDECHO        (getvar "cmdecho")
        OSMODE        (getvar "osmode")
  )
  (setvar "cmdecho" 0)
  (setvar "osmode" 0)
... [/B]

最开始，我也是这样写的，但实际上使用时有些问题。

它山之石

　　GETPOINT_LIST  是原程序里的函数，LUCAS未写入自己修改的程序里，要用可以先加载原程序或加到LUCAS的程序中。定义如下：
[php]
(defun getpoint_list ( / DIS OUT PT)
  (setq pt (getpoint "\n开始："))
  (princ "\n按任意键完成:")
  (if (= (type pt) 'LIST)
    (progn
      (setq out (list pt)
            dis (* 0.01 (getvar "viewsize")))
      (while (= 5 (car (setq pt (grread t 4 0))))
        (setq pt (cadr pt))
         (if (> (distance pt (car out)) dis)
           (progn
             (grdraw pt (car out) 1)
             (setq out (cons pt out))
             )
           )
        )
      )
    )
  (redraw)
  (reverse out)
  )
[/php]

LUCAS

有些甚麼问题??

li809

好东西,very good
Thank you

gjt1244

好东西，，顶！

aeo

最初由 LUCAS 发布
[B]有些甚麼问题?? [/B]

实际运用中，80%以上是要选原对象的.
实际运用中,只trim一根线的比例也是很高的(反而多了一下)

aeo

试试我改的：
1.有机会和trim一样，有选择的机会
2.如果点到实体，马上trim
3.如果在空的地方点下,自动拉出...

  如果在加入延伸方式等，应该可以取代cad的trim命令了吧.

[php]
;;;BY AEO
(defun c:xx( / cmdecho osmode pt pt0 pts ss)
  (setq        cmdecho        (getvar "cmdecho")
        osmode        (getvar "osmode")
  )
  (setvar "cmdecho" 0)
  (setvar "osmode" 0)
  (princ "\n选择剪切边...")
  (if (setq ss (ssget))(command ".select" ss))
  (princ"\n选择要修剪的对象: ")
  (grread t)
  (while(and(setq pt0(grread nil 12 2))
            (=(car pt0) 3)
            (setq pt0(cadr pt0))
        )
    (if(nentselp pt0)
       (progn
          (command """trim")
          (if ss(command ss))
          (command""pt0"")
          (if ss(command ".select" ss))
       )
       (if(and(setq pts(getpoint_list pt0))
              (>(length pts)1)
          )
         (progn
          (command"""trim")
          (if ss(command ss))(command"""f")
          (foreach pt pts (command pt))
          (command"""")
          (if ss(command ".select" ss))
       ))
   )
)(command)
  (setvar "osmode" osmode)
  (setvar "cmdecho" cmdecho)
  (princ)
)

(defun getpoint_list (pt / dis out)
  (if (= (type pt) 'LIST)
    (progn
      (setq out (list pt)
            dis (* 0.01 (getvar "viewsize")))
      (while (= 5 (car (setq pt (grread t 4 0))))
        (setq pt (cadr pt))
         (if (> (distance pt (car out)) dis)
           (progn
             (grdraw pt (car out) 1 1)
             (setq out (cons pt out))
             )
           )
        )
      )
    )
  (redraw)(grread t)
  (reverse out)
)
[/php]

狂刀

最初由 LUCAS 发布
[B]有些甚麼问题?? [/B]

我来回答： 用你的写法，当trim一条多义线的多个边的时候，只能trim一条边。

我改写的，完全囊括trim命令内容，包括p，e，uodo选项，支持shift延伸方式！

2. 
   
3. ;; xtr = 超级剪切－－by 狂刀
   
4. ;;思路from lijiao  [url]http://www.xdcad.net/forum/showthread.php?postid=1686237#post1686237[/url]
   
5. ;; 可替代trim.
   
6. (defun c:xtr (/ cmd os roop dis ss gr ga gb sel pts pts2 )
   
7.   (setq        cmd  (getvar "cmdecho")
   
8.         os   (getvar "osmode")
   
9.         roop T
   
10.         dis  (* 0.01 (getvar "viewsize"))
    
11.   )
    
12.   (setvar "cmdecho" 0)
    
13.   (setvar "osmode" 0)
    
14.   (princ "\n 选择剪切边<all>")
    
15.   (setq ss (ssget))
    
16.   (if (not ss)(setq ss ""))
    
17.   (princ"\n U-undo / E-edgemode / 选择要修剪的对象(按住Shift键延伸): ")
    
18.   (while roop
    
19.     (setq gr (grread nil 4 02)
    
20.           ga (car gr)
    
21.           gb (cadr gr))
    
22.     (cond
    
23.       ((= ga 3)
    
24.        (cond
    
25.          ((setq sel (nentselp gb))(command ".trim" ss sel ""))
    
26.          (T (setq pts (getpts dis))
    
27.           (if (setq pts2(cdr pts))
    
28.             (progn (command ".trim" ss )
    
29.               (mapcar '(lambda(x y)(command "f" x y "")) pts pts2)
    
30.               (command "")
    
31.             )
    
32.            )
    
33.           )
    
34.        ))
    
35.       ((member gr '((2 117)(2 85)));; "U"
    
36.         (command ".u"))
    
37.       ((member gr '((2 101)(2 69)));; "E"
    
38.         (setvar "edgemode" (abs(- (getvar "edgemode") 1))))
    
39.       ((member gr '((2 112)(2 80)));; "P"
    
40.         (initget "0 1 2")
    
41.         (setvar "PROJMODE" (atoi (getkword "[0 无 / 1 UCS / 2 视图]:"))))
    
42.       ((member gr '((11 0)(2 32)));; "" or enter
    
43.         (setq roop nil))
    
44.    )
    
45.   )
    
46.   (setvar "cmdecho" cmd)
    
47.   (setvar "osmode" os)
    
48.   (princ)
    
49. )
    
50. ;; (getpts) = 取得grread跟踪点表，dis为控制精度的距离.
    
51. (defun getpts (dis / gr pt pt0 pts)
    
52.    (while (= 5 (car (setq gr (grread t 4 0))))
    
53.      (setq pt (cadr gr))
    
54.      (if (not pt0)(setq pt0 pt pts (cons pt0 pts)))
    
55.      (if (> (distance pt pt0) dis)
    
56.        (progn
    
57.          (grdraw pt pt0 1 1)
    
58.          (setq pts (cons pt pts)
    
59.                pt0 pt)
    
60.        )
    
61.      )
    
62.    )
    
63.   (redraw)
    
64.   (reverse pts)
    
65. )
    

<br /> ;; xtr = 超级剪切－－by 狂刀<br /> ;;思路from lijiao  [url]http://www.xdcad.net/forum/showthread.php?postid=1686237#post1686237[/url]<br /> ;; 可替代trim.<br /> (defun c:xtr (/ cmd os roop dis ss gr ga gb sel pts pts2 )<br />   (setq        cmd  (getvar "cmdecho")<br />         os   (getvar "osmode")<br />         roop T<br />         dis  (* 0.01 (getvar "viewsize"))<br />   ) <br />   (setvar "cmdecho" 0) <br />   (setvar "osmode" 0) <br />   (princ "\n 选择剪切边<all>") <br />   (setq ss (ssget))<br />   (if (not ss)(setq ss ""))<br />   (princ"\n U-undo / E-edgemode / 选择要修剪的对象(按住Shift键延伸): ") <br />   (while roop<br />     (setq gr (grread nil 4 02)<br />           ga (car gr)<br />           gb (cadr gr))<br />     (cond<br />       ((= ga 3)<br />        (cond<br />          ((setq sel (nentselp gb))(command ".trim" ss sel ""))<br />          (T (setq pts (getpts dis))<br />           (if (setq pts2(cdr pts))<br />             (progn (command ".trim" ss )<br />               (mapcar '(lambda(x y)(command "f" x y "")) pts pts2)<br />               (command "")<br />             )<br />            )<br />           )<br />        ))<br />       ((member gr '((2 117)(2 85)));; "U"<br />         (command ".u"))<br />       ((member gr '((2 101)(2 69)));; "E"<br />         (setvar "edgemode" (abs(- (getvar "edgemode") 1))))<br />       ((member gr '((2 112)(2 80)));; "P"<br />         (initget "0 1 2")<br />         (setvar "PROJMODE" (atoi (getkword "[0 无 / 1 UCS / 2 视图]:"))))<br />       ((member gr '((11 0)(2 32)));; "" or enter<br />         (setq roop nil))<br />    )<br />   )<br />   (setvar "cmdecho" cmd) <br />   (setvar "osmode" os) <br />   (princ)<br /> )<br /> ;; (getpts) = 取得grread跟踪点表，dis为控制精度的距离.<br /> (defun getpts (dis / gr pt pt0 pts) <br />    (while (= 5 (car (setq gr (grread t 4 0))))<br />      (setq pt (cadr gr))<br />      (if (not pt0)(setq pt0 pt pts (cons pt0 pts)))<br />      (if (> (distance pt pt0) dis)<br />        (progn<br />          (grdraw pt pt0 1 1)<br />          (setq pts (cons pt pts)<br />                pt0 pt)<br />        )<br />      )<br />    ) <br />   (redraw)<br />   (reverse pts) <br /> )<br />

lxyljl

最初由 梦断江南 发布
[B]

那样还写什么啊,就一句
(command "t... [/B]

用trim需要选择剪切边，不一样在这里。

wkai

还是不要选择裁剪边界比较好，否则就用trim了。

ljpnb

最初由 狂刀 发布
[B]

我来回答： 用你的写法，当trim一条多义线的多个边的时候，只能trim一条边。

我改写的，完全囊括trim命令内容，包括p，e，uodo选项，支持sh... [/B]

程序好象有问题，选择边界后，再选物体回车不起作用，程序不动了。。。。。

lxyljl

最初由 aeo 发布
[B]试试我改的：
1.有机会和trim一样，有选择的机会
2.如果点到实体，马上trim
3.如果在空的地方点下,自动拉出...

  如果在加入延伸方式等，应该可以取代cad的trim命令了吧.

[php]
;;;BY AEO
(defun c:xx( ... [/B]

有点小问题，选择剪切边后按esc退出的话，剪切边被删除了。另外，剪切成功后如果用esc退出的话，需要按两次。斑竹能再修修么？

li809

期待楼主的新版本程序