批量将圆生成正方形,椭圆生成矩形,矩形生成椭圆，正方形生成圆

edata

;;;批量将圆生成正方形,椭圆生成矩形,矩形生成椭圆，正方形生成圆
;;;by edata@2013年11月20日
;;;命令 e2r

2. ;;;批量将圆生成正方形,椭圆生成矩形,矩形生成椭圆，正方形生成圆
   
3. ;;;by edata@2013年11月20日
   
4. ;;;命令 e2r
   
5. (defun c:e2r(/ msg1 msg2 ss en e p0 longp0 shorts p02 ds ang1 ang2 ds2 pts
   
6.        pt ANG ANG11 DS1 DS3 DS4 P1 P11 P11X P2 P3 P4 P40 PT C PT PX1 PX2 PX3 PX4)
   
7.   (vl-load-com)
   
8.   (setq *error*_Old *error*)  ;保存出错处理函数
   
9.   (setq *error* *error*_New)
   
10.   (setq msg1 "\n选择圆,椭圆,矩形:")
    
11.   (setq msg2 "\n未选择对象")
    
12.   (princ msg1)
    
13.   (if (setq ss(ssget '((0 . "ELLIPSE,LWPOLYLINE,circle"))))
    
14.     (progn
    
15.       (vla-StartUndoMark(vla-get-ActiveDocument (vlax-get-acad-object)));结束标记
    
16.     (while (setq en(ssname ss 0))
    
17.       (setq e (entget en))
    
18.       (cond
    
19.   ((= (cdr(assoc 0 e)) "ELLIPSE" )
    
20.       (progn
    
21.       (setq p0 (cdr(assoc 10 e))
    
22.       longp0(cdr (assoc 11 e))
    
23.       shorts(cdr (assoc 40 e)))
    
24.       (setq p02(list (+ (car p0) (car longp0))(+ (cadr p0) (cadr longp0))(+ (caddr p0) (caddr longp0))))
    
25.       (setq ds(distance p0 p02)
    
26.       ang1 (angle p0 p02)
    
27.       ang2 (angle p02 p0)
    
28.       )
    
29.       (setq ds2(* ds shorts))
    
30.       (setq p1(polar p02 (- ang1 (* pi 0.5)) ds2)
    
31.       p4(polar p02 (+ ang1 (* pi 0.5)) ds2)
    
32.       p2(polar p1 ang2 (* ds 2.0))
    
33.       p3(polar p4 ang2 (* ds 2.0))
    
34.       )
    
35.       
    
36.       (setq pts (list p1 p2 p3 p4))
    
37.        (entmake (append    (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length pts))(cons 70 1))
    
38.       (mapcar '(lambda (pt)(cons 10 pt)) pts ))
    
39.   )
    
40.       ))
    
41.   ((= (cdr(assoc 0 e)) "CIRCLE" )
    
42.       (progn
    
43.       (setq p0 (cdr(assoc 10 e))      
    
44.       c(cdr (assoc 40 e)))      
    
45.       (setq px1(polar p0 (* pi 0.0) c)
    
46.       px2(polar p0 (* pi 0.5) c)
    
47.       px3(polar p0 (* pi 1.0) c)
    
48.       px4(polar p0 (* pi 1.5) c)
    
49.       )
    
50.       (setq p1(polar px1 (* pi 0.5) c)
    
51.       p2(polar px2 (* pi 1) c)
    
52.       p3(polar px3 (* pi 1.5) c)
    
53.       p4(polar px4 (* pi 2) c)
    
54.       )      
    
55.       (setq pts (list p1 p2 p3 p4))
    
56.        (entmake (append    (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length pts))(cons 70 1))
    
57.       (mapcar '(lambda (pt)(cons 10 pt)) pts ))
    
58.   )
    
59.       ))
    
60.      ( (= (cdr(assoc 0 e)) "LWPOLYLINE" )
    
61.       (progn
    
62.         (setq pts (ayGetLWPolyLineVTX1 en))
    
63.         (setq p1 (car pts) p2 (cadr pts) p3 (caddr pts) p4 (cadddr pts))
    
64.         (setq ds1(distance p1 p2)
    
65.         ds2 (distance p2 p3)
    
66.         ds3 (distance p3 p4)
    
67.         ds4 (distance p4 p1))
    
68.         (setq ang1(angle p2 p1)
    
69.         ang2(angle p2 p3)
    
70.         ang11(angle p1 p2))        
    
71.         (if (and(and (= (rtos ds1 2 4) (rtos ds3 2 4) )(= (rtos ds2 2 4) (rtos ds4 2 4)))(member (angtos (- ang2 ang1) 1 2) (list "90d0'" "270d0'")))
    
72.         (progn
    
73.     (setq p0(inters p1 p3 p2 p4 nil))
    
74.     (setq p0(list (car p0 )(cadr p0) 0))
    
75.     (if (> ds1 ds2)
    
76.       (progn
    
77.         (setq ang ang11)
    
78.       (setq ds (* ds1 0.5))
    
79.         (setq p40(/ ds2 ds1))
    
80.       )
    
81.       (progn
    
82.         (setq ang ang2)
    
83.       (setq ds (* ds2 0.5))
    
84.         (setq p40(/ ds1 ds2))
    
85.       ))
    
86.     (setq p11x(polar p0 ang  ds))
    
87.     (setq p11x(list (car p11x )(cadr p11x) 0))
    
88.     (setq p11(list (- (car p11x)(car p0))(- (cadr p11x)(cadr p0))(- (caddr p11x)(caddr p0))))
    
89.     (if(/= p40 1.0)
    
90.     (progn      
    
91.        (entmake (list
    
92.             '(0 . "ELLIPSE")
    
93.             '(100 . "AcDbEntity")
    
94.             '(100 . "AcDbEllipse")
    
95.             (cons 10 p0)
    
96.             (cons 11 p11)
    
97.             (cons 40 p40)
    
98.             (cons 42 (* pi 2.0))
    
99.             ))
    
100.       )
     
101.       (progn
     
102.         (entmake(list(cons 0 "circle")(cons 10 p0)(cons 40 ds)))
     
103.         )            
     
104.       );end entmake
     
105.     )
     
106.     (princ"\n无效矩形")
     
107.     )
     
108.         );end progn2
     
109.       );end cond part2
     
110.       );end cond
     
111.       (setq ss (ssdel en ss))
     
112.       )
     
113.       (vla-EndUndoMark(vla-get-ActiveDocument (vlax-get-acad-object)));结束标记
     
114.       )
     
115.     (princ msg2)
     
116.     )
     
117.   
     
118.   (if *error*_Old (setq *error* *error*_Old))
     
119.   (princ)
     
120.   )
     
121. 
     
122. ;;;-----------------------------------------------
     
123. ;;; No.23-4-1 获取 LWPOLYLINE 对象所有顶点坐标   
     
124. ;;;-----------------------------------------------
     
125. (defun ayGetLWPolyLineVTX1 (EntName1 / Obj1 vtx vtxlst PtsList i)
     
126.   (vl-load-com)
     
127.   (setq Obj1 (vlax-ename->vla-object EntName1))
     
128.   (setq vtx (vla-get-Coordinates Obj1))
     
129.   (setq vtxLst (vlax-safearray->list (vlax-variant-value vtx)))
     
130.   (setq i 0)
     
131.   (setq PtsList nil)
     
132.   (repeat (/ (length vtxLst) 2)
     
133.     (setq PtsList (append PtsList (list (list (nth i vtxLst) (nth (1+ i) vtxLst)))))
     
134.     (setq i (+ i 2))
     
135.   );end_repeat
     
136.   (setq PtsList PtsList)
     
137. );end_defun
     
138. 
     
139. (defun *error*_New (msg)
     
140.   (vl-load-com)
     
141.   (if *error*_Old (setq *error* *error*_Old))
     
142.   (if (wcmatch (strcase msg t) "*break,*cancel*,*exit*,*取消*")
     
143.     (if  (= (getvar "LOCALE") "CHS")
     
144.       (princ "\n用户按了<Esc>强制退出")
     
145.       (princ "\nYou cancelled The operation!")
     
146.     )
     
147.     (princ (strcat "\n" msg))
     
148.   )
     
149.   (vla-EndUndoMark      ;结束标记
     
150.     (vla-get-ActiveDocument (vlax-get-acad-object))
     
151.   )  
     
152.   (princ)
     
153. )
     
154. (prompt "\n   圆\\椭圆<->矩形 互转,命令 e2r")
     
155. (princ)
     

;;;批量将圆生成正方形,椭圆生成矩形,矩形生成椭圆，正方形生成圆<br /> ;;;by edata@2013年11月20日<br /> ;;;命令 e2r<br /> (defun c:e2r(/ msg1 msg2 ss en e p0 longp0 shorts p02 ds ang1 ang2 ds2 pts<br />        pt ANG ANG11 DS1 DS3 DS4 P1 P11 P11X P2 P3 P4 P40 PT C PT PX1 PX2 PX3 PX4)<br />   (vl-load-com)<br />   (setq *error*_Old *error*)  ;保存出错处理函数<br />   (setq *error* *error*_New)<br />   (setq msg1 "\n选择圆,椭圆,矩形:")<br />   (setq msg2 "\n未选择对象")<br />   (princ msg1)<br />   (if (setq ss(ssget '((0 . "ELLIPSE,LWPOLYLINE,circle"))))<br />     (progn<br />       (vla-StartUndoMark(vla-get-ActiveDocument (vlax-get-acad-object)));结束标记<br />     (while (setq en(ssname ss 0))<br />       (setq e (entget en))<br />       (cond<br />   ((= (cdr(assoc 0 e)) "ELLIPSE" )<br />       (progn<br />       (setq p0 (cdr(assoc 10 e))<br />       longp0(cdr (assoc 11 e))<br />       shorts(cdr (assoc 40 e)))<br />       (setq p02(list (+ (car p0) (car longp0))(+ (cadr p0) (cadr longp0))(+ (caddr p0) (caddr longp0))))<br />       (setq ds(distance p0 p02)<br />       ang1 (angle p0 p02)<br />       ang2 (angle p02 p0)<br />       )<br />       (setq ds2(* ds shorts))<br />       (setq p1(polar p02 (- ang1 (* pi 0.5)) ds2)<br />       p4(polar p02 (+ ang1 (* pi 0.5)) ds2)<br />       p2(polar p1 ang2 (* ds 2.0))<br />       p3(polar p4 ang2 (* ds 2.0))<br />       )<br />       <br />       (setq pts (list p1 p2 p3 p4))<br />        (entmake (append    (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length pts))(cons 70 1))<br />       (mapcar '(lambda (pt)(cons 10 pt)) pts ))<br />   )<br />       ))<br />   ((= (cdr(assoc 0 e)) "CIRCLE" )<br />       (progn<br />       (setq p0 (cdr(assoc 10 e))      <br />       c(cdr (assoc 40 e)))      <br />       (setq px1(polar p0 (* pi 0.0) c)<br />       px2(polar p0 (* pi 0.5) c)<br />       px3(polar p0 (* pi 1.0) c)<br />       px4(polar p0 (* pi 1.5) c)<br />       )<br />       (setq p1(polar px1 (* pi 0.5) c)<br />       p2(polar px2 (* pi 1) c)<br />       p3(polar px3 (* pi 1.5) c)<br />       p4(polar px4 (* pi 2) c)<br />       )      <br />       (setq pts (list p1 p2 p3 p4))<br />        (entmake (append    (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length pts))(cons 70 1))<br />       (mapcar '(lambda (pt)(cons 10 pt)) pts ))<br />   )<br />       ))<br />      ( (= (cdr(assoc 0 e)) "LWPOLYLINE" )<br />       (progn<br />         (setq pts (ayGetLWPolyLineVTX1 en))<br />         (setq p1 (car pts) p2 (cadr pts) p3 (caddr pts) p4 (cadddr pts))<br />         (setq ds1(distance p1 p2)<br />         ds2 (distance p2 p3)<br />         ds3 (distance p3 p4)<br />         ds4 (distance p4 p1))<br />         (setq ang1(angle p2 p1)<br />         ang2(angle p2 p3)<br />         ang11(angle p1 p2))        <br />         (if (and(and (= (rtos ds1 2 4) (rtos ds3 2 4) )(= (rtos ds2 2 4) (rtos ds4 2 4)))(member (angtos (- ang2 ang1) 1 2) (list "90d0'" "270d0'")))<br />         (progn<br />     (setq p0(inters p1 p3 p2 p4 nil))<br />     (setq p0(list (car p0 )(cadr p0) 0))<br />     (if (> ds1 ds2)<br />       (progn<br />         (setq ang ang11)<br />       (setq ds (* ds1 0.5))<br />         (setq p40(/ ds2 ds1))<br />       )<br />       (progn<br />         (setq ang ang2)<br />       (setq ds (* ds2 0.5))<br />         (setq p40(/ ds1 ds2))<br />       ))<br />     (setq p11x(polar p0 ang  ds))<br />     (setq p11x(list (car p11x )(cadr p11x) 0))<br />     (setq p11(list (- (car p11x)(car p0))(- (cadr p11x)(cadr p0))(- (caddr p11x)(caddr p0))))<br />     (if(/= p40 1.0)<br />     (progn      <br />        (entmake (list<br />             '(0 . "ELLIPSE")<br />             '(100 . "AcDbEntity")<br />             '(100 . "AcDbEllipse")<br />             (cons 10 p0)<br />             (cons 11 p11)<br />             (cons 40 p40)<br />             (cons 42 (* pi 2.0))<br />             ))<br />       )<br />       (progn<br />         (entmake(list(cons 0 "circle")(cons 10 p0)(cons 40 ds)))<br />         )            <br />       );end entmake<br />     )<br />     (princ"\n无效矩形")<br />     )<br />         );end progn2<br />       );end cond part2<br />       );end cond<br />       (setq ss (ssdel en ss))<br />       )<br />       (vla-EndUndoMark(vla-get-ActiveDocument (vlax-get-acad-object)));结束标记<br />       )<br />     (princ msg2)<br />     )<br />   <br />   (if *error*_Old (setq *error* *error*_Old))<br />   (princ)<br />   )<br /> <br /> ;;;-----------------------------------------------<br /> ;;; No.23-4-1 获取 LWPOLYLINE 对象所有顶点坐标    <br /> ;;;-----------------------------------------------<br /> (defun ayGetLWPolyLineVTX1 (EntName1 / Obj1 vtx vtxlst PtsList i)<br />   (vl-load-com)<br />   (setq Obj1 (vlax-ename->vla-object EntName1))<br />   (setq vtx (vla-get-Coordinates Obj1))<br />   (setq vtxLst (vlax-safearray->list (vlax-variant-value vtx)))<br />   (setq i 0)<br />   (setq PtsList nil)<br />   (repeat (/ (length vtxLst) 2)<br />     (setq PtsList (append PtsList (list (list (nth i vtxLst) (nth (1+ i) vtxLst)))))<br />     (setq i (+ i 2))<br />   );end_repeat<br />   (setq PtsList PtsList)<br /> );end_defun<br /> <br /> (defun *error*_New (msg)<br />   (vl-load-com)<br />   (if *error*_Old (setq *error* *error*_Old))<br />   (if (wcmatch (strcase msg t) "*break,*cancel*,*exit*,*取消*")<br />     (if  (= (getvar "LOCALE") "CHS")<br />       (princ "\n用户按了<Esc>强制退出")<br />       (princ "\nYou cancelled The operation!")<br />     )<br />     (princ (strcat "\n" msg))<br />   )<br />   (vla-EndUndoMark      ;结束标记<br />     (vla-get-ActiveDocument (vlax-get-acad-object))<br />   )  <br />   (princ)<br /> )<br /> (prompt "\n   圆\\椭圆<->矩形 互转,命令 e2r")<br /> (princ)<br />

vormittag

折腾啥啊。

tianyi1230

画图的时候在什么时候用这个功能？

ynhh

太历害了,真的强大
感谢你的分享

ymcui

程序很好，不过好像用处不大.中看

999999

顶一下，收藏起来，功能不错

baoyizhu

程序不错，当我们做网罩类型产品时，把圆孔批量改为方孔就很方便了

前生

网罩，孔做成块啊。

hzyhzjjzh

感谢你的分享

戏男

好像用不了呢？