拉筋箍筋符号源码解析与测试（支持UCS、形式切换、智能比例、统一命令）
本帖最后由 林霄云 于 2014-2-19 15:37 编辑拉筋箍筋（支持UCS、形式切换、智能比例、统一命令）
原版本详见，拉筋符号源码解析与测试（详解算法，支持UCS、形式切换）
http://bbs.mjtd.com/forum.php?mo ... 170&fromuid=7303580
主函数调用
主要修改，增加点筋点数判断，当大于2时，采用箍筋命令(if ( >total_pt 2)
(progn
(setq num-pt 0)
(setq ss (ReinforceBar_G pt_list num-pt))
(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 num-pt (1+ num-pt)) ;切换标志，删除，生成
(ss_delete ss)
(setq ss (ReinforceBar_G pt_list num-pt))
))
)
);progn
);if其中子函数ReinforceBar_G，为绘制箍筋。(defun ReinforceBar_G(ptlistnum-pt / in-anglist ss pt_list h d en self-ang pt0 pt1 pt2 pt1a pt2a)
;函数ReinforceBar 生成箍筋，参数ptlist 点表，flag-num 箍筋弯钩位置。生成箍筋
;Desiged by 林霄云 2014年2月12日本箍筋符号绘制的核心代码为，一，给定点表ptlist，形成封闭的多段线；二，求得多段线各个内角，以便箍筋弯钩的插入。(defun con_ptlist (ptlist / x-list x y)
……
(defun con_anglist(ptlist / in-anglist total i x y )
……函数列表;;MAKE_LAYER
;;MAKE_STYLE
;;EN_OFFSET
;;SS2ENLIST
;;GET_PLINE_VERTEX
;;GET_MIDPOINT
;;GET_BAR_PTLIST
;;CON_PTLIST
;;MOD_I
;;CON_ANGLIST
;;MAKE_PLINE
;;MAKE_TEXT
;;SS_DELETE
;;REINFORCEBAR
;;REINFORCEBAR_G
;;C:RB 结果：详见附图
实现了拉筋箍筋的大一统，其满足结构专业应用需求。
异性箍筋的绘制；箍筋弯钩的正确性与可切换。拉筋的正确性与可切换。支持UCS。支持比例切换。
补充代码解析
con_ptlist函数，并非用凸包算法，但是取一种可被理解的一般使用可以接受的便捷方式。凸包算法。(defun con_ptlist (ptlist / x-list pt-first ang-list index-list out-list out-list1 i x y)
;函数con_ptlist，参数ptlist 点表。返回值，按逆时针排序好的，可生成pline的点表；但不保证是凸边形。
;Desiged by 林霄云 2014年2月12日
;取最右端点，当多个时，取右上端点，使用两次vl-sort就行。g版，在凸包算法中，定了复杂的lambda。
(setq x-list (vl-sort
(vl-sort ptlist '(lambda (x y) (< (cadr x) (cadr y)))) ; y坐标较小者在前面
'(lambda (x y) (< (car x) (car y))) ; x坐标较小者在前面
))
(setqpt-first (last x-list));最后一个，为x的较大者,且y的较大者。
;取角度list，然后进行极角排序，如果是凸包，极角相同时，得去掉距离近的点。此处并不处理。
(setq x-list (vl-remove pt-first x-list) ) ;去掉最后一个元素，因为其为起始点。
; (princ (vl-princ-to-string x-list))
(setq ang-list (mapcar '(lambda (x) (anglept-first x)) x-list));ang-list 与 x-list 有一一对应关系。(angle (setq pt1 (getpoint))(getpoint pt1))
; (princ (vl-princ-to-string ang-list))
(setq index-list (vl-sort-i ang-list '< ));最好不要有三点共线
; (princ (vl-princ-to-string index-list))
;生成点表
(setq i 0)
(setq out-list nil)
(repeat (setq total (length x-list))
(setq out-list (cons (nth (nth i index-list ) x-list) out-list))
(setq i (1+ i))
);repeat
;(princ (vl-princ-to-string (reverse out-list)))
;对于结束边要逆序。处理共线问题。
(setq i 1)
(setq ang-last (angle pt-first (car out-list)))
(while (= ang-last (angle pt-first (nth i out-list)))
(setq i (1+ i))
);while
;退出循环，i 保存了结束边点数（除了pt-first）。大于1时，需手工逆序；否则用reverse逆序。
(if (> i 1)
(progn
(setq out-list1 nil)
(setq ii 1)
(repeat total
(if (<= ii i)
(setq out-list1 (cons (nth (- i ii) out-list) out-list1))
(setq out-list1 (cons (nth(- ii 1 ) out-list) out-list1))
);if
(setq ii (1+ ii))
)
(cons pt-first out-list1); 人工逆序。
);progn
(cons pt-first (reverse out-list));
);if
);defun为了定位箍筋弯钩直段，内角平分线作为基准线。对于内角列表，巧妙的使用rem函数，去掉正负性。欢迎指点。(defun con_anglist(ptlist / in-anglist total i x y )
;函数con_anglist，参数ptlist 点表。返回值，点表形成的多边形内角。
;Desiged by 林霄云 2014年2月12日
(setq i 0)
(setq in-anglist '())
(setq total (length ptlist))
(repeat total
(setq in-anglist (cons (rem (+ (setq test1 (angle (nth i ptlist) (nth (mod_i (1- i) total) ptlist)))
(-(setq test2 (angle (nth i ptlist) (nth (mod_i (1+ i) total) ptlist))))
(* 2 pi))
(* 2 pi))
in-anglist))
(setq i (1+ i))
)
(reverse in-anglist)
)由于需要循环性，所以定义了mod_i函数，对角标值进行修正(defun mod_i (i num)
;函数mod_i，返回值，对i进行调整，使其形成在0 num-1内循环。要求-num-1 <i< 2*num
;Desiged by 林霄云 2014年2月12日
(if (< i 0) (setq i (+ i num) ) (if (>= i num) (setq i (- i num)) i ))
)定义了一个简单的多段线偏移en_offset(defun en_offset(en d d-flag / en-obj)
(setq en-obj (vlax-ename->vla-object en))
(vla-offset en-obj d)
(if d-flag (entdel en));d-flag ：delete source flag
)定义了一个简单的多段线生成函数make_pline，设置了测试代码。(defun make_pline(ptlist layername c-flag / ucszdirtemp-list i in-anglist)
;函数make_pline，参数ptlist 点表，layername 图层名，c-flag闭合标识 t为闭合。返回值，点表形成的多边形。为简单的pline，不支持圆弧。
;Desiged by 林霄云 2014年2月12日
(if c-flag (setq c-flag 1) (setq c-flag 0))
(setq ucszdir (trans '(0 0 1) 1 0 T ));生成OCS法向量
(setq temp-list(mapcar '(lambda(x)(cons 10 x)) ptlist ) )
(setq temp-list (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")
(cons 210 ucszdir)(cons 8 layername)(cons 90 (length ptlist)) (cons 70 c-flag)(cons 43 0))
temp-list ) )
;多线
(EntMakex temp-list) ;返回ename
);defun 定义了简单的图层生成函数make_layer(defun make_layer(layername code-6 code-62 code-370)
(if (null (tblobjname "LAYER" layername) )
(entmake (list '(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(70 . 0)
(cons 2 layername)
(cons 6 code-6) ;线型Continuous
(cons 62 code-62);颜色
(cons 370 code-370);线宽,整数,50表示0.50 9表示0.09
)
)
);if
);defun等等， 好程序，再加上设置线宽更完美了，code-370我还不会 支持一下，为结构设计减少点工作量。
牛，可惜用不起 429014673 发表于 2014-2-13 09:18 static/image/common/back.gif
牛，可惜用不起
源代码还在整理，由于定义了多个子函数，为了其具有通用性，需要点时间调试。
回头这个，都免费。 支持一下，为结构设计减少点工作量。 异性箍筋的绘制，太实用了 不错，用心了 能不能修改下钢筋图层可以自定义，钢筋宽度可以自定义 这样的有木有？
zhl0123321 发表于 2014-2-13 11:38 static/image/common/back.gif
能不能修改下钢筋图层可以自定义，钢筋宽度可以自定义
可以考虑，提供一个接口函数，让用户设置，并保存。 xyp1964 发表于 2014-2-13 12:59 static/image/common/back.gif
这样的有木有？
可以分次实现。
在选择点筋后，生成的点筋点表，过滤掉，使内角大于或等于pi的点。
但是，得多次选择。