[练习]一步一步写动态小程序

liminet

程序要实现动态画带有倒角的路

我正在写 里面纯用点计算

编写过程将一步一步贴出

每个函数都会不断修改

(defun c:q()
 (setq width 100)
 (vl-load-com)
 (setq pts nil)
 (setq model (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'ModelSpace))
 (setq pt1 (getpoint "请选择起点"))
 (setq pts (append pts (list pt1)))
 (while (setq pt (getpoint pt1 "请选择下一点"))
  (com "line" (list pt pt1))
  (setq pts (append pts (list (setq pt1 pt))))
 )
)

liminet

(defun com (name args)
 (cond
  ((= "line" name)
   (Vlax-Invoke-Method model 'AddLine (Vlax-3d-Point (car args)) (Vlax-3d-Point (cadr args)))
  )
 )
)

liminet

(defun c:q()
 (setq width 100)
 (vl-load-com)
 (setq pts nil)
 (setq model (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'ModelSpace))
 (setq pt1 (getpoint "请选择起点"))
 (setq pts (append pts (list pt1)))
 
 (setq qq t)
 (while (setq pt (getpoint pt1 "\n请选择下一点/U退回/空格确认"))
  (cond
   ((= pt "U")
    (setq pts (reverse (cdr (reverse pts))));删除一个点
    (entdel (entlast))
    (setq pt1 (last pts))
   )
   ((= pt "")
    (setq qq nil);退出
   )
   ((listp pt)
    (com "line" (list pt pt1))
    (setq pts (append pts (list (setq pt1 pt))))
   )
  )
  (initget "U  ");退回功能和空格确认退出
 )
 (if (> (length pts) 1)
  (draw pts);绘制
 )
)

liminet

呵呵 放心吧 我帮你发源码呢

liminet

不为名不为利

真正的回报明经

(defun c:q()
 (setq width 100)
 (vl-load-com)
 (setq pts nil)
 (setq model (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'ModelSpace))
 (setq pt1 (getpoint "请选择起点"))
 (setq pts (append pts (list pt1)))
 
 (setq qq t)
 (while (setq pt (getpoint pt1 "\n请选择下一点/U退回/空格确认"))
  (cond
   ((and (> (length pts) 1)(= pt "U"));防止过于退回错误
    (setq pts (reverse (cdr (reverse pts))));删除一个点
    (entdel (entlast))
    (setq pt1 (last pts))
   )
   ((= pt "U")
    (print "无法再退")
   )
   ((= pt "")
    (setq qq nil);退出
   )
   ((listp pt)
    (com "line" (list pt pt1))
    (setq pts (append pts (list (setq pt1 pt))))
   )
  )
  (initget "U  ");退回功能和空格确认退出
 )
 (if (> (length pts) 1)
  (draw pts);绘制
 )
)

liminet

现场写 现场调试

现场免费品尝

(defun c:q()
 (setq width 100);初始化路宽度为100
 (setq pi90 (* 0.5 pi) pi270 (* 1.5 pi));简化角度
 (vl-load-com)
 (setq pts nil)
 (setq model (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'ModelSpace))
 (setq pt1 (getpoint "请选择起点"))
 (if pt1
  (setq pts (append pts (list pt1)))
 )
 (setq qq t)
 (while (setq pt (getpoint pt1 "\n请选择下一点/U退回/空格确认"))
  (cond
   ((and (> (length pts) 1)(= pt "U"));防止过于退回错误
    (setq pts (reverse (cdr (reverse pts))));删除一个点
    (entdel (entlast))
    (setq pt1 (last pts))
   )
   ((= pt "U")
    (print "无法再退")
   )
   ((= pt "")
    (setq qq nil);退出
   )
   ((listp pt)
    (com "line" (list pt pt1))
    (setq pts (append pts (list (setq pt1 pt))))
   )
  )
  (initget "U  ");退回功能和空格确认退出
 )
 (if (> (length pts) 1)
  (draw pts);绘制
 )
)
(defun com (name args);全套简化所有绘图命令 代替command 省略捕捉问题
 (cond
  ((= "line" name);转为支持多个点连续画线
   (setq i 0)
   (repeat (/ (length args) 2)
    (setq pt1 (nth i args) pt2 (nth (1+ i) args))
    (Vlax-Invoke-Method model 'AddLine (Vlax-3d-Point pt1) (Vlax-3d-Point pt2))
    (setq i (+ i 2))
   )
  )
 )
)
(defun draw(pts);开始绘制
 (cond
  ((= (length pts) 2);仅仅是一条直线的情况
   (setq pt1 (car pts) pt2 (cadr pts))
   (setq ang (angle pt1 pt2))
   (setq pt_1a (polar pt1 (- ang pi90) (* 0.5 width)))
   (setq pt_1b (polar pt1 (+ ang pi90) (* 0.5 width)))
   (setq pt_2a (polar pt2 (- ang pi90) (* 0.5 width)))
   (setq pt_2b (polar pt2 (+ ang pi90) (* 0.5 width)))
   (com "line" (list pt_1a pt_2a pt_1b pt_2b))
  )
  ((> (length pts) 2)
   
  )
 )
)

liminet

(defun draw(pts);开始绘制
 (cond
  ((= (length pts) 2);仅仅是一条直线的情况
   (setq pt1 (car pts) pt2 (cadr pts))
   (setq ang (angle pt1 pt2))
   (setq pt_1a (polar pt1 (- ang pi90) (* 0.5 width)))
   (setq pt_1b (polar pt1 (+ ang pi90) (* 0.5 width)))
   (setq pt_2a (polar pt2 (- ang pi90) (* 0.5 width)))
   (setq pt_2b (polar pt2 (+ ang pi90) (* 0.5 width)))
   (com "line" (list pt_1a pt_2a pt_1b pt_2b))
  )
  ((> (length pts) 2);开始转弯的复杂情况
   (setq i 0)
   (repeat (- (length pts) 2)
    (setq pt1 (nth i pts) pt2 (nth (1+ i) pts) pt3 (nth (+ 2 i) pts))
    (setq RePts (3ptsBroke pt1 pt2 pt3))
    (setq i (1+ i))
   )
  )
 )
)
(defun 3ptsBroke(pt1 pt2 pt3);3个点转为转弯所有点(包括圆弧计算)
 (setq ang12 (angle pt1 pt2))
 (setq ang32 (angle pt3 pt2))
 
 (setq pt_1a (polar pt1 (- ang12 pi90) (* 0.5 width)))
 (setq pt_1b (polar pt1 (+ ang12 pi90) (* 0.5 width)))
 (setq pt_3a (polar pt3 (+ ang32 pi90) (* 0.5 width)))
 (setq pt_3b (polar pt3 (- ang32 pi90) (* 0.5 width)))
 
 (setq ang12 (angle pt1 pt2) ang32 (angle pt3 pt2))
 (setq ang21 (angle pt2 pt1) ang23 (angle pt2 pt3))
 
 (setq pt_1a_2a (polar pt_1a ang12 0.01))
 (setq pt_3a_2a (polar pt_3a ang32 0.01))
 (setq pt_1b_2b (polar pt_1b ang12 0.01))
 (setq pt_3b_2b (polar pt_3b ang32 0.01))
 
 (setq pt_2a (inters pt_1a pt_1a_2a pt_3a pt_3a_2a nil));拐点2点搞定
 (setq pt_2b (inters pt_1b pt_1b_2b pt_3b pt_3b_2b nil));拐点2点搞定
)