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

 我来答
朱06CAD
推荐于2018-05-10 · 知道合伙人软件行家
朱06CAD
知道合伙人软件行家
采纳数:4172 获赞数:18067
高中,熟悉AutoCAD。会autolisp及VBA程序。

向TA提问 私信TA
展开全部
;曲线转换为相同长度的圆并随鼠标移动
(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

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

xyqf3340
2018-05-10 · TA获得超过155个赞
知道答主
回答量:324
采纳率:100%
帮助的人:73.6万
已赞过 已踩过<
你对这个回答的评价是?
评论 收起
收起 1条折叠回答
推荐律师服务: 若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询

为你推荐:

下载百度知道APP,抢鲜体验
使用百度知道APP,立即抢鲜体验。你的手机镜头里或许有别人想知道的答案。
扫描二维码下载
×

类别

我们会通过消息、邮箱等方式尽快将举报结果通知您。

说明

0/200

提交
取消

辅 助

模 式