[原创]动态倒角,框选倒角

langjs

修改了一下，貌似没那个错误提示了，具体啥原因不明

;;; luyu9635 2009.11.12 langjs修改
;;; 动态框选圆角,保留图元框选的一侧
(defun c:fdt ( / gr loop p1)
  (vl-load-com)
  (setvar "filletrad" 0)
  (setvar "cmdecho" 0)
  (prompt "\n请选择对象:")
  (setq loop t)
  (while loop
    (setq gr (grread t 4 2))
    (if (= (car gr) 3)(setq p1 (cadr gr) loop nil )))
  (if (ssget p1 p1)(command "fillet" (osnap p1 "near") (osnap (cadr (entsel)) "near"))(getfillet p1))
  (princ)
)
(defun getfillet (pt / a b gr loop lst p1 plst ptlst ss ssmid)
  (setq p1 pt)
  (setq loop t)
  (while loop
    (setq gr (grread t 15 0))
    (cond ((= (car gr) 5)
        (setq plst (list p1 (list (car p1) (cadr (cadr gr))) (cadr gr) (list (car (cadr gr)) (cadr p1)) p1) ptlst plst)  (redraw)
        (repeat 4  (grdraw (car plst) (cadr plst) 2 1)  (setq plst (cdr plst)))
        (setq ssmid (mapcar  '(lambda (a b) (* (+ a b) 0.5)) p1 (cadr gr)))
        (if (setq ss (ssget "F" ptlst))
          (if (and(= (sslength ss) 2)(not (member (ssname ss 0) lst))(not (member (ssname ss 1) lst)))
            (progn  (setq lst (list (ssname ss 0) (ssname ss 1)))
              (command ".UNDO" "BE")
              (command "fillet" (vlax-curve-getclosestpointto (car lst) ssmid) (vlax-curve-getclosestpointto (cadr lst) ssmid))
              (command ".UNDO" "E")))
          (progn (if lst (command ".UNDO" ""))(setq lst nil))))
      ((member (car gr) '(3 11 25))
        (setq loop nil))))
  (redraw)
)

yoyoho

感谢 langjs 分享程序!

luyu9635

langjs 发表于 2014-7-3 11:47
修改了一下，貌似没那个错误提示了，具体啥原因不明

;;; luyu9635 2009.11.12 langjs修改

谢谢langjs大侠

恕放之生命

学习一下。

皇上快溜

要是能输入r值就好了

GNJLISP

能加重复使用吗？而不是倒一次后就停了

GNJLISP

langjs 发表于 2014-7-3 11:47
修改了一下，貌似没那个错误提示了，具体啥原因不明

;;; luyu9635 2009.11.12 langjs修改

这个可以加个重复使用吗？而不是倒一次就退也命令，帮忙改改，谢谢

安若浅溪

要是能加入R角跟C角就完美了

mnmnvmm2

谢谢楼主的分享！感激

fsafaffa

非常好的东西