一个实现梁交线自动断开的程序，非实用(源码)

蒹葭_Keirll

crazylsp 发表于 2012-12-9 13:35

感谢crazylsp兄，要是梁宽能记忆就更好了

蒹葭_Keirll

bdboy 发表于 2012-12-10 19:34
代码应该反过来用，已有梁线实现自动断开还算有用处，虽然网上有几个但识别率不高

2. (defun c:trimall(/ os ss ssline n index index1 l_p1 l_p2 l_int len ent p1 p2 p3 p4 pselect a b )
   
3. (command "undo" "be")
   
4.   (command "ucs" "w")
   
5.   (setq os (getvar "osmode"))
   
6.   (setvar "osmode" 0)
   
7.   (setq ss (ssget))
   
8.   (setq index 0
   
9.         l_p1 '()
   
10.         l_p2 '()
    
11.         l_int '()
    
12.         len (sslength ss)
    
13.   );end set
    
14.   
    
15.   (repeat len ;把直线端点存入表中
    
16.     (setq ent (entget (ssname ss index))
    
17.           index (+ 1 index)
    
18.           p1 (cdr (assoc 10 ent))
    
19.           p2 (cdr (assoc 11 ent))
    
20.           l_p1 (cons p1 l_p1)
    
21.           l_p2 (cons p2 l_p2)
    
22.     );end set
    
23.   );end repeat
    
24.   
    
25.   (setq index 0
    
26.         n (length l_p1)
    
27.   );end set
    
28.   (repeat n
    
29.     (setq p1 (nth index l_p1)
    
30.           p2 (nth index l_p2)
    
31.           index1 0
    
32.     );end set
    
33.     (repeat n ;计算某线与其他所有线的交点
    
34.       (if (/= index1 index)
    
35.         (setq p3 (nth index1 l_p1)
    
36.               p4 (nth index1 l_p2)
    
37.               index1 (+ 1 index1)
    
38.               pt (inters p1 p2 p3 p4)
    
39.               l_int (if pt (cons pt l_int) l_int)
    
40.         );end set
    
41.         (setq index1 (+ 1 index1))
    
42.       );end if
    
43.     );end repeat
    
44.     (if (= (car p1) (car p2)) ;排序
    
45.       (setq l_int (vl-sort l_int (function (lambda (e1 e2)(< (cadr e1) (cadr e2)))) ))
    
46.       (setq l_int (vl-sort l_int (function (lambda (e1 e2)(< (car e1) (car e2)))) ))
    
47.     );end if
    
48.     (setq
    
49.           pselect p1
    
50.           b pselect
    
51.     );end set
    
52.     (setq i 0
    
53.           len (length l_int)
    
54.     );end set
    
55.     (while (< i len) ;打断
    
56.       (setq
    
57.             pselect b
    
58.             a (nth i l_int);a<b
    
59.             b (nth (+ i 1) l_int)
    
60.             pselect (list (/ (+ (car pselect) (car a)) 2.0) (/ (+ (cadr pselect) (cadr a)) 2.0))
    
61.       );end set
    
62.       (setq ssline (nentselp pselect))
    
63.       (command "break" ssline "f" a b);break之后已经不是ssline了
    
64.       (setq i (+ i 2))
    
65.     );end while
    
66.     (setq l_int '()
    
67.           index (+ 1 index)
    
68.     );end set
    
69.   );end repeat
    
70. (setvar "osmode" os)
    
71. (command "ucs" "p")
    
72. (command "undo" "e")
    
73. );end fun
    

(defun c:trimall(/ os ss ssline n index index1 l_p1 l_p2 l_int len ent p1 p2 p3 p4 pselect a b )<br /> (command "undo" "be")<br />   (command "ucs" "w")<br />   (setq os (getvar "osmode"))<br />   (setvar "osmode" 0)<br />   (setq ss (ssget))<br />   (setq index 0<br />         l_p1 '()<br />         l_p2 '()<br />         l_int '()<br />         len (sslength ss)<br />   );end set<br />   <br />   (repeat len ;把直线端点存入表中<br />     (setq ent (entget (ssname ss index))<br />           index (+ 1 index)<br />           p1 (cdr (assoc 10 ent))<br />           p2 (cdr (assoc 11 ent))<br />           l_p1 (cons p1 l_p1)<br />           l_p2 (cons p2 l_p2)<br />     );end set<br />   );end repeat<br />   <br />   (setq index 0 <br />         n (length l_p1)<br />   );end set<br />   (repeat n<br />     (setq p1 (nth index l_p1)<br />           p2 (nth index l_p2)<br />           index1 0<br />     );end set<br />     (repeat n ;计算某线与其他所有线的交点<br />       (if (/= index1 index)<br />         (setq p3 (nth index1 l_p1)<br />               p4 (nth index1 l_p2)<br />               index1 (+ 1 index1)<br />               pt (inters p1 p2 p3 p4)<br />               l_int (if pt (cons pt l_int) l_int)<br />         );end set<br />         (setq index1 (+ 1 index1))<br />       );end if<br />     );end repeat<br />     (if (= (car p1) (car p2)) ;排序<br />       (setq l_int (vl-sort l_int (function (lambda (e1 e2)(< (cadr e1) (cadr e2)))) ))<br />       (setq l_int (vl-sort l_int (function (lambda (e1 e2)(< (car e1) (car e2)))) ))<br />     );end if<br />     (setq <br />           pselect p1<br />           b pselect<br />     );end set<br />     (setq i 0<br />           len (length l_int)<br />     );end set<br />     (while (< i len) ;打断<br />       (setq <br />             pselect b<br />             a (nth i l_int);a<b<br />             b (nth (+ i 1) l_int)<br />             pselect (list (/ (+ (car pselect) (car a)) 2.0) (/ (+ (cadr pselect) (cadr a)) 2.0))<br />       );end set<br />       (setq ssline (nentselp pselect))<br />       (command "break" ssline "f" a b);break之后已经不是ssline了<br />       (setq i (+ i 2))<br />     );end while<br />     (setq l_int '()<br />           index (+ 1 index)<br />     );end set<br />   );end repeat<br /> (setvar "osmode" os)<br /> (command "ucs" "p")<br /> (command "undo" "e")<br /> );end fun<br />

其实这个代码是在 已有梁线自动断开的代码 基础上做出来的，程序前半段是画梁线并把画出来的梁线作为一个选择集，后半段是实现梁线的自动断开。 梁线自动断开的单独程序可以是这个样子的，识别率可能也不会太高，若有高手看到，请指正。

bdboy

谢谢楼上的，但实际测试了下，还是不行，有些整条线都被误删了

bdboy

裁剪效果如下，单独对某个交点裁剪可以，但批量裁剪就会出下面的错误

bdboy

再就是十字交叉单独裁剪可以，T型交叉不行

xyp1964

;; 对话框方式＋动态捕捉

蒹葭_Keirll

xyp1964 发表于 2012-12-10 22:18
;; 对话框方式＋动态捕捉

很厉害的程序。请问院长grread函数下的捕捉是如何实现的，除了用G版的函数还有其他方法吗？

crazylsp

哈哈经过一天研究出对应十字交叉的修剪了！

200853006

血学习学习，！

enn09

最后那个不错，很实用，就需要断开的命令