拉筋符号源码解析与测试（详解算法，支持UCS、形式切换）
拉筋符号（详解算法，支持UCS、形式切换、智能比例）算法：
详见附图，拉筋为六点多段线。其顶点的计算按给定参数求得。
主函数 ReinforceBar：(defun ReinforceBar(ptlist S-flag / pt1 pt2 pt3 pt1a pt2a pt3a pt10 a d h self-ang temp-disb s-flag-num)
;函数ReinforceBar 生成拉筋，参数ptlist 点表，s-flag 拉筋形式控制开关。生成拉筋
;Desiged by 林霄云 2014年2月10日其中ptlist点表根据点筋获得，常见点筋形式为块或者2点多段线。取得点筋点表函数get_bar_ptlist(defun get_bar_ptlist( ss / pt_list pt en ent)
;函数get_bar_ptlist，参数ss 选择集。返回值，点筋点表。
;Desiged by 林霄云 2014年2月10日
;(setq ss (ssget '((0 . "INSERT,LWPOLYLINE"))));由用户任意选择TEXT实体 用于测试
(setq pt_list nil)
(foreach en (SSTOENLIST ss)
(setq ent (entget en))
(setq typ (cdr (assoc 0 ent)))
(cond
((= typ "INSERT") (setq pt (cdr (assoc 10 ent)))) ;块插入点，WCS
((= typ "LWPOLYLINE") (setq pt (get_midpoint en)))
);cond
(if pt
(setq pt_list (cons pt pt_list))
)
);foreach
(reverse pt_list)
)需强调的是，并不对块和多段线进行过多判断，其中子函数sstoenlist(defun SSTOENLIST (SS / I EN LST_EN) ;改名 By 林霄云
;函数SSTOENLIST，参数ss 选择集。返回值，选择集里的图元名列表。其中子函数get_midpoint，为求得多段线两顶点的中点。
主函数核心(setq pt1 (car ptlist))
(setq pt10 (cadr ptlist))
(setq a (* pi 0.5)
d 100
h 75
self-ang (angle pt1 pt10))
;根据长度判断比例，按1：25与1：100考虑，350这个阈值是有待商榷的。但是一般来说，满足要求
(if (< (setq temp-dis (distance pt1 pt10)) 350)
(setq d 25
h 20))
;画S拉筋，给self-ang增加一个负角度b
(if S-flag
(progn
(setq b (atan (* 2 h) (sqrt (+ (* temp-dis temp-dis) (* 4 h h)))))
(setq self-ang (- self-ang b))
);progn
)
(setq pt1 (polar pt1 (- self-ang a) h))
(setq pt2 (polar pt1 self-ang d))
(setq pt3 (polar pt1 (+ self-ang a ) (* 2 h)))
(if S-flag
(progn
(setq pt3a (polar pt10 (- self-ang a) h))
(setq pt1a (polar pt3a (+ self-ang a ) (* 2 h)))
(setq pt2a (polar pt1a (+ self-ang pi) d))
);progn
(progn
(setq pt1a (polar pt10 (- self-ang a) h))
(setq pt2a (polar pt1a (+ self-ang pi) d))
(setq pt3a (polar pt1a (+ self-ang a ) (* 2 h)))
);progn
);if s-flag
(if S-flag
(setq s-flag-num 1)
(setq s-flag-num -1)
)
(setq ucszdir (trans '(0 0 1) 1 0 T ));生成OCS法向量
(setq ss (ssadd)) ;设置选择集
(ssadd (EntMakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(8 . "G_BAR（钢筋）") '(100 . "AcDbPolyline") '(90 . 6) '(43 . 0)
(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)
;多线
ss思路如下，根据拉筋形式，计算拉筋多段线顶点，生成多段线，返回选择集。（切换比例由特征长度350决定，可以深化研究）
其中图层做如下判断(setq layername "G_BAR（钢筋）")
(if (null (tblobjname "LAYER" layername) )
(entmake (list '(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(70 . 0)
'(6 . "Continuous") ;线型
(cons 2 layername)
'(62 . 20);颜色
'(370 . 50);线宽,整数,50表示0.50 9表示0.09
)
)
);if 主函数调用如下
(defun C:RB()
;函数ReinforceBar
;Desiged by 林霄云 2014年2月10日
(prompt "\n选择点筋")
(setq ss-pt (ssget '((0 . "INSERT,LWPOLYLINE")))) ;选择点筋
(setq flag t)
(setq ss (ReinforceBar (get_bar_ptlist ss-pt) flag))
(prompt "\n左击切换拉筋形式")
(while (and (setq ptr (grread t 15 2))
(not (and (= 2 (car ptr)); 键盘事件
(or (= 13 (cadr ptr)) (= 32 (cadr ptr))) ;_Enter Space
))
(not (or (= (car ptr) 11) (= (car ptr) 25)));_Mouse Right button
)
; (redraw)
(cond ((= (car ptr) 3);_Mouse Left button
(setq flag (not flag)) ;切换标志，删除，生成
(ss-delete ss)
(setq ss (ReinforceBar (get_bar_ptlist ss-pt) flag))
))
)
(princ)
)
(princ "\nRBReinforceBar 生成拉筋命令加载成功\nDesigned by 林霄云 2014年2月10日")
(princ)结果：详附图
本代码对拉筋形式进行左键选择切换，仅是一种尝试，也许分别使用命令来得更简便。
哈哈第一个 支持下同行 强烈支持楼主，无私奉献 本帖最后由 林霄云 于 2014-2-11 16:08 编辑
有些人只会炫耀，有些人只会索取……
感谢老大、q2、g版、高飞鸟、路人等名人对我的成长提供的帮助。
同时感谢屠夫、小萝卜头、小菜、飞诗等侠的榜样作用。
最后感谢猫老师等大师的贡献精神对我的激励作用。
结构同行鼎力支持啊！ 同是结构同行,顶! 同是结构同行,顶! 虽然我不用画钢筋图，但是好东西必须顶起 必须支持下，感谢分享 谢谢楼主分享
页:
[1]