墙线绘制源码解析（支持UCS，偏心或居中布置，厚度设置，自动填充）
本帖最后由 林霄云 于 2014-5-5 20:37 编辑墙线绘制源码解析（支持UCS，偏心或居中布置，厚度设置，自动填充）
自最后的源码撰写后，过去已很多时候了。
引线标注点筋与线筋源码解析（支持UCS）
http://bbs.mjtd.com/forum.php?mo ... 872&fromuid=7303580
我身为结构，在代码中得到不仅有乐趣，更见得缜密或灵巧的思维，扎实或稀松的水平。此文虽为建筑结构所用画墙线，却也值得玩味些许。
引子
结构建模，需要结构布置。结构布置一般以建筑图为底图，在其上绘制梁与墙柱。哪里设墙柱，哪里设梁是结构布置问题，也是从绘图软件cad导入结构计算软件如pkpm的前提。故一需要画墙柱，二需要画梁，本人作此代码，以求快速建模。
思路
剪力墙主要是L型，一字型，其次是T型，I型和其他异性。故以L型墙线绘制为例进行解析代码。
1，通过偏移使墙有厚度。故率先获取其基准线的端点点表（基准线可以是中线或者边线）
2，根据参数进行偏移获得墙线，并自动填充
3，动态修改墙厚或者修改偏心
核心代码
取点表，L型 getwallpoint_a(defun getwallpoint_a( / pt1 pt2 pt3 ptlist-w x )
;WALLLINE-P方式
;Designed by 林霄云 2014年2月25日
(setvar "OSNAPZ" 1)
(setq pt1 (getpoint "\nbasepoint:"))
(princ pt1)
(setq pt2 (getpoint pt1 "\nnextpoint:"))
(princ pt2)
(grdraw pt1 pt2 20 1)
(setq pt3 (getpoint pt1 "\nnextpoint:"))
(if pt3
(progn (princ pt3)(grdraw pt1 pt3 20 1) (setq ptlist-w (mapcar '(lambda(x) (trans x 1 0)) (list pt3 pt1 pt2))));progn
(setq ptlist-w (mapcar '(lambda(x) (trans x 1 0)) (list pt1 pt2)))
);pt3 修正pt3不存在的时候
)生成墙线make_wall(defun make_wall(ptlist-w wid lr-flag / ss en en-a1 en-a2 wid-temp)
;约定lr-flag取值为-1，0.5，1
(setq lr-flag (rem lr-flag 3))
(setq lr-flag (nth lr-flag '( -1.0 0.5 1.0)))
(setq wid-temp (* wid lr-flag))
(setup "col"); 设置图层
(setq en (make_plineptlist-w (getvar "clayer") nil))
;生成辅助线
(setq en-a1 (en_offset_a en wid-temp t))
(setq en-a2 (en_offset_a en-a1 (* wid (- (sign wid-temp))) nil))
;取en-a1 en-a2坐标点，形成新的pline。删除辅助线。
(setq ptlist-w (append (get_pline_vertex en-a1) (reverse (get_pline_vertex en-a2))))
(setq en (make_pline ptlist-w (getvar "clayer") t))
(setq ss (ssadd))
(setq ss (ssadd en ss))
(entdel en-a1)
(entdel en-a2)
(autohatch_en en)
(setq ss (ssadd (entlast) ss))
)调用主函数，实现动态(defun C:wl( /ptlist-wss flag num-pt wid-temp wid-flag)
;WALLLINE-P方式
;Designed by 林霄云 2014年2月25日
(setq ss (ssadd))
(setq flag t)
(setq num-pt 1)
(setq wid-flag nil )
(setq ptlist-w (getwallpoint_a))
(setq ss(make_wall ptlist-w hnu:wallwid num-pt) )
;捕捉左键，进行缩放测试
(prompt "\n左击循环方式调整墙位置 or U撤销 or 右击确认退出")
(while (and (setq ptr (grread t 15 2))
flag
)
;(redraw)
(cond ((= (car ptr) 3);_Mouse Left button
(if ss
(progn (ss_delete ss)(setq num-pt (1+ num-pt)) (setq ss (make_wall ptlist-w hnu:wallwid num-pt))) ;切换标志，删除，生成
) ;
))
(cond ((= (car ptr) 2);键盘事件
(if (or (= (ascii "U") (cadr ptr)) (= (ascii "u") (cadr ptr))) (if ss (progn (ss_delete ss) (setq flag (not flag)))))
(if(<= (ascii "0")(setq wid-temp (cadr ptr))(ascii "9"))
(if wid-flag
(progn (setq wid-flag (+ (* 10 wid-flag )(- wid-temp (ascii "0"))))(princ (itoa (- wid-temp (ascii "0"))))) ;处理其他数字
(if ( = (ascii "0") wid-temp ) (setq wid-flag nil)(progn (setq wid-flag (- wid-temp (ascii "0"))) (princ (strcat "\n临时新墙厚:" (itoa (- wid-temp (ascii "0")))))));处理第一个数字
)
; (if wid-flag (princ (itoa wid-flag)));回显
);处理输入数字情况
(if (or (= 13 (cadr ptr)) (= 32 (cadr ptr)))
(if wid-flag
(progn (setq hnu:wallwid wid-flag)
(princ (strcat "\n当前墙厚为:" (itoa wid-flag)))
(if ss(progn (ss_delete ss) (setq ss nil)))
(setq ss (make_wall ptlist-w wid-flag num-pt))
(setq wid-flag nil)
)
(setq flag (not flag));退出循环
)
)
))
(cond ((or (= (car ptr) 11) (= (car ptr) 25))
(if wid-flag
(progn ;(setq hnu:wallwid wid-flag)
(princ (strcat "\n当前墙厚为:" (itoa wid-flag)))
(if ss(progn (ss_delete ss) (setq ss nil)))
(setq ss (make_wall ptlist-w wid-flag num-pt))
(setq wid-flag nil)
)
(setq flag (not flag));退出循环
)
);_Mouse Right button
);cond 右击事件
);while
;捕捉左键，进行缩放测试
(princ)
)由于核心是放代码。故弱化解析。有兴趣的，可以留言沟通。代码详见附件。
测试效果也没时间做精细了。希望热心人做出gif回复上。
本帖最后由 xyp1964 于 2014-5-7 11:45 编辑
揭秘 setup函数(defun setup (la)
(if (= (tblsearch "layer" la) nil)
(Command "-layer" "m" la "")
(Command "-layer" "t" la "")
)
(setvar "clayer" la)
) 寻找了很久了，多谢大神分享，大赞。 看上去很智能的插件。赞一个 先下好，慢慢学习，转PKPM模型是直接用PKPM的程序吗？ 下载了所有附件还是缺少函数，no function definition: SETUP tanle2020 发表于 2014-5-6 09:00 static/image/common/back.gif
下载了所有附件还是缺少函数，no function definition: SETUP
对于setup函数出现的错误，可以注释之，或用（setvar "clayer" 图层名）替换之，前提是该图层存在。
同时，也敬请期待下篇文章对setup函数的解析。
楼主牛得很厉害，赞。
院长不用多长时间就会过来踢馆了。 赞~~~~~~~~~~~ 支持，虽然不是结构专业 G都给3分肯定差不了！ 用（setvar "clayer""墙"）替换了图层名，仍画不出 要是有个完整的傻瓜型的直接能用就好了