拉筋符号源码解析与测试（详解算法，支持UCS、形式切换）

林霄云

拉筋符号（详解算法，支持UCS、形式切换、智能比例）
算法：
详见附图，拉筋为六点多段线。其顶点的计算按给定参数求得。
主函数 ReinforceBar：

2. (defun ReinforceBar(ptlist S-flag / pt1 pt2 pt3 pt1a pt2a pt3a pt10 a d h self-ang temp-dis  b s-flag-num)
   
3. ;函数ReinforceBar 生成拉筋，参数ptlist 点表，s-flag 拉筋形式控制开关。生成拉筋
   
4. ;Desiged by 林霄云 2014年2月10日

(defun ReinforceBar(ptlist S-flag / pt1 pt2 pt3 pt1a pt2a pt3a pt10 a d h self-ang temp-dis  b s-flag-num)<br /> ;函数ReinforceBar 生成拉筋，参数ptlist 点表，s-flag 拉筋形式控制开关。生成拉筋<br /> ;Desiged by 林霄云 2014年2月10日

其中ptlist点表根据点筋获得，常见点筋形式为块或者2点多段线。取得点筋点表函数get_bar_ptlist

2. (defun get_bar_ptlist( ss / pt_list pt en ent)
   
3. ;函数get_bar_ptlist，参数ss 选择集。返回值，点筋点表。
   
4. ;Desiged by 林霄云 2014年2月10日
   
5. ;(setq ss (ssget '((0 . "INSERT,LWPOLYLINE"))));由用户任意选择TEXT实体 用于测试
   
6. (setq pt_list nil)
   
7. (foreach en (SSTOENLIST ss)
   
8. (setq ent (entget en))
   
9. (setq typ (cdr (assoc 0 ent)))
   
10. (cond
    
11. ((= typ "INSERT") (setq pt (cdr (assoc 10 ent)))) ;块插入点，WCS
    
12. ((= typ "LWPOLYLINE") (setq pt (get_midpoint en)))
    
13. );cond
    
14. (if pt
    
15. (setq pt_list (cons pt pt_list))
    
16. )
    
17. );foreach
    
18. (reverse pt_list)
    
19. )

(defun get_bar_ptlist( ss / pt_list pt en ent)<br /> ;函数get_bar_ptlist，参数ss 选择集。返回值，点筋点表。<br /> ;Desiged by 林霄云 2014年2月10日<br /> ;(setq ss (ssget '((0 . "INSERT,LWPOLYLINE"))));由用户任意选择TEXT实体 用于测试<br /> (setq pt_list nil)<br /> (foreach en (SSTOENLIST ss)<br /> (setq ent (entget en))<br /> (setq typ (cdr (assoc 0 ent)))<br /> (cond <br /> ((= typ "INSERT") (setq pt (cdr (assoc 10 ent)))) ;块插入点，WCS<br /> ((= typ "LWPOLYLINE") (setq pt (get_midpoint en)))<br /> );cond<br /> (if pt<br /> (setq pt_list (cons pt pt_list))<br /> )<br /> );foreach<br /> (reverse pt_list)<br /> )

需强调的是，并不对块和多段线进行过多判断，其中子函数sstoenlist

2. (defun SSTOENLIST (SS / I EN LST_EN) ;改名 By 林霄云
   
3. ;函数SSTOENLIST，参数ss 选择集。返回值，选择集里的图元名列表。

(defun SSTOENLIST (SS / I EN LST_EN) ;改名 By 林霄云<br /> ;函数SSTOENLIST，参数ss 选择集。返回值，选择集里的图元名列表。

其中子函数get_midpoint，为求得多段线两顶点的中点。
主函数核心

2. (setq pt1 (car ptlist))
   
3. (setq pt10 (cadr ptlist))
   
4. 
   
5. 
   
6. (setq a (* pi 0.5)
   
7.     d 100
   
8.     h 75
   
9.     self-ang (angle pt1 pt10))
   
10. ;根据长度判断比例，按1：25与1：100考虑，350这个阈值是有待商榷的。但是一般来说，满足要求
    
11. (if (< (setq temp-dis (distance pt1 pt10)) 350)
    
12. (setq d 25
    
13.     h 20))
    
14.    
    
15. ;画S拉筋，给self-ang增加一个负角度b
    
16. (if S-flag
    
17. (progn
    
18. (setq b (atan (* 2 h) (sqrt (+ (* temp-dis temp-dis) (* 4 h h)))))
    
19. (setq self-ang (- self-ang b))
    
20. );progn
    
21. )
    
22.    
    
23. (setq pt1 (polar pt1 (- self-ang a) h))
    
24. (setq pt2 (polar pt1 self-ang d))
    
25. (setq pt3 (polar pt1 (+ self-ang a ) (* 2 h)))
    
26. 
    
27. (if S-flag
    
28. (progn
    
29. (setq pt3a (polar pt10 (- self-ang a) h))
    
30. (setq pt1a (polar pt3a (+ self-ang a ) (* 2 h)))
    
31. (setq pt2a (polar pt1a (+ self-ang pi) d))
    
32. 
    
33. );progn
    
34. (progn
    
35. (setq pt1a (polar pt10 (- self-ang a) h))
    
36. (setq pt2a (polar pt1a (+ self-ang pi) d))
    
37. (setq pt3a (polar pt1a (+ self-ang a ) (* 2 h)))
    
38. );progn
    
39. );if s-flag
    
40. 
    
41. (if S-flag
    
42. (setq s-flag-num 1)
    
43. (setq s-flag-num -1)
    
44. )
    
45. (setq ucszdir (trans '(0 0 1) 1 0 T ));生成OCS法向量
    
46. 
    
47. (setq ss (ssadd)) ;设置选择集
    
48. (ssadd (EntMakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(8 . "G_BAR（钢筋）") '(100 . "AcDbPolyline") '(90 . 6) '(43 . 0)
    
49. (cons 10 pt2) (cons 10 pt1)'(42 . -1) (cons 10 pt3) (cons 10 pt3a)(cons 42 s-flag-num)(cons 10 pt1a)(cons 10 pt2a) (cons 210 ucszdir))) ss)
    
50. ;多线
    
51. ss

(setq pt1 (car ptlist))<br /> (setq pt10 (cadr ptlist))<br /> <br /> <br /> (setq a (* pi 0.5)<br />     d 100<br />     h 75<br />     self-ang (angle pt1 pt10))<br /> ;根据长度判断比例，按1：25与1：100考虑，350这个阈值是有待商榷的。但是一般来说，满足要求<br /> (if (< (setq temp-dis (distance pt1 pt10)) 350) <br /> (setq d 25<br />     h 20))<br />     <br /> ;画S拉筋，给self-ang增加一个负角度b<br /> (if S-flag<br /> (progn<br /> (setq b (atan (* 2 h) (sqrt (+ (* temp-dis temp-dis) (* 4 h h)))))<br /> (setq self-ang (- self-ang b))<br /> );progn<br /> )<br />     <br /> (setq pt1 (polar pt1 (- self-ang a) h))<br /> (setq pt2 (polar pt1 self-ang d))<br /> (setq pt3 (polar pt1 (+ self-ang a ) (* 2 h)))<br /> <br /> (if S-flag <br /> (progn<br /> (setq pt3a (polar pt10 (- self-ang a) h))<br /> (setq pt1a (polar pt3a (+ self-ang a ) (* 2 h)))<br /> (setq pt2a (polar pt1a (+ self-ang pi) d))<br /> <br /> );progn<br /> (progn<br /> (setq pt1a (polar pt10 (- self-ang a) h))<br /> (setq pt2a (polar pt1a (+ self-ang pi) d))<br /> (setq pt3a (polar pt1a (+ self-ang a ) (* 2 h)))<br /> );progn<br /> );if s-flag<br /> <br /> (if S-flag<br /> (setq s-flag-num 1)<br /> (setq s-flag-num -1)<br /> )<br /> (setq ucszdir (trans '(0 0 1) 1 0 T ));生成OCS法向量<br /> <br /> (setq ss (ssadd)) ;设置选择集<br /> (ssadd (EntMakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(8 . "G_BAR（钢筋）") '(100 . "AcDbPolyline") '(90 . 6) '(43 . 0) <br /> (cons 10 pt2) (cons 10 pt1)'(42 . -1) (cons 10 pt3) (cons 10 pt3a)(cons 42 s-flag-num)(cons 10 pt1a)(cons 10 pt2a) (cons 210 ucszdir))) ss)<br /> ;多线<br /> ss

思路如下，根据拉筋形式，计算拉筋多段线顶点，生成多段线，返回选择集。（切换比例由特征长度350决定，可以深化研究）
其中图层做如下判断

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

(setq layername "G_BAR（钢筋）")<br /> (if (null (tblobjname "LAYER" layername) )<br /> (entmake (list '(0 . "LAYER")<br />         '(100 . "AcDbSymbolTableRecord")<br />         '(100 . "AcDbLayerTableRecord")<br />         '(70 . 0)<br />         '(6 . "Continuous")   ;线型<br />         (cons 2 layername)<br />     '(62 . 20)  ;颜色<br />     '(370 . 50)  ;线宽,整数,50表示0.50 9表示0.09<br />         )<br />     )<br /> );if

主函数调用如下

2. (defun C:RB()
   
3. ;函数ReinforceBar
   
4. ;Desiged by 林霄云 2014年2月10日
   
5. (prompt "\n选择点筋")
   
6. (setq ss-pt (ssget '((0 . "INSERT,LWPOLYLINE")))) ;选择点筋
   
7. (setq flag t)
   
8. (setq ss (ReinforceBar (get_bar_ptlist ss-pt) flag))
   
9. (prompt "\n左击切换拉筋形式")
   
10.       (while (and (setq ptr (grread t 15 2))
    
11.               (not (and (= 2 (car ptr)); 键盘事件
    
12.                     (or (= 13 (cadr ptr)) (= 32 (cadr ptr))) ;_Enter Space
    
13.             ))
    
14.              (not (or (= (car ptr) 11) (= (car ptr) 25)));_Mouse Right button
    
15.                           )   
    
16.                  ; (redraw)
    
17.       (cond ((= (car ptr) 3);_Mouse Left button
    
18.         (setq flag (not flag)) ;切换标志，删除，生成
    
19.         (ss-delete ss)
    
20.         (setq ss (ReinforceBar (get_bar_ptlist ss-pt) flag))
    
21.            ))
    
22. 
    
23. )
    
24. (princ)
    
25. )
    
26. (princ "\nRB  ReinforceBar 生成拉筋命令加载成功\nDesigned by 林霄云 2014年2月10日")
    
27. (princ)

(defun C:RB()<br /> ;函数ReinforceBar<br /> ;Desiged by 林霄云 2014年2月10日<br /> (prompt "\n选择点筋")<br /> (setq ss-pt (ssget '((0 . "INSERT,LWPOLYLINE")))) ;选择点筋<br /> (setq flag t)<br /> (setq ss (ReinforceBar (get_bar_ptlist ss-pt) flag))<br /> (prompt "\n左击切换拉筋形式")<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 flag (not flag)) ;切换标志，删除，生成<br />         (ss-delete ss)<br />         (setq ss (ReinforceBar (get_bar_ptlist ss-pt) flag))<br />            ))<br /> <br /> )<br /> (princ)<br /> )<br /> (princ "\nRB  ReinforceBar 生成拉筋命令加载成功\nDesigned by 林霄云 2014年2月10日")<br /> (princ)

结果：详附图
本代码对拉筋形式进行左键选择切换，仅是一种尝试，也许分别使用命令来得更简便。

qiushizhda

哈哈  第一个 支持下同行

richine001

强烈支持楼主，无私奉献

林霄云

有些人只会炫耀，有些人只会索取……

感谢老大、q2、g版、高飞鸟、路人等名人对我的成长提供的帮助。
同时感谢屠夫、小萝卜头、小菜、飞诗等侠的榜样作用。
最后感谢猫老师等大师的贡献精神对我的激励作用。

wangshang323

结构同行鼎力支持啊！

wudechao

同是结构同行,顶!

enn09

同是结构同行,顶!

skg123

虽然我不用画钢筋图，但是好东西必须顶起

水仙的错

必须支持下，感谢分享

JHX948954875

谢谢楼主分享