拉筋箍筋符号源码解析与测试（支持UCS、形式切换、智能比例、统一命令）

林霄云

拉筋箍筋（支持UCS、形式切换、智能比例、统一命令）
原版本详见，拉筋符号源码解析与测试（详解算法，支持UCS、形式切换）
http://bbs.mjtd.com/forum.php?mo ... 170&fromuid=7303580
主函数调用
主要修改，增加点筋点数判断，当大于2时，采用箍筋命令

2. (if ( >  total_pt 2)
   
3. (progn
   
4. (setq num-pt 0)
   
5. (setq ss (ReinforceBar_G pt_list num-pt))
   
6. 
   
7. (prompt "\n左击切换箍筋形式")
   
8. 
   
9.       (while (and (setq ptr (grread t 15 2))
   
10.               (not (and (= 2 (car ptr)); 键盘事件
    
11.                     (or (= 13 (cadr ptr)) (= 32 (cadr ptr))) ;_Enter Space
    
12.             ))
    
13.              (not (or (= (car ptr) 11) (= (car ptr) 25)));_Mouse Right button
    
14.                           )   
    
15.                  ; (redraw)
    
16.       (cond ((= (car ptr) 3);_Mouse Left button
    
17.         (setq num-pt (1+ num-pt)) ;切换标志，删除，生成
    
18.         (ss_delete ss)
    
19.         (setq ss (ReinforceBar_G pt_list num-pt))
    
20.            ))
    
21. 
    
22. )
    
23. 
    
24. );progn
    
25. );if

(if ( >  total_pt 2)<br /> (progn<br /> (setq num-pt 0)<br /> (setq ss (ReinforceBar_G pt_list num-pt))<br /> <br /> (prompt "\n左击切换箍筋形式")<br /> <br />       (while (and (setq ptr (grread t 15 2))<br />               (not (and (= 2 (car ptr)); 键盘事件<br />                     (or (= 13 (cadr ptr)) (= 32 (cadr ptr))) ;_Enter Space<br />             ))<br />              (not (or (= (car ptr) 11) (= (car ptr) 25)));_Mouse Right button <br />                           )   <br />                  ; (redraw)<br />       (cond ((= (car ptr) 3);_Mouse Left button <br />         (setq num-pt (1+ num-pt)) ;切换标志，删除，生成<br />         (ss_delete ss)<br />         (setq ss (ReinforceBar_G pt_list num-pt))<br />            ))<br /> <br /> )<br /> <br /> );progn<br /> );if

其中子函数ReinforceBar_G，为绘制箍筋。

