批量倒角

bloodtempt

1. (setq ss1 (ssget "F" (list
   
2.                        (setq pt1 (vl-remove (last (setq pt1 (getpoint "选择第一组线："))) pt1))
   
3.                        (setq pt2 (vl-remove (last (setq pt2 (getpoint pt1))) pt2)))))
   
4. (setq ss2 (ssget "F" (list
   
5.                        (setq pt3 (vl-remove (last (setq pt3 (getpoint "选择第二组线："))) pt3))
   
6.                        (setq pt4 (vl-remove (last (setq pt4 (getpoint pt3))) pt4)))))
   
7. (setq i 0)
   
8. (repeat (min (sslength ss1)(sslength ss2))
   
9.   (command "_.CHAMFER"
   
10.         (osnap (onwplpt (ssname ss1 i) pt1 pt2) "Near")
    
11.         (osnap (onwplpt (ssname ss2 i) pt3 pt4) "Near")
    
12.       )
    
13.   (setq i (1+ i))
    
14. )
    
15. (defun onwplpt (en p1 p2 / linept lwpt pt)
    
16.   (defun LWPt (en /)
    
17.     (mapcar 'cdr
    
18.       (vl-remove-if-not
    
19.         '(lambda (x) (or (= (car x) 10) (= (car x) 11)))
    
20.         (entget en)
    
21.       )
    
22.     )
    
23.   )
    
24.   (defun LInept (lst )
    
25.     (if (>= (length lst) 2)
    
26.       (cons (list (car lst)(cadr lst))
    
27.         (LInept
    
28.           (vl-remove
    
29.             (car Lst)
    
30.             lst
    
31.           )
    
32.         )
    
33.       )
    
34.     )
    
35.   )
    
36.   (mapcar '(lambda (x / inte)
    
37.              (if (setq inte (inters (car x) (cadr x) p1 p2 nil))
    
38.                (if (IsOnLine (car x) (cadr x) inte )
    
39.                  inte
    
40.                )
    
41.              )
    
42.            )
    
43.     (LInept (lwpt en))
    
44.   )
    
45.   inte
    
46. )
    
47.   

(setq ss1 (ssget "F" (list <br />                        (setq pt1 (vl-remove (last (setq pt1 (getpoint "选择第一组线："))) pt1))<br />                        (setq pt2 (vl-remove (last (setq pt2 (getpoint pt1))) pt2)))))<br /> (setq ss2 (ssget "F" (list <br />                        (setq pt3 (vl-remove (last (setq pt3 (getpoint "选择第二组线："))) pt3))<br />                        (setq pt4 (vl-remove (last (setq pt4 (getpoint pt3))) pt4)))))<br /> (setq i 0)<br /> (repeat (min (sslength ss1)(sslength ss2))<br />   (command "_.CHAMFER"<br />         (osnap (onwplpt (ssname ss1 i) pt1 pt2) "Near")<br />         (osnap (onwplpt (ssname ss2 i) pt3 pt4) "Near")<br />       )<br />   (setq i (1+ i))<br /> )<br /> (defun onwplpt (en p1 p2 / linept lwpt pt)<br />   (defun LWPt (en /)<br />     (mapcar 'cdr<br />       (vl-remove-if-not<br />         '(lambda (x) (or (= (car x) 10) (= (car x) 11)))<br />         (entget en)<br />       )<br />     )<br />   )<br />   (defun LInept (lst )<br />     (if (>= (length lst) 2)<br />       (cons (list (car lst)(cadr lst))<br />         (LInept<br />           (vl-remove<br />             (car Lst)<br />             lst<br />           )<br />         )<br />       )<br />     )<br />   )<br />   (mapcar '(lambda (x / inte) <br />              (if (setq inte (inters (car x) (cadr x) p1 p2 nil))<br />                (if (IsOnLine (car x) (cadr x) inte )<br />                  inte<br />                )<br />              )<br />            )<br />     (LInept (lwpt en))<br />   )<br />   inte<br /> ) <br />   

；批量倒角，代码错误，不知道错在哪里了，大家给看看

xj6019

非常给力,一直致力于寻找这么一款插件，这个能实现一部分吧，测试了一下，稍有遗憾，距离很近的线判断有问题，不能倒角，期待有人还可以改善完美一下这个插件。谢谢楼主的分享。

bloodtempt

1. (defun C:fvd (/ i onwplpt pt1 pt2 pt3 pt4 ss1 ss2 vl-remz)
   
2.   (defun vl-remz (pt)
   
3.     (vl-remove (last pt) pt)
   
4.   )
   
5.   (defun onwplpt (en p1 p2 / linept lwpt inte)
   
6.     (defun LWPt (en /)
   
7.       (mapcar 'cdr
   
8.         (vl-remove-if-not
   
9.           '(lambda (x) (or (= (car x) 10) (= (car x) 11)))
   
10.           (entget en)
    
11.         )
    
12.       )
    
13.     )
    
14.     (defun LInept (lst )
    
15.       (if (>= (length lst) 2)
    
16.         (cons (list (car lst)(cadr lst))
    
17.           (LInept
    
18.             (vl-remove
    
19.               (car Lst)
    
20.               lst
    
21.             )
    
22.           )
    
23.         )
    
24.       )
    
25.     )
    
26.     (mapcar '(lambda (x)
    
27.                (if (setq inte (inters (car x) (cadr x) p1 p2 nil))
    
28.                  (if (IsOnLine (car x) (cadr x) inte )
    
29.                    inte
    
30.                  )
    
31.                )
    
32.              )
    
33.       (LInept (lwpt en))
    
34.     )
    
35.     inte
    
36.   )
    
37.   (setq ss1 (ssget "F" (list
    
38.                          (setq pt1 (vl-remz (getpoint "选择第一组线：")))
    
39.                          (setq pt2 (vl-remz (getpoint pt1))))))
    
40.   (setq ss2 (ssget "F" (list
    
41.                          (setq pt3 (vl-remz (getpoint "选择第二组线：")))
    
42.                          (setq pt4 (vl-remz (getpoint pt3))))))
    
43.   (setq i 0)
    
44.   (repeat (min (sslength ss1)(sslength ss2))
    
45.     (command "_.CHAMFER"
    
46.       (onwplpt (ssname ss1 i) pt1 pt2)
    
47.       (onwplpt (ssname ss2 i) pt3 pt4)
    
48.     )
    
49.     (setq i (1+ i))
    
50.   )
    
51. )

