批量将圆生成正方形,椭圆生成矩形,矩形生成椭圆，正方形生成圆
;;;批量将圆生成正方形,椭圆生成矩形,矩形生成椭圆，正方形生成圆;;;by edata@2013年11月20日
;;;命令 e2r
;;;批量将圆生成正方形,椭圆生成矩形,矩形生成椭圆，正方形生成圆
;;;by edata@2013年11月20日
;;;命令 e2r
(defun c:e2r(/ msg1 msg2 ss en e p0 longp0 shorts p02 ds ang1 ang2 ds2 pts
pt ANG ANG11 DS1 DS3 DS4 P1 P11 P11X P2 P3 P4 P40 PT C PT PX1 PX2 PX3 PX4)
(vl-load-com)
(setq *error*_Old *error*);保存出错处理函数
(setq *error* *error*_New)
(setq msg1 "\n选择圆,椭圆,矩形:")
(setq msg2 "\n未选择对象")
(princ msg1)
(if (setq ss(ssget '((0 . "ELLIPSE,LWPOLYLINE,circle"))))
(progn
(vla-StartUndoMark(vla-get-ActiveDocument (vlax-get-acad-object)));结束标记
(while (setq en(ssname ss 0))
(setq e (entget en))
(cond
((= (cdr(assoc 0 e)) "ELLIPSE" )
(progn
(setq p0 (cdr(assoc 10 e))
longp0(cdr (assoc 11 e))
shorts(cdr (assoc 40 e)))
(setq p02(list (+ (car p0) (car longp0))(+ (cadr p0) (cadr longp0))(+ (caddr p0) (caddr longp0))))
(setq ds(distance p0 p02)
ang1 (angle p0 p02)
ang2 (angle p02 p0)
)
(setq ds2(* ds shorts))
(setq p1(polar p02 (- ang1 (* pi 0.5)) ds2)
p4(polar p02 (+ ang1 (* pi 0.5)) ds2)
p2(polar p1 ang2 (* ds 2.0))
p3(polar p4 ang2 (* ds 2.0))
)
(setq pts (list p1 p2 p3 p4))
(entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length pts))(cons 70 1))
(mapcar '(lambda (pt)(cons 10 pt)) pts ))
)
))
((= (cdr(assoc 0 e)) "CIRCLE" )
(progn
(setq p0 (cdr(assoc 10 e))
c(cdr (assoc 40 e)))
(setq px1(polar p0 (* pi 0.0) c)
px2(polar p0 (* pi 0.5) c)
px3(polar p0 (* pi 1.0) c)
px4(polar p0 (* pi 1.5) c)
)
(setq p1(polar px1 (* pi 0.5) c)
p2(polar px2 (* pi 1) c)
p3(polar px3 (* pi 1.5) c)
p4(polar px4 (* pi 2) c)
)
(setq pts (list p1 p2 p3 p4))
(entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length pts))(cons 70 1))
(mapcar '(lambda (pt)(cons 10 pt)) pts ))
)
))
( (= (cdr(assoc 0 e)) "LWPOLYLINE" )
(progn
(setq pts (ayGetLWPolyLineVTX1 en))
(setq p1 (car pts) p2 (cadr pts) p3 (caddr pts) p4 (cadddr pts))
(setq ds1(distance p1 p2)
ds2 (distance p2 p3)
ds3 (distance p3 p4)
ds4 (distance p4 p1))
(setq ang1(angle p2 p1)
ang2(angle p2 p3)
ang11(angle p1 p2))
(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'")))
(progn
(setq p0(inters p1 p3 p2 p4 nil))
(setq p0(list (car p0 )(cadr p0) 0))
(if (> ds1 ds2)
(progn
(setq ang ang11)
(setq ds (* ds1 0.5))
(setq p40(/ ds2 ds1))
)
(progn
(setq ang ang2)
(setq ds (* ds2 0.5))
(setq p40(/ ds1 ds2))
))
(setq p11x(polar p0 angds))
(setq p11x(list (car p11x )(cadr p11x) 0))
(setq p11(list (- (car p11x)(car p0))(- (cadr p11x)(cadr p0))(- (caddr p11x)(caddr p0))))
(if(/= p40 1.0)
(progn
(entmake (list
'(0 . "ELLIPSE")
'(100 . "AcDbEntity")
'(100 . "AcDbEllipse")
(cons 10 p0)
(cons 11 p11)
(cons 40 p40)
(cons 42 (* pi 2.0))
))
)
(progn
(entmake(list(cons 0 "circle")(cons 10 p0)(cons 40 ds)))
)
);end entmake
)
(princ"\n无效矩形")
)
);end progn2
);end cond part2
);end cond
(setq ss (ssdel en ss))
)
(vla-EndUndoMark(vla-get-ActiveDocument (vlax-get-acad-object)));结束标记
)
(princ msg2)
)
(if *error*_Old (setq *error* *error*_Old))
(princ)
)
;;;-----------------------------------------------
;;; No.23-4-1 获取 LWPOLYLINE 对象所有顶点坐标
;;;-----------------------------------------------
(defun ayGetLWPolyLineVTX1 (EntName1 / Obj1 vtx vtxlst PtsList i)
(vl-load-com)
(setq Obj1 (vlax-ename->vla-object EntName1))
(setq vtx (vla-get-Coordinates Obj1))
(setq vtxLst (vlax-safearray->list (vlax-variant-value vtx)))
(setq i 0)
(setq PtsList nil)
(repeat (/ (length vtxLst) 2)
(setq PtsList (append PtsList (list (list (nth i vtxLst) (nth (1+ i) vtxLst)))))
(setq i (+ i 2))
);end_repeat
(setq PtsList PtsList)
);end_defun
(defun *error*_New (msg)
(vl-load-com)
(if *error*_Old (setq *error* *error*_Old))
(if (wcmatch (strcase msg t) "*break,*cancel*,*exit*,*取消*")
(if(= (getvar "LOCALE") "CHS")
(princ "\n用户按了<Esc>强制退出")
(princ "\nYou cancelled The operation!")
)
(princ (strcat "\n" msg))
)
(vla-EndUndoMark ;结束标记
(vla-get-ActiveDocument (vlax-get-acad-object))
)
(princ)
)
(prompt "\n 圆\\椭圆<->矩形 互转,命令 e2r")
(princ)
折腾啥啊。 画图的时候在什么时候用这个功能？ 太历害了,真的强大
感谢你的分享 程序很好，不过好像用处不大.中看 顶一下，收藏起来，功能不错 程序不错，当我们做网罩类型产品时，把圆孔批量改为方孔就很方便了 网罩，孔做成块啊。 感谢你的分享{:1_1:} 好像用不了呢？
页:
[1]