2. (defun ReinforceBar_G(ptlist  num-pt / in-anglist ss pt_list h d en self-ang pt0 pt1 pt2 pt1a pt2a)
   
3. ;函数ReinforceBar 生成箍筋，参数ptlist 点表，flag-num 箍筋弯钩位置。生成箍筋
   
4. ;Desiged by 林霄云 2014年2月12日

(defun ReinforceBar_G(ptlist  num-pt / in-anglist ss pt_list h d en self-ang pt0 pt1 pt2 pt1a pt2a)<br /> ;函数ReinforceBar 生成箍筋，参数ptlist 点表，flag-num 箍筋弯钩位置。生成箍筋<br /> ;Desiged by 林霄云 2014年2月12日

本箍筋符号绘制的核心代码为，一，给定点表ptlist，形成封闭的多段线；二，求得多段线各个内角，以便箍筋弯钩的插入。

2. (defun con_ptlist (ptlist / x-list x y)
   
3. ……
   
4. (defun con_anglist(ptlist / in-anglist total i x y )
   
5. ……

(defun con_ptlist (ptlist / x-list x y)<br /> ……<br /> (defun con_anglist(ptlist / in-anglist total i x y )<br /> ……

函数列表

1. ;;MAKE_LAYER
   
2. ;;MAKE_STYLE
   
3. ;;EN_OFFSET
   
4. ;;SS2ENLIST
   
5. ;;GET_PLINE_VERTEX
   
6. ;;GET_MIDPOINT
   
7. ;;GET_BAR_PTLIST
   
8. ;;CON_PTLIST
   
9. ;;MOD_I
   
10. ;;CON_ANGLIST
    
11. ;;MAKE_PLINE
    
12. ;;MAKE_TEXT
    
13. ;;SS_DELETE
    
14. ;;REINFORCEBAR
    
15. ;;REINFORCEBAR_G
    
16. ;;C:RB

复制代码

结果：详见附图
实现了拉筋箍筋的大一统，其满足结构专业应用需求。
异性箍筋的绘制；箍筋弯钩的正确性与可切换。拉筋的正确性与可切换。支持UCS。支持比例切换。

补充代码解析
con_ptlist函数，并非用凸包算法，但是取一种可被理解的一般使用可以接受的便捷方式。凸包算法。

2. (defun con_ptlist (ptlist / x-list pt-first ang-list index-list out-list out-list1 i x y)
   
3. ;函数con_ptlist，参数ptlist 点表。返回值，按逆时针排序好的，可生成pline的点表；但不保证是凸边形。
   
4. ;Desiged by 林霄云 2014年2月12日
   
5. 
   
6. ;取最右端点，当多个时，取右上端点，使用两次vl-sort就行。g版，在凸包算法中，定了复杂的lambda。
   
7. (setq x-list (vl-sort
   
8.                    (vl-sort ptlist '(lambda (x y) (< (cadr x) (cadr y)))) ; y坐标较小者在前面
   
9.                    '(lambda (x y) (< (car x) (car y)))                ; x坐标较小者在前面
   
10.                  ))
    
11. (setq  pt-first (last x-list))  ;最后一个，为x的较大者,且y的较大者。   
    
12. 
    
13. ;取角度list，然后进行极角排序，如果是凸包，极角相同时，得去掉距离近的点。此处并不处理。
    
14.   (setq x-list (vl-remove pt-first x-list) ) ;去掉最后一个元素，因为其为起始点。
    
15. ; (princ (vl-princ-to-string x-list))
    
16.   (setq ang-list (mapcar '(lambda (x) (angle  pt-first x)) x-list));ang-list 与 x-list 有一一对应关系。(angle (setq pt1 (getpoint))(getpoint pt1))
    
17. ; (princ (vl-princ-to-string ang-list))
    
18.   (setq index-list (vl-sort-i ang-list '< ));最好不要有三点共线
    
19. ; (princ (vl-princ-to-string index-list))
    
20. ;生成点表
    
21.   (setq i 0)
    
22.   (setq out-list nil)
    
23.   (repeat (setq total (length x-list))
    
24.   (setq out-list (cons (nth (nth i index-list ) x-list) out-list))
    
25.   (setq i (1+ i))
    
26.   );repeat
    
27. ;  (princ (vl-princ-to-string (reverse out-list)))
    
28. 
    
29. ;对于结束边要逆序。处理共线问题。
    
30. (setq i 1)
    
31. (setq ang-last (angle pt-first (car out-list)))
    
32. (while (= ang-last (angle pt-first (nth i out-list)))
    
33. (setq i (1+ i))
    
34. );while
    
35. ;退出循环，i 保存了结束边点数（除了pt-first）。大于1时，需手工逆序；否则用reverse逆序。
    
36. (if (> i 1)
    
37. (progn
    
38. (setq out-list1 nil)
    
39. (setq ii 1)
    
40. (repeat total
    
41. (if (<= ii i)
    
42. (setq out-list1 (cons (nth (- i ii) out-list) out-list1))
    
43. (setq out-list1 (cons (nth  (- ii 1 ) out-list) out-list1))
    
44. );if
    
45. (setq ii (1+ ii))
    
46. )
    
47. 
    
48. (cons pt-first out-list1); 人工逆序。
    
49. );progn
    
50.   (cons pt-first (reverse out-list));
    
51.    );if
    
52.   );defun

(defun con_ptlist (ptlist / x-list pt-first ang-list index-list out-list out-list1 i x y)<br /> ;函数con_ptlist，参数ptlist 点表。返回值，按逆时针排序好的，可生成pline的点表；但不保证是凸边形。<br /> ;Desiged by 林霄云 2014年2月12日<br /> <br /> ;取最右端点，当多个时，取右上端点，使用两次vl-sort就行。g版，在凸包算法中，定了复杂的lambda。 <br /> (setq x-list (vl-sort<br />                    (vl-sort ptlist '(lambda (x y) (< (cadr x) (cadr y)))) ; y坐标较小者在前面<br />                    '(lambda (x y) (< (car x) (car y)))                ; x坐标较小者在前面<br />                  ))<br /> (setq  pt-first (last x-list))  ;最后一个，为x的较大者,且y的较大者。   <br /> <br /> ;取角度list，然后进行极角排序，如果是凸包，极角相同时，得去掉距离近的点。此处并不处理。<br />   (setq x-list (vl-remove pt-first x-list) ) ;去掉最后一个元素，因为其为起始点。<br /> ; (princ (vl-princ-to-string x-list))<br />   (setq ang-list (mapcar '(lambda (x) (angle  pt-first x)) x-list));ang-list 与 x-list 有一一对应关系。(angle (setq pt1 (getpoint))(getpoint pt1))<br /> ; (princ (vl-princ-to-string ang-list))<br />   (setq index-list (vl-sort-i ang-list '< ));最好不要有三点共线<br /> ; (princ (vl-princ-to-string index-list))<br /> ;生成点表 <br />   (setq i 0) <br />   (setq out-list nil)<br />   (repeat (setq total (length x-list))<br />   (setq out-list (cons (nth (nth i index-list ) x-list) out-list))<br />   (setq i (1+ i))<br />   );repeat<br /> ;  (princ (vl-princ-to-string (reverse out-list)))<br /> <br /> ;对于结束边要逆序。处理共线问题。<br /> (setq i 1)<br /> (setq ang-last (angle pt-first (car out-list)))<br /> (while (= ang-last (angle pt-first (nth i out-list)))<br /> (setq i (1+ i))<br /> );while<br /> ;退出循环，i 保存了结束边点数（除了pt-first）。大于1时，需手工逆序；否则用reverse逆序。<br /> (if (> i 1) <br /> (progn<br /> (setq out-list1 nil)<br /> (setq ii 1)<br /> (repeat total<br /> (if (<= ii i)<br /> (setq out-list1 (cons (nth (- i ii) out-list) out-list1))<br /> (setq out-list1 (cons (nth  (- ii 1 ) out-list) out-list1))<br /> );if<br /> (setq ii (1+ ii))<br /> )<br /> <br /> (cons pt-first out-list1); 人工逆序。<br /> );progn<br />   (cons pt-first (reverse out-list));<br />    );if<br />   );defun

为了定位箍筋弯钩直段，内角平分线作为基准线。对于内角列表，巧妙的使用rem函数，去掉正负性。欢迎指点。

2. (defun con_anglist(ptlist / in-anglist total i x y )
   
3. ;函数con_anglist，参数ptlist 点表。返回值，点表形成的多边形内角。
   
4. ;Desiged by 林霄云 2014年2月12日
   
5.     (setq i 0)
   
6.   (setq in-anglist '())  
   
7.   (setq total (length ptlist))
   
8.     (repeat total
   
9.   (setq in-anglist (cons (rem (+   (setq test1 (angle (nth i ptlist) (nth (mod_i (1- i) total) ptlist)))
   
10.                 (-  (setq test2 (angle (nth i ptlist) (nth (mod_i (1+ i) total) ptlist))))
    
11.                 (* 2 pi))
    
12.                 (* 2 pi))
    
13.               in-anglist))
    
14.        (setq i (1+ i))
    
15.     )
    
16.    
    
17.   (reverse in-anglist)
    
18.   )

(defun con_anglist(ptlist / in-anglist total i x y )<br /> ;函数con_anglist，参数ptlist 点表。返回值，点表形成的多边形内角。<br /> ;Desiged by 林霄云 2014年2月12日<br />     (setq i 0)<br />   (setq in-anglist '())  <br />   (setq total (length ptlist))<br />     (repeat total<br />   (setq in-anglist (cons (rem (+   (setq test1 (angle (nth i ptlist) (nth (mod_i (1- i) total) ptlist)))<br />                 (-  (setq test2 (angle (nth i ptlist) (nth (mod_i (1+ i) total) ptlist))))<br />                 (* 2 pi))<br />                 (* 2 pi))<br />               in-anglist))<br />        (setq i (1+ i))<br />     )<br />     <br />   (reverse in-anglist)<br />   )

由于需要循环性，所以定义了mod_i函数，对角标值进行修正

2.   (defun mod_i (i num)
   
3. ;函数mod_i，返回值，对i进行调整，使其形成在0 num-1内循环。要求  -num-1 <i< 2*num
   
4. ;Desiged by 林霄云 2014年2月12日
   
5.   (if (< i 0) (setq i (+ i num) ) (if (>= i num) (setq i (- i num)) i ))
   
6.   )

  (defun mod_i (i num)<br /> ;函数mod_i，返回值，对i进行调整，使其形成在0 num-1内循环。要求  -num-1 <i< 2*num <br /> ;Desiged by 林霄云 2014年2月12日 <br />   (if (< i 0) (setq i (+ i num) ) (if (>= i num) (setq i (- i num)) i ))<br />   )

定义了一个简单的多段线偏移en_offset

2. (defun en_offset(en d d-flag / en-obj)
   
3. (setq en-obj (vlax-ename->vla-object en))
   
4. (vla-offset en-obj d)
   
5. (if d-flag (entdel en));d-flag ：delete source flag
   
6. )

(defun en_offset(en d d-flag / en-obj)<br /> (setq en-obj (vlax-ename->vla-object en))<br /> (vla-offset en-obj d)<br /> (if d-flag (entdel en));d-flag ：delete source flag<br /> )

定义了一个简单的多段线生成函数make_pline，设置了测试代码。

2. (defun make_pline(ptlist layername c-flag / ucszdir  temp-list i in-anglist)
   
3. ;函数make_pline，参数ptlist 点表，layername 图层名，c-flag闭合标识 t为闭合。返回值，点表形成的多边形。为简单的pline，不支持圆弧。
   
4. ;Desiged by 林霄云 2014年2月12日
   
5. 
   
6. (if c-flag (setq c-flag 1) (setq c-flag 0))
   
7. (setq ucszdir (trans '(0 0 1) 1 0 T ));生成OCS法向量
   
8. 
   
9. (setq temp-list  (mapcar '(lambda(x)(cons 10 x)) ptlist ) )
   
10. 
    
11. (setq temp-list (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")
    
12.                 (cons 210 ucszdir)(cons 8 layername)  (cons 90 (length ptlist)) (cons 70 c-flag)(cons 43 0))
    
13.         temp-list ) )
    
14. ;多线
    
15. (EntMakex temp-list) ;返回ename
    
16. );defun

(defun make_pline(ptlist layername c-flag / ucszdir  temp-list i in-anglist)<br /> ;函数make_pline，参数ptlist 点表，layername 图层名，c-flag闭合标识 t为闭合。返回值，点表形成的多边形。为简单的pline，不支持圆弧。<br /> ;Desiged by 林霄云 2014年2月12日<br /> <br /> (if c-flag (setq c-flag 1) (setq c-flag 0))<br /> (setq ucszdir (trans '(0 0 1) 1 0 T ));生成OCS法向量<br /> <br /> (setq temp-list  (mapcar '(lambda(x)(cons 10 x)) ptlist ) )<br /> <br /> (setq temp-list (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")<br />                 (cons 210 ucszdir)(cons 8 layername)  (cons 90 (length ptlist)) (cons 70 c-flag)(cons 43 0)) <br />         temp-list ) )<br /> ;多线<br /> (EntMakex temp-list) ;返回ename<br /> );defun

定义了简单的图层生成函数make_layer

2. (defun make_layer(layername code-6 code-62 code-370)
   
3. (if (null (tblobjname "LAYER" layername) )
   
4. (entmake (list '(0 . "LAYER")
   
5.         '(100 . "AcDbSymbolTableRecord")
   
6.         '(100 . "AcDbLayerTableRecord")
   
7.         '(70 . 0)
   
8.     (cons 2 layername)
   
9.         (cons 6 code-6)   ;线型Continuous
   
10.        (cons 62 code-62)  ;颜色
    
11.     (cons 370 code-370)  ;线宽,整数,50表示0.50 9表示0.09
    
12.         )
    
13.     )
    
14. );if
    
15. );defun

(defun make_layer(layername code-6 code-62 code-370)<br /> (if (null (tblobjname "LAYER" layername) )<br /> (entmake (list '(0 . "LAYER")<br />         '(100 . "AcDbSymbolTableRecord")<br />         '(100 . "AcDbLayerTableRecord")<br />         '(70 . 0)<br />     (cons 2 layername)<br />         (cons 6 code-6)   ;线型Continuous<br />        (cons 62 code-62)  ;颜色<br />     (cons 370 code-370)  ;线宽,整数,50表示0.50 9表示0.09<br />         )<br />     )<br /> );if <br /> );defun

等等，

广易精通

好程序，再加上设置线宽更完美了，code-370我还不会

阿猪蛋

支持一下，为结构设计减少点工作量。

429014673

牛，可惜用不起

林霄云

429014673 发表于 2014-2-13 09:18
牛，可惜用不起

源代码还在整理，由于定义了多个子函数，为了其具有通用性，需要点时间调试。
回头这个，都免费。

yfs719

支持一下，为结构设计减少点工作量。

chleiwu

异性箍筋的绘制，太实用了

myjping

不错，用心了

zhl0123321

能不能修改下钢筋图层可以自定义，钢筋宽度可以自定义

xyp1964

这样的有木有？

林霄云

zhl0123321 发表于 2014-2-13 11:38
能不能修改下钢筋图层可以自定义，钢筋宽度可以自定义

可以考虑，提供一个接口函数，让用户设置，并保存。

林霄云

xyp1964 发表于 2014-2-13 12:59
这样的有木有？

可以分次实现。
在选择点筋后，生成的点筋点表，过滤掉，使内角大于或等于pi的点。
但是，得多次选择。