画线修剪工具源码!!

xiaoyuzj503

[sell=2][/sell][code](defun C:XJ (/ pt0 ptlist ptlist0 ss cmdecho osmode getpoint_list)
  (setq

xiaoyuzj503

1. (defun C:XJ (/ pt0 ptlist ptlist0 ss cmdecho osmode getpoint_list)
   
2.   (setq        cmdecho        (getvar "cmdecho")
   
3.         osmode        (getvar "osmode")
   
4.   )
   
5.   (defun getpoint_list (/ DIS OUT PT)
   
6.     (setq pt (getpoint "\n开始："))
   
7.     (princ "\n按任意键完成:")
   
8.     (if        (= (type pt) 'LIST)
   
9.       (progn
   
10.         (setq out (list pt)
    
11.               dis (* 0.01 (getvar "viewsize"))
    
12.         )
    
13.         (while (= 5 (car (setq pt (grread t 4 0))))
    
14.           (setq pt (cadr pt))
    
15.           (if (> (distance pt (car out)) dis)
    
16.             (progn
    
17.               (grdraw pt (car out) 1)
    
18.               (setq out (cons pt out))
    
19.             )
    
20.           )
    
21.         )
    
22.       )
    
23.     )
    
24.     (redraw)
    
25.     (reverse out)
    
26.   )
    
27.   (while (and (setq ptlist0 (getpoint_list))
    
28.               (> (length ptlist0) 1)
    
29.          )
    
30.     (setvar "cmdecho" 0)
    
31.     (setvar "osmode" 0)
    
32.     (setq pt0         (car ptlist0)
    
33.           ptlist (cdr ptlist0)
    
34.     )
    
35.     (command "trim" "")
    
36.     (foreach pt        ptlist
    
37.       (command "f" pt0 pt "")
    
38.       (setq pt0 pt)
    
39.     )
    
40.     (command "")
    
41.     (if        (setq ss (ssget "f" ptlist0))
    
42.       (command "erase" ss "")
    
43.     )
    
44.     (setvar "osmode" osmode)
    
45.     (setvar "cmdecho" cmdecho)
    
46.   )
    
47.   (princ)
    
48. )
    
49. 
    

(defun C:XJ (/ pt0 ptlist ptlist0 ss cmdecho osmode getpoint_list)<br />   (setq        cmdecho        (getvar "cmdecho")<br />         osmode        (getvar "osmode")<br />   )<br />   (defun getpoint_list (/ DIS OUT PT)<br />     (setq pt (getpoint "\n开始："))<br />     (princ "\n按任意键完成:")<br />     (if        (= (type pt) 'LIST)<br />       (progn<br />         (setq out (list pt)<br />               dis (* 0.01 (getvar "viewsize"))<br />         )<br />         (while (= 5 (car (setq pt (grread t 4 0))))<br />           (setq pt (cadr pt))<br />           (if (> (distance pt (car out)) dis)<br />             (progn<br />               (grdraw pt (car out) 1)<br />               (setq out (cons pt out))<br />             )<br />           )<br />         )<br />       )<br />     )<br />     (redraw)<br />     (reverse out)<br />   )<br />   (while (and (setq ptlist0 (getpoint_list))<br />               (> (length ptlist0) 1)<br />          )<br />     (setvar "cmdecho" 0)<br />     (setvar "osmode" 0)<br />     (setq pt0         (car ptlist0)<br />           ptlist (cdr ptlist0)<br />     )<br />     (command "trim" "")<br />     (foreach pt        ptlist<br />       (command "f" pt0 pt "")<br />       (setq pt0 pt)<br />     )<br />     (command "")<br />     (if        (setq ss (ssget "f" ptlist0))<br />       (command "erase" ss "")<br />     )<br />     (setvar "osmode" osmode)<br />     (setvar "cmdecho" cmdecho)<br />   )<br />   (princ)<br /> )<br /> <br />

XDSoft

xiaoyuzj503 发表于 2013-5-19 10:09

楼主，最好做一个动画文件，演示你的代码。

清风明月10

很好用，画云线，经过的图元或被删除或被剪切。谢谢楼主的奉献。

/db_自贡黄明儒_

哈哈哈,2D什么也没看见!!!
程序不错哈,收藏了

viphappy

谢谢分享，论坛有你很精彩

liuyun242

谢谢分享，学习

yfph2918

这个不错，下来试试看

ysq101

下来学习一下！~

xiaoyuzj503

畫線修剪動畫

xiaoyuzj503

[pcode=lisp,true](defun C:FQ (/ pt0 ptlist ptlist0 ss cmdecho osmode getpoint_list)
  (setq        cmdecho        (getvar "cmdecho")
        osmode        (getvar "osmode")
  )

  (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))
          (suijishu)
          (if (> (distance pt (car out)) dis)
            (progn
              (grdraw pt (car out) tm2 0)
              (setq out (cons pt out))
            )
          )
        )
      )
    )
    (redraw)
    (reverse out)
  )
  (while (and (setq ptlist0 (getpoint_list))
              (> (length ptlist0) 1)
         )
    (setvar "cmdecho" 0)
    (setvar "osmode" 0)
    (setq pt0         (car ptlist0)
          ptlist (cdr ptlist0)
    )
    (command "trim" "")
    (foreach pt        ptlist
      (command "f" pt0 pt "")
      (setq pt0 pt)
    )
    (command "")
    (if        (setq ss (ssget "f" ptlist0))
      (command "erase" ss "")
    )
    (setvar "osmode" osmode)
    (setvar "cmdecho" cmdecho)
  )
  (princ)
)

(defun suijishu ()

(SETQ TM1 (ATOI (SUBSTR (RTOS (GETVAR "CDATE") 2 7) 15) )
       TM2 (REM (+ (* Tm1 120) 3) (* Tm1 50))
  )
  (if (= tm2 0) (setq tm2 240))
  (while (AND (< 255 tm2) (/= TM2 0))
   (setq tm2 (/ tm2 60))
  )
  (setq tm2 (adot tm2))
(prin1)
)[/pcode]

稍稍改了下。但有个问题！还想请大师指点指点。

oooohen

好！！！！

习惯

不错 很好....

xxxxxxxxx123

:(:(:(学学   谢谢分享。。

tmwall

程序出错，奇怪了。。。。。。。。。。