求！！！批量修改倒角，R角

yang198910204

批量修改倒角如图
我希望自动能让倒角变大三分之一左右，最好支持多段线，

ljttjl

批量修改倒圆角或倒45度直角程序演示

byghbcx

(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)
  )

yang198910204

我想说的是就像"ljttjl"贴出来的那样的,他有那程序可惜不愿意给源码