Question

autocad中vba二次开发给我随便一个简单示例可以吗

Answer 1

;曲线转换为相同长度的圆并随鼠标移动
(defun C:Tes ( / &dis1 &k1 &kw1 &ob1)
 (setvar "cmdecho" 0)
 (setvar "blipmode" 0)
 (if (null vlax-dump-object) (vl-load-com) )
 (princ "\n请选择曲线");曲线包括：直线，椭圆，圆，圆弧，多段线，样条曲线
 (if (setq &kw1 (ssget '((0 . "LINE,ELLIPSE,CIRCLE,ARC,LWPOLYLINE,SPLINE"))));1
  (progn;;1
   (setq &dis1 0);如果有选择了，就计算长度和
   (while (setq &k1 (ssname &kw1 0))
    (setq &kw1 (ssdel &k1 &kw1))
    (setq &ob1 (vlax-ename->vla-object &k1))
    (setq &dis1 (+ &dis1 (vlax-curve-getDistAtParam &ob1 (vlax-curve-getEndParam &ob1))))
   );while
   (if (> &dis1 0)(lsp201512231 &dis1) );长度和大于0就转换为圆
  );progn;1
 );if;1
 (prin1)
)

(defun lsp201512231 (&dis1 / #g1 #r1 %k1 &kw1 gr n1 pt pt1)
 (setq #r1 (/ &dis1 pi 2) %k1 t)
 (setq  gr (grread t 4 0) pt (cadr gr) pt1 pt);;取得鼠标操作及坐标
 (entmake (list '(0 . "CIRCLE") (cons 10 pt) (cons 40 #r1)));绘制圆
 (setq &kw1 (entlast) #g1 (entget &kw1))
 (while %k1
  (setq  gr (grread t 4 0) n1 (car gr) pt (cadr gr));;取得鼠标操作及坐标
  (if (and (= n1 5) (>= (distance pt1 pt) 15));1;如果鼠标移动的距离大于15，那么刷新圆
   (progn;;1
    (setq pt1 pt)
    (setq pt (cons 10 pt));变为表
    (setq #g1 (subst pt (assoc 10 #g1) #g1));替换
    (entmod #g1);刷新圆
   );progn;1
  );if;1
  (if (= n1 3) (setq %k1 nil) );点击左键结束
  (if (or (= n1 2) (= n1 25)) (progn (setq %k1 nil) (entdel &kw1) ));如果空格键或右键不绘制圆并结束动作
 );while
);复制到记事本，以【.lsp】为后缀命名。autoLISP加载后，命令为：TES

程序要有使用目的，这样编写程序由电脑完成工作。

Answer 2

网页链接