修剪出错

祥子

Jack_PC 发表于 2011-7-17 22:08
你能帮我看楼下刚贴的全部程序吗?

;画矩形并倒圆角
(Defun C:Rer (/ pt1 pt2 r os)
  (Initget 1)
  (Setq pt1 (Getpoint "\n 指定左下角点: "))
  (Initget 3)
  (setq pt2 (getcorner pt1 "\n请指定对角点:"))
  (setq os(getvar 'osmode))

  (Setvar "Cmdecho" 0)
  (Setvar "osmode" 0)
  (Command "Rectangle" Pt1 pt2)
  (Initget 4)
  (Setq R (Getreal "\n 指定圆角半径 <1.0>: "))
  (If R Null) (Setq R 1)
  (Setvar "Filletrad" R)
  (Command "Fillet" "P" (Entlast))
  (setvar 'osmode os)
(Prin1))

ljpnb

不知道是不是这样的结果

2. 
   
3. (defun c:test ()
   
4.   (setq pt1 (getpoint "\n请指定第一角点:"))
   
5.   (setq pt2 (getcorner pt1 "\n请指定对角点:"))
   
6.   (setq r 3.0)
   
7.   (setvar "edgemode" 0)
   
8.   (command "RECTANG" pt1 pt2)
   
9.   (setq en (entlast))
   
10.   (command "fillet" "r" r)
    
11.   (command "fillet" "p" (list en pt1))
    
12.   (setq en (entlast))
    
13.   (command "explode" en)
    
14.   (setq ss (ssadd))
    
15.   (while (setq en (entnext en))
    
16.     (ssadd en ss)
    
17.   )
    
18.   (setq k 0)
    
19.   (repeat (sslength ss)
    
20.     (setq en  (ssname ss k)
    
21.           ent (entget en)
    
22.     )
    
23.     (if        (= (cdr (assoc 0 ent)) "LINE")
    
24.       (entdel en)
    
25.     )
    
26.     (setq k (1+ k))
    
27.   )
    
28.   (princ)
    
29. )
    

<br /> (defun c:test ()<br />   (setq pt1 (getpoint "\n请指定第一角点:"))<br />   (setq pt2 (getcorner pt1 "\n请指定对角点:"))<br />   (setq r 3.0)<br />   (setvar "edgemode" 0)<br />   (command "RECTANG" pt1 pt2)<br />   (setq en (entlast))<br />   (command "fillet" "r" r)<br />   (command "fillet" "p" (list en pt1))<br />   (setq en (entlast))<br />   (command "explode" en)<br />   (setq ss (ssadd))<br />   (while (setq en (entnext en))<br />     (ssadd en ss)<br />   )<br />   (setq k 0)<br />   (repeat (sslength ss)<br />     (setq en  (ssname ss k)<br />           ent (entget en)<br />     )<br />     (if        (= (cdr (assoc 0 ent)) "LINE")<br />       (entdel en)<br />     )<br />     (setq k (1+ k))<br />   )<br />   (princ)<br /> )<br />

Jack_PC

谢谢各位，我的意思是长方形不是程序生成的，是图档中已经存在的，只需要在CAD中运行这个程序实现倒圆角，请看下图片所示结果

zhynt

拉框圆角：

2. 
   
3. (defun c:test ()
   
4.   (setq oldos (getvar "osmode"))
   
5.   (setq        oldcmd        (getvar "cmdecho"))
   
6.   (setvar "cmdecho" 0)       
   
7.   (setq tf T)
   
8.   (setq pta (getpoint "\n指定一个角点:"))  
   
9.   (while tf
   
10.     (initget "R")
    
11.     (setq ptc (getcorner pta (strcat "\n指定另一个角点[圆角半径(R)]:<"(rtos (setq fil (getvar "FILLETRAD")))">")))
    
12.     (cond
    
13.       ((= ptc "R")
    
14.        (setq fil (getreal (strcat "\n指定圆角半径:<" (rtos (getvar "FILLETRAD"))">")))
    
15.        (if (= fil nil)
    
16.          (setq fil (getvar "FILLETRAD"))
    
17.          (setvar "FILLETRAD" fil)
    
18.        )
    
19.       )
    
20.       ((= (type ptc) 'list)
    
21.        (setq tf nil)
    
22.        (setq ptn (list (min (car pta) (car ptc))
    
23.                        (min (cadr pta) (cadr ptc))
    
24.                  )
    
25.              ptc (list (max (car pta) (car ptc))
    
26.                        (max (cadr pta) (cadr ptc))
    
27.                  )
    
28.              pta ptn
    
29.        )
    
30.        (setq ptb (list (car pta) (cadr ptc))
    
31.              ptd (list (car ptc) (cadr pta))
    
32.        )
    
33.        (if (< oldos 16384)
    
34.             (setvar "osmode" (+ oldos 16384))
    
35.           )
    
36.        (setq fil (getvar "FILLETRAD"))   
    
37.        (if (/= fil 0)
    
38.          (progn
    
39.            (setq pt1 (polar pta (* 0.5 pi) fil)
    
40.                  pt2 (polar ptb (* 0.5 pi 3) fil)
    
41.                  pt3 (polar ptb 0 fil)
    
42.                  pt4 (polar ptc pi fil)
    
43.                  pt5 (polar ptc (* 0.5 pi 3) fil)
    
44.                  pt6 (polar ptd (* 0.5 pi) fil)
    
45.                  pt7 (polar ptd pi fil)
    
46.                  pt8 (polar pta 0 fil)                 
    
47.            )
    
48.            (command "pline"        pt1   pt2   "a"          pt3        "L"   pt4
    
49.                     "A"          pt5        "L"   pt6   "A"          pt7        "L"   pt8
    
50.                     "A"          "CL"
    
51.                    )
    
52.          )
    
53.          (command "RECTANGLE" pta ptc)
    
54.        )
    
55.       )
    
56.     )
    
57.   )
    
58.   (setvar "osmode" oldos)
    
59.   (setvar "cmdecho" oldcmd)
    
60.   (princ)
    
61. )
    

<br /> (defun c:test ()<br />   (setq oldos (getvar "osmode"))<br />   (setq        oldcmd        (getvar "cmdecho"))<br />   (setvar "cmdecho" 0)        <br />   (setq tf T)<br />   (setq pta (getpoint "\n指定一个角点:"))  <br />   (while tf<br />     (initget "R")<br />     (setq ptc (getcorner pta (strcat "\n指定另一个角点[圆角半径(R)]:<"(rtos (setq fil (getvar "FILLETRAD")))">")))<br />     (cond<br />       ((= ptc "R")<br />        (setq fil (getreal (strcat "\n指定圆角半径:<" (rtos (getvar "FILLETRAD"))">")))<br />        (if (= fil nil)<br />          (setq fil (getvar "FILLETRAD"))<br />          (setvar "FILLETRAD" fil)<br />        )<br />       )<br />       ((= (type ptc) 'list)<br />        (setq tf nil)<br />        (setq ptn (list (min (car pta) (car ptc))<br />                        (min (cadr pta) (cadr ptc))<br />                  )<br />              ptc (list (max (car pta) (car ptc))<br />                        (max (cadr pta) (cadr ptc))<br />                  )<br />              pta ptn<br />        )<br />        (setq ptb (list (car pta) (cadr ptc))<br />              ptd (list (car ptc) (cadr pta))<br />        )<br />        (if (< oldos 16384)<br />             (setvar "osmode" (+ oldos 16384))<br />           )<br />        (setq fil (getvar "FILLETRAD"))    <br />        (if (/= fil 0)<br />          (progn<br />            (setq pt1 (polar pta (* 0.5 pi) fil)<br />                  pt2 (polar ptb (* 0.5 pi 3) fil)<br />                  pt3 (polar ptb 0 fil)<br />                  pt4 (polar ptc pi fil)<br />                  pt5 (polar ptc (* 0.5 pi 3) fil)<br />                  pt6 (polar ptd (* 0.5 pi) fil)<br />                  pt7 (polar ptd pi fil)<br />                  pt8 (polar pta 0 fil)                 <br />            )<br />            (command "pline"        pt1   pt2   "a"          pt3        "L"   pt4<br />                     "A"          pt5        "L"   pt6   "A"          pt7        "L"   pt8<br />                     "A"          "CL"<br />                    )<br />          )<br />          (command "RECTANGLE" pta ptc)<br />        )<br />       )<br />     )<br />   )<br />   (setvar "osmode" oldos)<br />   (setvar "cmdecho" oldcmd)<br />   (princ)<br /> )<br />

zhynt

选择矩形倒圆角

2. 
   
3. (defun c:test ()
   
4.   (setq tf T)
   
5.   (setq ptn (getpoint "\n指定一个角点:"))
   
6.   (while tf
   
7.     (initget "R")
   
8.     (setq
   
9.       ptm (getcorner ptn
   
10.                      (strcat "\n指定另一个角点[圆角半径(R)]:<"
    
11.                              (rtos (setq fil (getvar "FILLETRAD")))
    
12.                              ">"
    
13.                      )
    
14.           )
    
15.     )
    
16.     (cond
    
17.       ((= ptm "R")
    
18.        (setq fil (getreal (strcat "\n指定圆角半径:<"
    
19.                                   (rtos (getvar "FILLETRAD"))
    
20.                                   ">"
    
21.                           )
    
22.                  )
    
23.        )
    
24.        (if (= fil nil)
    
25.          (setq fil (getvar "FILLETRAD"))
    
26.          (setvar "FILLETRAD" fil)
    
27.        )
    
28.       )
    
29.       ((= (type ptm) 'list)
    
30.        (setq tf nil)
    
31.        (setq ss (ssget "w" ptn ptm '((0 . "LWPOLYLINE"))))
    
32.        (setq n 0)
    
33.        (repeat (sslength ss)
    
34.          (setq en (ssname ss n))
    
35.          (command "FILLET" "P" en)
    
36.          (setq n (1+ n))
    
37.        )
    
38.       )
    
39.     )
    
40.   )
    
41. )
    

<br /> (defun c:test ()<br />   (setq tf T)<br />   (setq ptn (getpoint "\n指定一个角点:"))<br />   (while tf<br />     (initget "R")<br />     (setq<br />       ptm (getcorner ptn<br />                      (strcat "\n指定另一个角点[圆角半径(R)]:<"<br />                              (rtos (setq fil (getvar "FILLETRAD")))<br />                              ">"<br />                      )<br />           )<br />     )<br />     (cond<br />       ((= ptm "R")<br />        (setq fil (getreal (strcat "\n指定圆角半径:<"<br />                                   (rtos (getvar "FILLETRAD"))<br />                                   ">"<br />                           )<br />                  )<br />        )<br />        (if (= fil nil)<br />          (setq fil (getvar "FILLETRAD"))<br />          (setvar "FILLETRAD" fil)<br />        )<br />       )<br />       ((= (type ptm) 'list)<br />        (setq tf nil)<br />        (setq ss (ssget "w" ptn ptm '((0 . "LWPOLYLINE"))))<br />        (setq n 0)<br />        (repeat (sslength ss)<br />          (setq en (ssname ss n))<br />          (command "FILLET" "P" en)<br />          (setq n (1+ n))<br />        )<br />       )<br />     )<br />   )<br /> )<br />

ljpnb

Jack_PC 发表于 2011-7-17 23:27
谢谢各位，我的意思是长方形不是程序生成的，是图档中已经存在的，只需要在CAD中运行这个程序实现倒圆角，请 ...

如果长方形是用rectang画的，这样就可以了
(setvar "FILLETRAD"  3.0);;3.0可以用变量输入
(command "fillet" "p" (entsel))

zhynt

不错，一时没想到，搞复杂了。

Jack_PC

谢谢各位!
长方形是分别由四条直线组成,非常希望此问题大家帮助解决,前面我贴出的程序只可以在2004中运行正常,但是在2010中就出错,

Andyhon

...但是在2010中就出错...
???
看不出有何干碍
请上传样本文件(*.Dwg )以利诊断

Jack_PC

Andyhon 发表于 2011-7-18 21:17
...但是在2010中就出错...
???
看不出有何干碍

这是2010的DWG档案，请帮我看看