求！！！批量修改倒角，R角
批量修改倒角如图我希望自动能让倒角变大三分之一左右，最好支持多段线，
批量修改倒圆角或倒45度直角程序演示
本帖最后由 byghbcx 于 2011-9-27 18:02 编辑
(defun c:f-ch( / p->pl ENT_FROM odl-var ent st et ent_type d s_st s_et wid pt bulge s1 s2 n s_ent pt par);改切角或倒角,支持圆弧倒角、多义钱倒角
(defun p->pl (ss w / en a)
(setq en (ssname ss 0))
(setq a (cdr (assoc 0 (entget en))))
(cond ((or (= "LINE" a) (= "ARC" a))
(command "pedit" en "Y" "j" ss "" "w" w "x"))
((or (= "LWPOLYLINE" a) (= "POLYLINE" a))
(command "pedit" en "j" ss "" "w" w "x"))
(T T)
)
)
(DEFUN ENT_FROM (E / SS SN)
(SETQ SS (SSADD))
(WHILE E
(SETQ E (ENTNEXT E))
(IF E
(PROGN
(SETQ SN (CDR (ASSOC 0 (ENTGET E))))
(IF (NOT (MEMBER SN (quote ("ATTRIB" "VERTEX" "SEQEND"))))
(SETQ SS (SSADD E SS))
)
)
)
)
SS
)
(vl-load-com)
(setq old-var (mapcar 'getvar '("chamfera" "chamferb" "filletrad")))
(setq d (getreal (strcat "\n请输入倒角距离<" (rtos (getvar "filletrad")) ">:")))
(if d (setvar "filletrad" d))
(while (setq ent (entsel "\n请选择倒角或切角线/<空选结束>:"))
(setq st (vlax-curve-getStartPoint (vlax-ename->vla-object (car ent)))
et (vlax-curve-getEndPoint (vlax-ename->vla-object (car ent)))
)
(setq ent_type (cdr (assoc 0 (entget (car ent)))))
(cond
((= ent_type "LINE")
(command "_.erase" ent "")
(setq ent (ssget "c" st st))
(if (wcmatch (cdr (assoc 0 (entget (ssname ent 0)))) "*POLYLINE") (command "_.explode" ent))
(setq ent (ssget "c" et et))
(if (wcmatch (cdr (assoc 0 (entget (ssname ent 0)))) "*POLYLINE") (command "_.explode" ent))
(command "_.fillet" st et)
(setq s (entlast))
(setq s_st (vlax-curve-getStartPoint (vlax-ename->vla-object s))
s_et (vlax-curve-getEndPoint (vlax-ename->vla-object s))
)
(command "_.line" s_st s_et "")
(command "_.erase" s "")
)
((= ent_type "ARC")
(command "_.erase" ent "")
(command "_.fillet" st et)
)
((wcmatch ent_type "*POLYLINE")
(setq wid (cdr (assoc 40 (entget (car ent)))))
(setq pt (vlax-curve-getClosestPointTo (car ent) (cadr ent)))
(setq par (vlax-curve-getParamAtPoint(car ent) pt))
(setq st (vlax-curve-getPointAtParam (car ent) (fix par))
et (vlax-curve-getPointAtParam (car ent) (1+ (fix par))))
(setq bulge (vla-getbulge (vlax-ename->vla-object (car ent)) (fix par)))
(setq ent0 (entlast))
(command "_.explode" (car ent))
(command "_.erase" (ssget "c" pt pt) "")
(command "_.fillet" st et)
(if (= bulge 0)
(progn
(setq s (entlast))
(setq s_st (vlax-curve-getStartPoint (vlax-ename->vla-object s))
s_et (vlax-curve-getEndPoint (vlax-ename->vla-object s))
)
(command "_.line" s_st s_et "")
(command "_.erase" s "")
)
)
(SETQ SSE (ENT_FROM ENT0))
(P->PL SSE Wid)
)
)
(mapcar 'setvar '("chamfera" "chamferb" "filletrad") old-var)
(princ)
)
我想说的是就像"ljttjl"贴出来的那样的,他有那程序可惜不愿意给源码
页:
[1]