@lisp敏捷开发方法论

vitalgg

原始链接： https://mp.weixin.qq.com/s?__biz ... 5e7b2c6318bf835c#rd

* 从一个小需求说起
直接需求：求两个图层的线的交点形成圆

操作过程描述：提示选择第一个图层，然后提示选择第二个图层，然后选择图纸范围，范围内的图层一和图层二的线的交点形成圆形
* 编程关键点
1 选择第一个图层，
2 选择第二个图层，
3 然后选择图纸范围，
4 计算交点
5 绘制圆形

** 关键步骤功能点
*** 取得图层名
我们有两个方法取得图层名，1 从图层列表中选择。2 从图元对象得到图层名。

如果不知道怎么写代码，可以打开 CAD应用云 微信公众号。
输入要求查询有没有可用的函数。

*** 取得图纸范围
常用的是 ssget 的矩形和多边形选择。初始代码我们使用简单的矩形
#+begin_src lisp

1. (ssget "w" pt1 pt2)

(ssget "w" pt1 pt2)

#+end_src
或
#+begin_src lisp

1. (ssget "C" pt1 pt2)

(ssget "C" pt1 pt2)

#+end_src
*** 曲线交点
查询是否有可用的函数

*** 绘制圆形
由于命令创建圆和ActiveX方法创建圆的影响，不容易命中我们的@lisp函数要创建圆。输入 make-circle 也很容易搜到我们需要的函数。
* 组织代码
前面所有的技术问题都有解决的函数了。我们把这些函数组织到一起来完成需求

#+begin_src lisp

1.   ;; 取第一、二个图层名
   
2.   (setq layer1 (entity:get-layer (car (entsel))))
   
3.   (setq layer2 (entity:get-layer (car (entsel))))
   
4.   ;; 取图纸范围
   
5.   (setq pt1 (getpoint "取图纸范围的第一个点"))
   
6.   ;; 为了直观些，我们使用 getcorner 函数
   
7.   (setq pt1 (getcorner pt1 "取图纸范围的第二个点"))
   
8. 
   
9.   ;; 取图纸范围内的两个图层上的曲线
   
10. 
    
