关于批量框选修改R角

快乐王子刚

关于批量框选修改R角

这样的插件，哪个高手帮忙写一下，非常感谢。

newer

先去看看这个帖子， http://bbs.xdcad.net/thread-671374-1-1.html 非模式对话框倒角插件，看看满足要求不，如果需要改进再跟帖。

快乐王子刚

newer 发表于 2016-9-16 15:33

个人感觉有个对话框出来，不是太方便，能不能就像演示那样，输入R角就可以，我只需要倒R角，不用倒C角。我提供一个代码，你看看能不能改一下，好像里面有ET函数，但是我安装了ET还是用不了。能不能改为晓东的函数。
(defun c:ffrr (/ newrad ss pts i ee)
   (setq newrad (getreal "\n请输入新的半径："))
   (setvar "FilletRad" newrad)
   (setq ss (ssget '(( 0 . "LINE,ARC,LWPOLYLINE"))))
   (setq pts (acet-geom-ss-extents ss nil))     ; ET func
   (SetVar "PeditAccept" 1)
   (command "Pedit" "M" ss "" "J" "" "")
   (setq ss (ssget "C" (car pts) (cadr pts) '(( 0 . "LWPOLYLINE")))
          i  0
   )

   (while (setq ee (ssname ss i))
     (command "Fillet" "P" ee)
     (setq i (1+ i))
   )
)

newer

快乐王子刚 发表于 2016-9-16 15:50

试试，代码可以批量多次对已经倒角的多次操作

1. (defun c:tt ()
   
2.   (if (and
   
3.         (setq r (getreal "\n输入倒角半径<退出>:"))
   
4.         (setq ss (ssget '((0 . "LWPOLYLINE"))))
   
5.       )
   
6.     (progn
   
7.       (xdrx_setsstodb ss 0)
   
8.       (while (setq e (xdrx_getentdata 0))
   
9.         (xdrx_polyline_compress e)
   
10.         (setq ss1 (xdrx_entity_explode e)
    
11.               ss1 (ssdel e ss1)
    
12.         )
    
13.         (setq pls (xdrx_pickset->ents ss1))
    
14.         (setq pls (mapcar
    
15.           '(lambda (x)
    
16.              (if (xdrx_object_isa x "AcDbArc")
    
17.                (xdrx_entity_delete x)
    
18.                x
    
19.              )
    
20.            )
    
21.           pls
    
22.         ))
    
23.         (setq pls (vl-remove t pls))
    
24.         (if (setq tf (xdrx_curve_isclosed e))
    
25.           (setq pls1 (cons (last pls) pls))
    
26.           (setq pls1 pls)
    
27.         )
    
28.         (setq pls2 nil)
    
29.         (mapcar
    
30.           '(lambda (x)
    
31.              (setq x1 (car x)
    
32.                    x2 (cadr x)
    
33.              )
    
34.              (if (and
    
35.                    (xdrx_object_isa x1 "AcDbLine")
    
36.                    (xdrx_object_isa x2 "AcDbLine")
    
37.                    (xdrx_curve_fillet x1 x2 r)
    
38.                  )
    
39.                (progn
    
40.                  (setq pls2 (cons (entlast) pls2))
    
41.                )
    
42.              )
    
43.            )
    
44.           (xd::list:snakePair pls1)
    
45.         )
    
46.         (xdrx_curve->polyline (append
    
47.                                 pls2
    
48.                                 pls1
    
49.                               )
    
50.         )
    
51.         (setq n (entlast))
    
52.         (xdrx_entity_matchprop e n)
    
53.         (xdrx_polyline_compress n)
    
54.         (if tf
    
55.           (xdrx_setpropertyvalue n "closed" t)
    
56.         )
    
57.         (xdrx_object_swapid n e)
    
58.         (xdrx_entity_delete n)
    
59.       )
    
60.     )
    
61.   )
    
62.   (princ)
    
63. )
    
64. 
    

(defun c:tt ()<br />   (if (and<br />         (setq r (getreal "\n输入倒角半径<退出>:"))<br />         (setq ss (ssget '((0 . "LWPOLYLINE"))))<br />       )<br />     (progn<br />       (xdrx_setsstodb ss 0)<br />       (while (setq e (xdrx_getentdata 0))<br />         (xdrx_polyline_compress e)<br />         (setq ss1 (xdrx_entity_explode e)<br />               ss1 (ssdel e ss1)<br />         )<br />         (setq pls (xdrx_pickset->ents ss1))<br />         (setq pls (mapcar<br />           '(lambda (x)<br />              (if (xdrx_object_isa x "AcDbArc")<br />                (xdrx_entity_delete x)<br />                x<br />              )<br />            )<br />           pls<br />         ))<br />         (setq pls (vl-remove t pls))<br />         (if (setq tf (xdrx_curve_isclosed e))<br />           (setq pls1 (cons (last pls) pls))<br />           (setq pls1 pls)<br />         )<br />         (setq pls2 nil)<br />         (mapcar<br />           '(lambda (x)<br />              (setq x1 (car x)<br />                    x2 (cadr x)<br />              )<br />              (if (and<br />                    (xdrx_object_isa x1 "AcDbLine")<br />                    (xdrx_object_isa x2 "AcDbLine")<br />                    (xdrx_curve_fillet x1 x2 r)<br />                  )<br />                (progn<br />                  (setq pls2 (cons (entlast) pls2))<br />                )<br />              )<br />            )<br />           (xd::list:snakePair pls1)<br />         )<br />         (xdrx_curve->polyline (append<br />                                 pls2<br />                                 pls1<br />                               )<br />         )<br />         (setq n (entlast))<br />         (xdrx_entity_matchprop e n)<br />         (xdrx_polyline_compress n)<br />         (if tf<br />           (xdrx_setpropertyvalue n "closed" t)<br />         )<br />         (xdrx_object_swapid n e)<br />         (xdrx_entity_delete n)<br />       )<br />     )<br />   )<br />   (princ)<br /> )<br /> <br />

如果可以， 希望做个你的例子的动画传上来，我用它更新每日插件。

如果需要完善，跟帖。

快乐王子刚

newer 发表于 2016-9-16 17:30

你的这个也可以实现 ，只是觉得不是太方便。而且你的这个倒完R角之后，想再倒回直角，就出现错误。我提供一个，非常好用，感谢@LISPBOY提供的帮助。


(defun c:fe (/ *rr ss pts i ee)
(defun ssbox ( s / a b i m n o )
    (repeat (setq i (sslength s))
        (if
            (and
                (setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
                (vlax-method-applicable-p o 'getboundingbox)
                (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b))))
            )
            (setq m (cons (vlax-safearray->list a) m)
                  n (cons (vlax-safearray->list b) n)
            )
        )
    )
    (if (and m n)
        (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list m n))
    )
)
(if (not *rr) (setq *rr 0.00))
   (setq ss (ssget '(( 0 . "LINE,ARC,LWPOLYLINE"))))
   (setq pts (ssbox ss))
   (SetVar "PeditAccept" 1)
   (setq *rr (cond((getreal (strcat "\n输入倒角半径 <"(rtos *rr 2 2) ">: ")))(*rr)))
   (setvar "FilletRad" *rr)
   (command "Pedit" "M" ss "" "J" "" "")
   (setq ss (ssget "C" (car pts) (cadr pts) '(( 0 . "LWPOLYLINE")))
          i  0
   )
   (while (setq ee (ssname ss i))
     (command "Fillet" "P" ee)
     (setq i (1+ i))
   )
)

守仁格竹GM

                           

y0yxt

插件见附件
加载后输入 af

sicky111

晓东老大评了分，说明是个好东西。

止步不殇

还不知道怎么入门的我感觉好厉害啊~