框选进行批量倒圆

crazylsp

程序中d1 (distance p2 pp1)好像d1要改成d3 哈。

lidaxiu

呵呵，这个不错好多地方能用的到

yaokui25

呵呵，这个不错好多地方能用的到

yaokui25

xiaxiang 发表于 2012-4-24 14:34
对程序进行了重写

为什么执行命令之后，在原来图形基础上又做了一个圆弧，也就是原来的图形仍然保留着。这是什么原因呢？大家没有这种现象？我是菜鸟，希望能得到楼主的解答

♂葶芷の跳動.√

【KAIXIN】 发表于 2012-4-23 18:20
程序没有问题，应该是CAD的问题....

你好。我想要这个文件，又不知道从那里下载，能给我一个吗？？在此感放……327178801@qq.com

laorenhao999

感激15楼啊，大好人！

dabingrain

2. ;批量倒圆角
   
3. (defun c:TT ( / rr minl maxr n en en1 en2 CURVE TLEN)
   
4.   (setq cm (getvar "cmdecho") os (getvar "osmode"))
   
5.   (setvar "cmdecho" 0)       
   
6.         (COMMAND ".undo" "BE")
   
7.   (prompt "请选择直线，相连的才能倒角:")
   
8.   (while (setq en (ssget '((0 . "LINE"))))
   
9.                 (setq N 0 MINL 0)
   
10.                 (repeat (sslength en)
    
11.                         (setq CURVE (vlax-ename->vla-object (ssname en N)))
    
12.                         (setq TLEN (vlax-curve-getdistatparam
    
13.                                                                          CURVE
    
14.                                                                          (vlax-curve-getendparam CURVE)
    
15.                                                                  )
    
16.                         )
    
17.                         (if (= minl 0) (setq minl tlen))
    
18.                         (if (> minl tlen) (setq minl tlen))
    
19.                         (setq N (1+ N))
    
20.                 )
    
21.                 (setq maxR (/ minl 2))
    
22.                 (if ( = rr nil)(setq rr (1+ maxR)))               
    
23.                 (while (> rr  maxR)
    
24.                         (setq rr (getreal (strcat "\n 输入r的大小 R≤" (rtos maxR) ":<" (rtos (fix maxR)) ">")) aa nil)
    
25.                 )
    
26.                 (setq n (sslength en))
    
27.                 (command "fillet" "r" rr)
    
28.                 (setq n (1- n))
    
29.                 (while (>= n 1)
    
30.                         (setq
    
31.                                 en1 (ssname en n)
    
32.                                 en2 (ssname en (setq n (1- n))))                                       
    
33.                         (if (HH:TwoEntsInters en1 en2 0)
    
34.                                 (vl-cmdf "fillet" en1 en2)
    
35.                         )
    
36.                 )
    
37.                 (prompt "请选择直线，相连的才能倒角:")
    
38.         )
    
39.         (setvar "cmdecho" cm)
    
40.         (COMMAND ".undo" "E")
    
41.         (princ)
    
42. )

;批量倒圆角<br /> (defun c:TT ( / rr minl maxr n en en1 en2 CURVE TLEN)<br />   (setq cm (getvar "cmdecho") os (getvar "osmode"))<br />   (setvar "cmdecho" 0)        <br />         (COMMAND ".undo" "BE")<br />   (prompt "请选择直线，相连的才能倒角:")<br />   (while (setq en (ssget '((0 . "LINE"))))<br />                 (setq N 0 MINL 0) <br />                 (repeat (sslength en) <br />                         (setq CURVE (vlax-ename->vla-object (ssname en N))) <br />                         (setq TLEN (vlax-curve-getdistatparam <br />                                                                          CURVE <br />                                                                          (vlax-curve-getendparam CURVE) <br />                                                                  ) <br />                         )<br />                         (if (= minl 0) (setq minl tlen))<br />                         (if (> minl tlen) (setq minl tlen))<br />                         (setq N (1+ N)) <br />                 ) <br />                 (setq maxR (/ minl 2))<br />                 (if ( = rr nil)(setq rr (1+ maxR)))                <br />                 (while (> rr  maxR)<br />                         (setq rr (getreal (strcat "\n 输入r的大小 R≤" (rtos maxR) ":<" (rtos (fix maxR)) ">")) aa nil)<br />                 )<br />                 (setq n (sslength en))<br />                 (command "fillet" "r" rr)<br />                 (setq n (1- n))<br />                 (while (>= n 1)<br />                         (setq<br />                                 en1 (ssname en n)<br />                                 en2 (ssname en (setq n (1- n))))                                        <br />                         (if (HH:TwoEntsInters en1 en2 0)<br />                                 (vl-cmdf "fillet" en1 en2)<br />                         )<br />                 )<br />                 (prompt "请选择直线，相连的才能倒角:")<br />         )<br />         (setvar "cmdecho" cm)<br />         (COMMAND ".undo" "E")<br />         (princ)<br /> )