实现框选一次性倒R角

Andyhon

请回8#

More info:
http://www.google.com/search?as_ ... A%2F%2Fbbs.mjtd.com

皇上快溜

Andyhon 发表于 2012-5-18 10:55

Andyhon你好，你这个程序超级迷人。请问，想让下列短程序很你这个程序串接起来使用，该怎么弄？
(defun c:F()(command "FILLET" "R" "(getreal "\n请输入新的半径：")" "FILLET") (PRINC))
(defun c:FF()(command "FILLET" "R" "0" "FILLET") (PRINC))         
(defun c:F1()(command "FILLET" "R" "0.1" "FILLET") (PRINC))         
(defun c:F15()(command "FILLET" "R" "0.15" "FILLET") (PRINC))
(defun c:F2()(command "FILLET" "R" "0.2" "FILLET") (PRINC))         
(defun c:F25()(command "FILLET" "R" "0.25" "FILLET") (PRINC))
。。。。。
。。。。。
短程序赋予倒角R值，然后统一串接到你这个程序上，以实现框选倒角




另外，你这个程序框选倒角之后是是条连成一体的多义线，能不能让它变成炸开的？

Andyhon

2. 
   
3. (defun ffr (rad / newrad ss pts i ee)
   
4.    ;; (setq newrad (getreal "\n请输入新的半径："))
   
5.    (setvar "FilletRad" rad)
   
6.    (setq ss (ssget '(( 0 . "LINE,ARC,LWPOLYLINE"))))
   
7. 
   
8.    (setq pts (acet-geom-ss-extents ss nil))     ; ET func
   
9.    (SetVar "PeditAccept" 1)
   
10.    (command "Pedit" "M" ss "" "J" "" "")
    
11.    (setq ss (ssget "C" (car pts) (cadr pts) '(( 0 . "LWPOLYLINE")))
    
12.           i  0
    
13.    )
    
14. 
    
15.    (while (setq ee (ssname ss i))
    
16.      (command "Fillet" "P" ee)
    
17.      (setq i (1+ i))
    
18.    )
    
19. )
    
20. 
    
21. 以 (defun c:F25()(command "FILLET" "R" "0.25" "FILLET") (PRINC)) 为例
    
22. 
    
23. (defun c:F25() (ffr 0.25))
    
24. 
    
25. ;;; 单一 LwPolyline 适用
    
26. ;;; 炸开
    
27. (defun c:F25()(ffr 0.25) (command "explode" (entlast)))
    
28. 
    
29. ;;; 多重时函式修订
    
30.    (while (setq ee (ssname ss i))
    
31.      (command "Fillet" "P" ee)
    
32.      (setq i (1+ i))
    
33.      (command "explode" (entlast))
    
34.    )
    

<br /> (defun ffr (rad / newrad ss pts i ee)<br />    ;; (setq newrad (getreal "\n请输入新的半径："))<br />    (setvar "FilletRad" rad)<br />    (setq ss (ssget '(( 0 . "LINE,ARC,LWPOLYLINE"))))<br /> <br />    (setq pts (acet-geom-ss-extents ss nil))     ; ET func<br />    (SetVar "PeditAccept" 1)<br />    (command "Pedit" "M" ss "" "J" "" "")<br />    (setq ss (ssget "C" (car pts) (cadr pts) '(( 0 . "LWPOLYLINE")))<br />           i  0<br />    )<br /> <br />    (while (setq ee (ssname ss i))<br />      (command "Fillet" "P" ee)<br />      (setq i (1+ i))<br />    )<br /> )<br /> <br /> 以 (defun c:F25()(command "FILLET" "R" "0.25" "FILLET") (PRINC)) 为例<br /> <br /> (defun c:F25() (ffr 0.25))<br /> <br /> ;;; 单一 LwPolyline 适用<br /> ;;; 炸开<br /> (defun c:F25()(ffr 0.25) (command "explode" (entlast)))<br /> <br /> ;;; 多重时函式修订<br />    (while (setq ee (ssname ss i))<br />      (command "Fillet" "P" ee)<br />      (setq i (1+ i))<br />      (command "explode" (entlast))<br />    )<br />

lqplvhehe321

mark回头好好研究

ketxu

I changed it to not depend on Express function

1. (defun c:fps (/  ss pts i ee :ST:SS-Boundingbox :ST:SS->List :ST:SS->ListVla LM:ssget os ov)
   
2. (setq
   
3.         os '(PeditAccept cmdecho)
   
4.         ov (mapcar 'getvar os)
   
5. )
   
6. (mapcar 'setvar os '(1 0))
   
7. (defun LM:ssget ( msg arg / sel )
   
8.     (princ msg)
   
9.     (setvar 'nomutt 1)
   
10.     (setq sel (vl-catch-all-apply 'ssget arg))
    
11.     (setvar 'nomutt 0)
    
12.     (if (not (vl-catch-all-error-p sel)) sel)
    
13. )
    
14. ;Return list ename from ssget
    
15. (defun :ST:SS->List(ss / n e l)
    
16.   (setq n (sslength ss))
    
17.   (while (setq e (ssname ss (setq n (1- n))))
    
18.     (setq l (cons e l))
    
19.   )  
    
20. )
    
21. ;Return list vla Object from s
    
22. (defun :ST:SS->ListVla(s)(mapcar 'vlax-ename->vla-object (:ST:SS->List s)))
    
23. (defun :ST:SS-Boundingbox ( lst / llp ls1 ls2 urp )
    
24.     (foreach obj lst
    
25.         (vla-getboundingbox obj 'llp 'urp)
    
26.         (setq ls1 (cons (vlax-safearray->list llp) ls1)
    
27.               ls2 (cons (vlax-safearray->list urp) ls2)
    
28.         )
    
29.     )
    
30.     (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2))
    
31. )
    
32.            (or  *newrad* (setq *newrad* 1))        
    
33.    (setq *newrad* (getdist (strcat "\nB\U+00E1n k\U+00EDnh fillet <" (rtos *newrad*) "> :")))
    
34.    (setvar "FilletRad" *newrad*)
    
35.    ;(setq ss (ssget '(( 0 . "LINE,ARC,LWPOLYLINE"))))
    
36.    (setq ss (LM:ssget "Select Line, Arc, Pline to fillet :" (list '(( 0 . "LINE,ARC,LWPOLYLINE")))))
    
37. 
    
38.    (setq pts (:ST:SS-Boundingbox (:ST:SS->ListVla ss )))     ; ET func
    
39.    
    
40.    (command "edit" "M" ss "" "J" "" "")
    
41.    (setq ss (ssget "C" (car pts) (cadr pts) '(( 0 . "LWPOLYLINE")))
    
42.           i  0
    
43.    )
    
44.    
    
45.    (while (setq ee (ssname ss i))
    
46.      (command "Fillet" "" ee)
    
47.      (setq i (1+ i))
    
48.    )
    
49.    (mapcar 'setvar os ov)
    
50.    (princ)
    
51. )

(defun c:fps (/  ss pts i ee :ST:SS-Boundingbox :ST:SS->List :ST:SS->ListVla LM:ssget os ov)<br /> (setq<br />         os '(PeditAccept cmdecho)<br />         ov (mapcar 'getvar os)<br /> )<br /> (mapcar 'setvar os '(1 0))<br /> (defun LM:ssget ( msg arg / sel )<br />     (princ msg)<br />     (setvar 'nomutt 1)<br />     (setq sel (vl-catch-all-apply 'ssget arg))<br />     (setvar 'nomutt 0)<br />     (if (not (vl-catch-all-error-p sel)) sel)<br /> )<br /> ;Return list ename from ssget<br /> (defun :ST:SS->List(ss / n e l)<br />   (setq n (sslength ss))<br />   (while (setq e (ssname ss (setq n (1- n))))<br />     (setq l (cons e l))<br />   )  <br /> )<br /> ;Return list vla Object from s<br /> (defun :ST:SS->ListVla(s)(mapcar 'vlax-ename->vla-object (:ST:SS->List s)))<br /> (defun :ST:SS-Boundingbox ( lst / llp ls1 ls2 urp )<br />     (foreach obj lst<br />         (vla-getboundingbox obj 'llp 'urp)<br />         (setq ls1 (cons (vlax-safearray->list llp) ls1)<br />               ls2 (cons (vlax-safearray->list urp) ls2)<br />         )<br />     )<br />     (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2))<br /> )<br />            (or  *newrad* (setq *newrad* 1))        <br />    (setq *newrad* (getdist (strcat "\nB\U+00E1n k\U+00EDnh fillet <" (rtos *newrad*) "> :")))<br />    (setvar "FilletRad" *newrad*)<br />    ;(setq ss (ssget '(( 0 . "LINE,ARC,LWPOLYLINE"))))<br />    (setq ss (LM:ssget "Select Line, Arc, Pline to fillet :" (list '(( 0 . "LINE,ARC,LWPOLYLINE")))))<br /> <br />    (setq pts (:ST:SS-Boundingbox (:ST:SS->ListVla ss )))     ; ET func<br />    <br />    (command "<img src="static/image/smiley/default/titter.gif" smilieid="9" border="0" alt="" />edit" "M" ss "" "J" "" "")<br />    (setq ss (ssget "C" (car pts) (cadr pts) '(( 0 . "LWPOLYLINE")))<br />           i  0<br />    )<br />    <br />    (while (setq ee (ssname ss i))<br />      (command "Fillet" "<img src="static/image/smiley/default/titter.gif" smilieid="9" border="0" alt="" />" ee)<br />      (setq i (1+ i))<br />    )<br />    (mapcar 'setvar os ov)<br />    (princ)<br /> )

注册

mark一下，备查-------

下文没句号。

ketxu 发表于 2019-11-4 14:56
I changed it to not depend on Express function

这个可以 就是英文的Bán kính fillet <10.0000> :  Select Line, Arc, Pline to fillet :

kwcs2003

保存不了，怎么回来，一保存就乱码

Ming131564

我也正需要顶一个！

陈小五

时隔11年，请问有这种倒内R角的插件吗C:\Users\111\Desktop\QQ截图20230202095828.png