(defun C:fvd (/ i onwplpt pt1 pt2 pt3 pt4 ss1 ss2 vl-remz)<br />   (defun vl-remz (pt)<br />     (vl-remove (last pt) pt)<br />   )<br />   (defun onwplpt (en p1 p2 / linept lwpt inte)<br />     (defun LWPt (en /)<br />       (mapcar 'cdr<br />         (vl-remove-if-not<br />           '(lambda (x) (or (= (car x) 10) (= (car x) 11)))<br />           (entget en)<br />         )<br />       )<br />     )<br />     (defun LInept (lst )<br />       (if (>= (length lst) 2)<br />         (cons (list (car lst)(cadr lst))<br />           (LInept<br />             (vl-remove<br />               (car Lst)<br />               lst<br />             )<br />           )<br />         )<br />       )<br />     )<br />     (mapcar '(lambda (x) <br />                (if (setq inte (inters (car x) (cadr x) p1 p2 nil))<br />                  (if (IsOnLine (car x) (cadr x) inte )<br />                    inte<br />                  )<br />                )<br />              )<br />       (LInept (lwpt en))<br />     )<br />     inte<br />   ) <br />   (setq ss1 (ssget "F" (list <br />                          (setq pt1 (vl-remz (getpoint "选择第一组线：")))<br />                          (setq pt2 (vl-remz (getpoint pt1))))))<br />   (setq ss2 (ssget "F" (list <br />                          (setq pt3 (vl-remz (getpoint "选择第二组线：")))<br />                          (setq pt4 (vl-remz (getpoint pt3))))))<br />   (setq i 0)<br />   (repeat (min (sslength ss1)(sslength ss2))<br />     (command "_.CHAMFER"<br />       (onwplpt (ssname ss1 i) pt1 pt2)<br />       (onwplpt (ssname ss2 i) pt3 pt4)<br />     )<br />     (setq i (1+ i))<br />   )<br /> )

都爱拿现成的，那，修改了一下，可以用了，多段线还有点毛病，再查原因

yoyoho

缺函数 "IsOnLine"

bai2000

不能用

春鸽带你飞

少个函数，没法调试 错误: no function definition: ISONLINE

bloodtempt

春鸽带你飞 发表于 2019-5-6 12:45
少个函数，没法调试 错误: no function definition: ISONLINE

(defun IsOnLine (p1 p2 px)
        (< (abs (- (+ (distance p1 px) (distance p2 px)) (distance p1 p2))) 0.001)
)

bai2000

对多段线不能用

magicheno

好像可以用非常给力

magicheno

貌似会有错误，有时间会出错的