11.   (setq ents1
    
12.         (pickset:to-list
    
13.          (ssget "c" pt1 pt2  (list (cons 0 (@:get-config '@curve:types))(cons 8 layer1)))))
    
14.   (setq ents2
    
15.         (pickset:to-list
    
16.          (ssget "c" pt1 pt2  (list (cons 0 (@:get-config '@curve:types))(cons 8 layer2)))))
    
17. 
    
18.   ;; 需求中要求不需要同一图层的曲线
    
19.   (setq res nil)
    
20.   (foreach ent1 ents1
    
21.     (foreach ent2 ents2
    
22.       (setq res (append res
    
23.                     (curve:inters ent1 ent2 acextendnone)
    
24.       ))))
    
25.   ;; 去掉空值
    
26.   (setq res (vl-remove nil res))
    
27. 
    
28.   ;; 画圆,半径 50
    
29.   (entity:make-circle res 50)
    

  ;; 取第一、二个图层名<br />   (setq layer1 (entity:get-layer (car (entsel))))<br />   (setq layer2 (entity:get-layer (car (entsel))))<br />   ;; 取图纸范围<br />   (setq pt1 (getpoint "取图纸范围的第一个点"))<br />   ;; 为了直观些，我们使用 getcorner 函数<br />   (setq pt1 (getcorner pt1 "取图纸范围的第二个点"))<br /> <br />   ;; 取图纸范围内的两个图层上的曲线<br /> <br />   (setq ents1<br />         (pickset:to-list<br />          (ssget "c" pt1 pt2  (list (cons 0 (@:get-config '@curve:types))(cons 8 layer1)))))<br />   (setq ents2<br />         (pickset:to-list<br />          (ssget "c" pt1 pt2  (list (cons 0 (@:get-config '@curve:types))(cons 8 layer2)))))<br /> <br />   ;; 需求中要求不需要同一图层的曲线<br />   (setq res nil)<br />   (foreach ent1 ents1<br />     (foreach ent2 ents2<br />       (setq res (append res<br />                     (curve:inters ent1 ent2 acextendnone)<br />       ))))<br />   ;; 去掉空值<br />   (setq res (vl-remove nil res))<br /> <br />   ;; 画圆,半径 50<br />   (entity:make-circle res 50)<br />

#+end_src
至此，基本的需求就完成了。

* 封装与迭代优化
将上面的过程封装成函数,私有化变量

#+begin_src lisp

1.   (defun get-cross-from-2layer (/ layer1 layer2 pt1 pt2 ents1 ents2 res)
   
2.     ;; 取第一、二个图层名
   
3.     (setq layer1 (entity:get-layer (car (entsel))))
   
4.     (setq layer2 (entity:get-layer (car (entsel))))
   
5.     ;; 取图纸范围
   
6.     (setq pt1 (getpoint "取图纸范围的第一个点"))
   
7.     ;; 为了直观些，我们使用 getcorner 函数
   
8.     (setq pt2 (getcorner pt1 "取图纸范围的第二个点"))
   
9. 
   
10.     ;; 取图纸范围内的两个图层上的曲线
    
11. 
    
12.     (setq ents1
    
13.           (pickset:to-list
    
14.            (ssget "c" pt1 pt2  (list (cons 0 (@:get-config '@curve:types))(cons 8 layer1)))))
    
15.     (setq ents2
    
16.           (pickset:to-list
    
17.            (ssget "c" pt1 pt2  (list (cons 0 (@:get-config '@curve:types))(cons 8 layer2)))))
    
18. 
    
19.     ;; 需求中要求不需要同一图层的曲线
    
20.     (setq res nil)
    
21.     (foreach ent1 ents1
    
22.              (foreach ent2 ents2
    
23.                       (setq res (append res
    
24.                                         (curve:inters ent1 ent2 acextendnone)
    
25.                                         ))))
    
26.     ;; 去掉空值
    
27.     (setq res (vl-remove nil res))
    
28.     ;; 画圆,半径 50
    
29.     (entity:make-circle res 50)
    
30.     )
    

  (defun get-cross-from-2layer (/ layer1 layer2 pt1 pt2 ents1 ents2 res)<br />     ;; 取第一、二个图层名<br />     (setq layer1 (entity:get-layer (car (entsel))))<br />     (setq layer2 (entity:get-layer (car (entsel))))<br />     ;; 取图纸范围<br />     (setq pt1 (getpoint "取图纸范围的第一个点"))<br />     ;; 为了直观些，我们使用 getcorner 函数<br />     (setq pt2 (getcorner pt1 "取图纸范围的第二个点"))<br /> <br />     ;; 取图纸范围内的两个图层上的曲线<br /> <br />     (setq ents1<br />           (pickset:to-list<br />            (ssget "c" pt1 pt2  (list (cons 0 (@:get-config '@curve:types))(cons 8 layer1)))))<br />     (setq ents2<br />           (pickset:to-list<br />            (ssget "c" pt1 pt2  (list (cons 0 (@:get-config '@curve:types))(cons 8 layer2)))))<br /> <br />     ;; 需求中要求不需要同一图层的曲线<br />     (setq res nil)<br />     (foreach ent1 ents1<br />              (foreach ent2 ents2<br />                       (setq res (append res<br />                                         (curve:inters ent1 ent2 acextendnone)<br />                                         ))))<br />     ;; 去掉空值<br />     (setq res (vl-remove nil res))<br />     ;; 画圆,半径 50<br />     (entity:make-circle res 50)<br />     )<br />

#+end_src

对于只使用了一次的符号变量，我们可以直接用表达式将其代替掉。

#+begin_src lisp

1. (defun get-cross-from-2layer (/ layer1 layer2 pt1 pt2 ents1 ents2 res)
   
2.     ;; 取第一、二个图层名
   
3.     (setq layer1 (entity:get-layer (car (entsel))))
   
4.     (setq layer2 (entity:get-layer (car (entsel))))
   
5.     ;; 取图纸范围
   
6.     (setq pt1 (getpoint "取图纸范围的第一个点"))
   
7.     ;; 为了直观些，我们使用 getcorner 函数
   
8.     (setq pt2 (getcorner pt1 "取图纸范围的第二个点"))
   
9. 
   
10.     ;; 需求中要求不需要同一图层的曲线
    
11.     (setq res nil)
    
12.     (foreach ent1 (pickset:to-list
    
13.                    (ssget "c" pt1 pt2  (list (cons 0 (@:get-config '@curve:types))(cons 8 layer1))))
    
14.              (foreach ent2 (pickset:to-list
    
15.                             (ssget "c" pt1 pt2  (list (cons 0 (@:get-config '@curve:types))(cons 8 layer2))))
    
16.                       (setq res (append res
    
17.                                         (curve:inters ent1 ent2 acextendnone)
    
18.                                         ))))
    
19.     ;; 去掉空值
    
20.     (setq res (vl-remove nil res))
    
21.     ;; 画圆,半径 50
    
22.     (entity:make-circle res 50)
    
23.     )
    

(defun get-cross-from-2layer (/ layer1 layer2 pt1 pt2 ents1 ents2 res)<br />     ;; 取第一、二个图层名<br />     (setq layer1 (entity:get-layer (car (entsel))))<br />     (setq layer2 (entity:get-layer (car (entsel))))<br />     ;; 取图纸范围<br />     (setq pt1 (getpoint "取图纸范围的第一个点"))<br />     ;; 为了直观些，我们使用 getcorner 函数<br />     (setq pt2 (getcorner pt1 "取图纸范围的第二个点"))<br /> <br />     ;; 需求中要求不需要同一图层的曲线<br />     (setq res nil)<br />     (foreach ent1 (pickset:to-list<br />                    (ssget "c" pt1 pt2  (list (cons 0 (@:get-config '@curve:types))(cons 8 layer1))))<br />              (foreach ent2 (pickset:to-list<br />                             (ssget "c" pt1 pt2  (list (cons 0 (@:get-config '@curve:types))(cons 8 layer2))))<br />                       (setq res (append res<br />                                         (curve:inters ent1 ent2 acextendnone)<br />                                         ))))<br />     ;; 去掉空值<br />     (setq res (vl-remove nil res))<br />     ;; 画圆,半径 50<br />     (entity:make-circle res 50)<br />     )<br />

#+end_src

** 添加帮助说明，并加入到 @lisp 菜单系统

#+begin_src lisp

1. (@:add-menu "@试验室" "层间线交点" '(@lab:get-cross-from-2layer))
   
2.   (defun @lab:get-cross-from-2layer (/ layer1 layer2 pt1 pt2 ents1 ents2 res)
   
3.     (@:help '("求两个图层的线的交点形成圆"
   
4.               " 操作：选择第一个图层，然后提示选择第二个图层，然后选择图纸范围，范围内的图层一和图层二的线的交点形成圆形"))
   
5.     ;; 取第一、二个图层名
   
6.     (setq layer1 (entity:get-layer (car (entsel))))
   
7.     (setq layer2 (entity:get-layer (car (entsel))))
   
8.     ;; 取图纸范围
   
9.     (setq pt1 (getpoint "取图纸范围的第一个点"))
   
10.     ;; 为了直观些，我们使用 getcorner 函数
    
11.     (setq pt2 (getcorner pt1 "取图纸范围的第二个点"))
    
12. 
    
13.     ;; 需求中要求不需要同一图层的曲线
    
14.     (setq res nil)
    
15.     (foreach ent1 (pickset:to-list
    
16.                    (ssget "c" pt1 pt2  (list (cons 0 (@:get-config '@curve:types))(cons 8 layer1))))
    
17.              (foreach ent2 (pickset:to-list
    
18.                             (ssget "c" pt1 pt2  (list (cons 0 (@:get-config '@curve:types))(cons 8 layer2))))
    
19.                       (setq res (append res
    
20.                                         (curve:inters ent1 ent2 acextendnone)
    
21.                                         ))))
    
22.     ;; 去掉空值
    
23.     (setq res (vl-remove nil res))
    
24.     ;; 画圆,半径 50
    
25.     (entity:make-circle res 50)
    
26.     )
    

(@:add-menu "@试验室" "层间线交点" '(@lab:get-cross-from-2layer))<br />   (defun @lab:get-cross-from-2layer (/ layer1 layer2 pt1 pt2 ents1 ents2 res)<br />     (@:help '("求两个图层的线的交点形成圆"<br />               " 操作：选择第一个图层，然后提示选择第二个图层，然后选择图纸范围，范围内的图层一和图层二的线的交点形成圆形"))<br />     ;; 取第一、二个图层名<br />     (setq layer1 (entity:get-layer (car (entsel))))<br />     (setq layer2 (entity:get-layer (car (entsel))))<br />     ;; 取图纸范围<br />     (setq pt1 (getpoint "取图纸范围的第一个点"))<br />     ;; 为了直观些，我们使用 getcorner 函数<br />     (setq pt2 (getcorner pt1 "取图纸范围的第二个点"))<br /> <br />     ;; 需求中要求不需要同一图层的曲线<br />     (setq res nil)<br />     (foreach ent1 (pickset:to-list<br />                    (ssget "c" pt1 pt2  (list (cons 0 (@:get-config '@curve:types))(cons 8 layer1))))<br />              (foreach ent2 (pickset:to-list<br />                             (ssget "c" pt1 pt2  (list (cons 0 (@:get-config '@curve:types))(cons 8 layer2))))<br />                       (setq res (append res<br />                                         (curve:inters ent1 ent2 acextendnone)<br />                                         ))))<br />     ;; 去掉空值<br />     (setq res (vl-remove nil res))<br />     ;; 画圆,半径 50<br />     (entity:make-circle res 50)<br />     )<br />

#+end_src

* 发布
把上面的包括有菜单和功能函数的代码保存到一个单独的文件 get-cross-from-2layer.lsp ，并保存到 atlisp/packages/at-lab/ 目录下。

修改 @试验室 的包定义文件，加入 get-cross-from-2layer 到 定义的 :files 字段下。


增加版本号，使用 CAD下的 @lisp开发工具发布即可。






公众号文章：