ninja37 发表于 2021-7-10 09:44:32

求帮助，点变圆程序修改一下。

求各位大师帮下忙帮助，点变圆程序修改一下。
应为我们厂里是做加工的 ，平时圆的大小都是说直径，半径很别扭。
下面的程序是输入半径    要求改成点变圆输入直径
;;;          起割点   点变圆   ;;;;;;;;;;
(defun c:2Y ( / &k1 &kw1 r1 ss1 ss2 x)
(vl-load-com)
(initget 6)
(if (not (setq r1 (getdist "\n请输入圆半径默认:<0.4>"))) (setq r1 0.4))
(princ "\n请选择点")
(if (setq &kw1 (ssget '((0 . "POINT"))))
(progn
   (setq ss1 '())
   (while (setq &k1 (ssname &kw1 0))
    (setq &kw1 (ssdel &k1 &kw1) ss1 (cons (vlax-ename->vla-object &k1) ss1))
   );while
   (setq ss2 (mapcar '(lambda (x) (vlax-get x 'Coordinates)) ss1))
   (mapcar '(lambda (x) (entmake (list '(0 . "CIRCLE") (cons 10 x) (cons 40 r1)))) ss2)
   (mapcar 'vla-delete ss1)
))(princ))

ww5w 发表于 2021-7-10 09:44:33

(defun c:2Y( / &k1 &kw1 r1 ss1 ss2 x)
(vl-load-com)
(initget 6)
(if (not (setq r1 (getdist "\n请输入圆直径默认:<0.4>"))) (setq r1 0.4))
(setq r1 (/ r1 2))
(princ "\n请选择点")
(if (setq &kw1 (ssget '((0 . "POINT"))))
(progn
   (setq ss1 '())
   (while (setq &k1 (ssname &kw1 0))
    (setq &kw1 (ssdel &k1 &kw1) ss1 (cons (vlax-ename->vla-object &k1) ss1))
   );while
   (setq ss2 (mapcar '(lambda (x) (vlax-get x 'Coordinates)) ss1))
   (mapcar '(lambda (x) (entmake (list '(0 . "CIRCLE") (cons 10 x) (cons 40 r1)))) ss2)
   (mapcar 'vla-delete ss1)
))(princ))

ninja37 发表于 2021-7-11 11:12:52

ww5w 发表于 2021-7-10 09:44
(defun c:2Y( / &k1 &kw1 r1 ss1 ss2 x)
(vl-load-com)
(initget 6)


谢谢 已经在使用中了，谢谢帮助

zmzk 发表于 2022-12-26 10:10:38

这个有点用啊！

戏男 发表于 2023-6-12 10:43:26

好像网孔可以用到这个程序
页: [1]
查看完整版本: 求帮助，点变圆程序修改一下。