修改一下批量倒角代码

qazxswk

以下代码是出自本论坛一位大神之手的。感觉还不错，就是在缩小屏幕时，批量倒角时，就容易出错。希望哪位大神再修改一下。谢谢。
原帖在http://bbs.mjtd.com/thread-181583-1-1.html

(defun c:tt()(setvar "osmode" 0)
(defun gx(p1 p2 p3)
  (if (equal (* (- (cadr p2)(cadr p1)) (- (car p3)(car p1))) (* (- (cadr p3)(cadr p1)) (- (car p2)(car p1))) 0.0001)
      t
          nil
   )
)
(setq linelst (ssget '((0 . "LINE,LWPOLYLINE"))))
(setq n (sslength linelst) pts nil i 0)
(setq pt (getpoint "请输入辅助点"))
(while (< i n)
       (setq pts (cons (vlax-curve-getClosestPointTo (vlax-ename->vla-object (ssname linelst i)) pt t) pts))
           (setq i (+ i 1))
)
(setq pe (car pts) lst1 nil lst2 nil)
(foreach ez pts            
            (if (gx pt pe ez)
                    (setq lst1 (cons ez lst1))
                    (setq lst2 (cons ez lst2))
                 )
)
(setq lst1 (vl-sort lst1 '(lambda (pa pb) (< (distance pt pa) (distance pt pb)))))
(setq lst2 (vl-sort lst2 '(lambda (px py) (< (distance pt px) (distance pt py)))))
(setq nmin (min (length lst1) (length lst2)) j 0)
(while (< j nmin)
       (command "FILLET" (nth j lst1)(nth j lst2))
       (setq j (+ j 1))   
)
)

9609759

在这行代码"(setq pe (car pts) lst1 nil lst2 nil)" 的上面加上这段代码再试试！！
(vl-load-com)
(setq obj_cad (vlax-get-acad-object))
(setq win_pt1 (apply 'mapcar (cons 'min pts)))
(setq win_pt2 (apply 'mapcar (cons 'max pts)))
;调整当前视口
(vla-ZoomWindow obj_cad (vlax-3D-point win_pt1) (vlax-3D-point  win_pt2))

qazxswk

9609759 发表于 2023-2-20 15:54
在这行代码"(setq pe (car pts) lst1 nil lst2 nil)" 的上面加上这段代码再试试！！
(vl-load-com)
(setq ...

办法可行，就是在进行倒角操作时，把操作区域的视图放大。在这个思路上，我在完成倒角操作后，加上一句(command "zoom" "p")，这样视图就回到原来的状态了。不错。缺点就是会感觉屏幕会闪一下，不过能接受