可以麻烦论坛的大神把这个倒角程序改为循环执行吗

rhww

在论坛找了几个倒角的程序
1、改造倒角FILLET命令， 支持框选   这个帖子的程序非常好用，唯一不足的就是，用一次后捕捉丢失，可以用防止布置丢失的lisp解决，但是没用一次系统变量“QAFLAGS”都会变μ“1”，导致双击编辑文字失效
2、又无聊了，发一个源代码 xxdf 智能动态框选倒角 v1.3   这个帖子的也不错，但是因为动态显示，有时候框选了没反映，具体原因不明

3、另外找了两个源码，找不到帖子了，我上传上来，这个两个源码都有一个问题就是都执行一次就退出了，我想要的效果是一直循环执行，直到人为退出，类似剪切命令一样，麻烦各位大神修改一下，感激不尽。

lifuq1979

没测试，试试
(defun c:fdttt ( / gr loop p1)
  (vl-load-com)
  (setvar "filletrad" 0)
  (setvar "cmdecho" 0)
(while t
  (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)
)

evayleung

CAD自带的倒角不行吗？也挺好用的啊

Linhay

命令: F
FILLET
当前设置: 模式 = 修剪，半径 = 0.0000
选择第一个对象或 [放弃(U)/多段线(P)/半径(R)/修剪(T)/多个(M)]: r
指定圆角半径 <0.0000>: 10
选择第一个对象或 [放弃(U)/多段线(P)/半径(R)/修剪(T)/多个(M)]: p
选择二维多段线或 [半径(R)]:

lifuq1979

循环while
(defun c:fdttt ( / gr loop p1)
  (vl-load-com)
  (setvar "filletrad" 0)
  (setvar "cmdecho" 0)
(while
  (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)
)

yoyoho

lifuq1979 发表于 2018-7-6 17:25
循环while
(defun c:fdttt ( / gr loop p1)
  (vl-load-com)

程序autocad2012测试没成功?

指令: fdttt

请选择对象:

后面没了,不能选取对象

bai2000

我和楼上一样的

yoyoho

lifuq1979 发表于 2018-7-8 21:02
没测试，试试
(defun c:fdttt ( / gr loop p1)
  (vl-load-com)

感谢分享程序,autocad2012测试o.k.

999999

谢谢楼主的贴子，谢谢评论区的大神出手，，

999999

lifuq1979 发表于 2018-7-8 21:02
没测试，试试
(defun c:fdttt ( / gr loop p1)
  (vl-load-com)

大神您好，您写的代码很好用，谢谢您的幸苦付出，您可否增加一个可以输入半径的选项（带记忆的）