Question

有点复杂的autolisp编程问题

哪位大佬帮忙编写一个autolisp小程序：点选圆时自动捕捉圆心，并与下一个点选的圆的圆心自动连线，连接若干个圆心后，按下一个命令可在刚连圆心的所有直线中点画一条中点重合的10mm的垂直线，再按下一个命令后将所有垂直线向两边各偏移2mm，并删除原本的垂直线

Answer 1

(defun c:tes ( / ent1 pt1 pt2 ss1)
 (vl-load-com)
 (if (and (setq ent1 (entsel "\n请选择第一个圆"))
          (setq ent1 (vlax-ename->vla-object (car ent1)))
          (= (vla-get-ObjectName ent1) "AcDbCircle");判断是圆
          (setq pt1 (vlax-get ent1 'Center));取得圆心坐标
     )
  (progn;;1
   (setq ss1 '())
   (while (and (setq ent1 (entsel "\n请选择下一个圆"))
               (setq ent1 (vlax-ename->vla-object (car ent1)))
               (= (vla-get-ObjectName ent1) "AcDbCircle")
               (setq pt2 (vlax-get ent1 'Center));取得圆心坐标
               (> (distance pt1 pt2) 0.01);两个圆的间距大于0.01毫米
          )
    (entmake (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt2)))
    (setq ss1 (cons (entlast) ss1))
    (setq pt1 pt2)
   );while
   (if (car ss1);如果有绘制了直线
    (progn;;2
     (setq ss1 (mapcar 'vlax-ename->vla-object ss1))
     (setq ss1 (mapcar 'x1708161 ss1));绘制10长度垂直线
     (mapcar 'x1708162 ss1);偏移对象，并删除垂直线
    );progn;2
   );if;2
  );progn;1
 );if;1
 (princ)
)

;绘制垂直线
(defun x1708161 (obj / ang1 obj p1 p2)
 (setq p1 (vlax-curve-getPointAtParam obj (* 0.5 (vlax-curve-getEndParam obj)))
       ang1 (+ (vla-get-Angle obj) (* pi 0.5))
       p2 (polar p1 ang1 5)
       p1 (polar p1 ang1 -5)
 )
 (entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p2)))
 (vlax-ename->vla-object (entlast))
)

;偏移对象
(defun x1708162 (obj /obj)
 (vla-offset obj -2)
 (vla-offset obj 2)
 (vla-delete obj)
)

写了一个autolisp程序，加载后，输入命令【TES】（命令你可以自己修改）就可以做到你的要求。