[lisp程序]FILLET功能增强

saintdog

可一次修剪两组线条，不用一根根地点

2. 
   
3. ;This function will fillet two groups of   crossing  lines with the most simplest  
   
4. ;method.
   
5. (defun C:A (/ a b c f g h i d )
   
6.             (command  "undo"  "M")
   
7.             (setq  f   (getpoint  " 第一组线条剪切端起点:"))
   
8.             (setq  g   (getpoint  " 第一组线条剪切端终点:"))
   
9.                            (setq a   (ssget "f" (list f g)))
   
10.                                           (setq b  (sslength a ))
    
11.             (setq h   (getpoint  " 第二组线条剪切端起点:"))
    
12.             (setq i   (getpoint  " 第二组线条剪切端终点:"))
    
13.                           (setq c   (ssget "f" (list h i)))
    
14.                                           (setq   d   0)
    
15.                            (command  "pickbox" "3")
    
16.            (if (>  (sslength a)  (sslength c))  
    
17.             (setq  b  (sslength c)))
    
18.              (while  (< d b)
    
19.              (progn
    
20.              (command   "fillet"
    
21.                              (inters  (cdr  (assoc 10  (entget  (ssname a d ))))
    
22.                                           (cdr  (assoc  11 (entget  (ssname a d  ))))   f  g)
    
23.                              (inters  (cdr  (assoc 10  (entget  (ssname c d ))))
    
24.                                           (cdr  (assoc  11 (entget  (ssname c d  ))))  h  i))
    
25.                              (setq  d  (+ 1 d))))
    
26.     (command  "pickbox" "5")
    
27.               (if
    
28.          (or
    
29.                 (/= msg "Function cancelled")
    
30.                 (= msg "quit / exit abort")
    
31.       )
    
32.   (princ)
    
33.   (princ (strcat "\nError: " msg))
    
34. )
    
35.    (setq  a nil) (setq  b nil) (setq c nil)
    
36.    (gc)
    
37. )
    

<br /> ;This function will fillet two groups of   crossing  lines with the most simplest  <br /> ;method.<br /> (defun C:A (/ a b c f g h i d )<br />             (command  "undo"  "M")<br />             (setq  f   (getpoint  " 第一组线条剪切端起点:"))<br />             (setq  g   (getpoint  " 第一组线条剪切端终点:"))<br />                            (setq a   (ssget "f" (list f g)))<br />                                           (setq b  (sslength a ))<br />             (setq h   (getpoint  " 第二组线条剪切端起点:"))<br />             (setq i   (getpoint  " 第二组线条剪切端终点:"))<br />                           (setq c   (ssget "f" (list h i)))<br />                                           (setq   d   0)<br />                            (command  "pickbox" "3")<br />            (if (>  (sslength a)  (sslength c))  <br />             (setq  b  (sslength c)))<br />              (while  (< d b)<br />              (progn<br />              (command   "fillet" <br />                              (inters  (cdr  (assoc 10  (entget  (ssname a d ))))<br />                                           (cdr  (assoc  11 (entget  (ssname a d  ))))   f  g)<br />                              (inters  (cdr  (assoc 10  (entget  (ssname c d ))))<br />                                           (cdr  (assoc  11 (entget  (ssname c d  ))))  h  i))<br />                              (setq  d  (+ 1 d))))<br />     (command  "pickbox" "5")<br />               (if <br />          (or <br />                 (/= msg "Function cancelled")<br />                 (= msg "quit / exit abort") <br />       )<br />   (princ)<br />   (princ (strcat "\nError: " msg))<br /> )<br />    (setq  a nil) (setq  b nil) (setq c nil) <br />    (gc)<br /> )<br />

申士

上面的朋友，您的LISP小弟试了一下，不知针对解决哪一方面的问题，望告知....

xgwl

有点意思！又有点用不明白！好象用于修剪墙线用的！

saintdog

程序主要是为LCD液晶显示屏电路设计用的；SPECIAL FOR COG；以及需要剪切超过四根以上的线条的情形。

LUCAS

最初由 saintdog 发布
[B]程序主要是为LCD液晶显示屏电路设计用的；SPECIAL FOR COG；以及需要剪切超过四根以上的线条的情形。 [/B]

贴图说明好吗?

梦断江南

楼主能否制作个演示?或者贴图