明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 10863|回复: 33

[源码] 墙线绘制源码解析(支持UCS,偏心或居中布置,厚度设置,自动填充)

    [复制链接]
发表于 2014-5-5 20:37 | 显示全部楼层 |阅读模式
本帖最后由 林霄云 于 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
  1. (defun getwallpoint_a( / pt1 pt2 pt3 ptlist-w x )
  2. ;WALLLINE-P方式
  3. ;Designed by 林霄云 2014年2月25日
  4. (setvar "OSNAPZ" 1)
  5. (setq pt1 (getpoint "\nbasepoint:"))
  6. (princ pt1)
  7. (setq pt2 (getpoint pt1 "\nnextpoint:"))
  8. (princ pt2)
  9. (grdraw pt1 pt2 20 1)
  10. (setq pt3 (getpoint pt1 "\nnextpoint:"))

  11. (if pt3
  12. (progn (princ pt3)(grdraw pt1 pt3 20 1) (setq ptlist-w (mapcar '(lambda(x) (trans x 1 0)) (list pt3 pt1 pt2)))  );progn
  13. (setq ptlist-w (mapcar '(lambda(x) (trans x 1 0)) (list pt1 pt2)))
  14. );pt3 修正pt3不存在的时候
  15. )
生成墙线make_wall
  1. (defun make_wall(ptlist-w wid lr-flag / ss en en-a1 en-a2 wid-temp)
  2. ;约定lr-flag取值为-1,0.5,1
  3. (setq lr-flag (rem lr-flag 3))
  4. (setq lr-flag (nth lr-flag '( -1.0 0.5 1.0)))
  5. (setq wid-temp (* wid lr-flag))

  6. (setup "col"); 设置图层
  7. (setq en (make_pline  ptlist-w (getvar "clayer") nil))
  8. ;生成辅助线
  9. (setq en-a1 (en_offset_a en wid-temp t))
  10. (setq en-a2 (en_offset_a en-a1 (* wid (- (sign wid-temp))) nil))

  11. ;取en-a1 en-a2坐标点,形成新的pline。删除辅助线。
  12. (setq ptlist-w (append (get_pline_vertex en-a1) (reverse (get_pline_vertex en-a2))))
  13. (setq en (make_pline ptlist-w (getvar "clayer") t))

  14. (setq ss (ssadd))
  15. (setq ss (ssadd en ss))

  16. (entdel en-a1)
  17. (entdel en-a2)

  18. (autohatch_en en)
  19. (setq ss (ssadd (entlast) ss))
  20. )
调用主函数,实现动态
  1. (defun C:wl( /  ptlist-w  ss flag num-pt wid-temp wid-flag)
  2. ;WALLLINE-P方式
  3. ;Designed by 林霄云 2014年2月25日
  4. (setq ss (ssadd))
  5. (setq flag t)
  6. (setq num-pt 1)
  7. (setq wid-flag nil )

  8. (setq ptlist-w (getwallpoint_a))

  9. (setq ss  (make_wall ptlist-w hnu:wallwid num-pt) )

  10.       ;捕捉左键,进行缩放测试
  11.       (prompt "\n左击循环方式调整墙位置 or U撤销 or 右击确认退出")
  12.       (while (and (setq ptr (grread t 15 2))
  13.                 flag
  14.                  )   
  15.                  ;(redraw)
  16.       (cond ((= (car ptr) 3);_Mouse Left button
  17.          (if ss
  18.          (progn (ss_delete ss)(setq num-pt (1+ num-pt)) (setq ss (make_wall ptlist-w hnu:wallwid num-pt))) ;切换标志,删除,生成
  19.          ) ;
  20.            ))
  21.        (cond ((= (car ptr) 2);键盘事件
  22.                   
  23.          (if (or (= (ascii "U") (cadr ptr)) (= (ascii "u") (cadr ptr))) (if ss (progn (ss_delete ss) (setq flag (not flag)))))
  24.          (if  (<= (ascii "0")(setq wid-temp (cadr ptr))(ascii "9"))
  25.           (if wid-flag  
  26.           (progn (setq wid-flag (+ (* 10 wid-flag )(- wid-temp (ascii "0"))))(princ (itoa (- wid-temp (ascii "0"))))) ;处理其他数字
  27.           (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")))))));处理第一个数字
  28.           )
  29.           ; (if wid-flag (princ (itoa wid-flag)));回显
  30.           );处理输入数字情况
  31.          (if (or (= 13 (cadr ptr)) (= 32 (cadr ptr)))
  32.           (if wid-flag
  33.           (progn (setq hnu:wallwid wid-flag)
  34.                (princ (strcat "\n当前墙厚为:" (itoa wid-flag)))
  35.                (if ss  (progn (ss_delete ss) (setq ss nil)))               
  36.                (setq ss (make_wall ptlist-w wid-flag num-pt))
  37.                (setq wid-flag nil)
  38.                )
  39.                (setq flag (not flag));退出循环
  40.            )
  41.            )   
  42.            ))
  43.            
  44.       (cond ((or (= (car ptr) 11) (= (car ptr) 25))
  45.       (if wid-flag
  46.           (progn ;(setq hnu:wallwid wid-flag)
  47.                (princ (strcat "\n当前墙厚为:" (itoa wid-flag)))
  48.                (if ss  (progn (ss_delete ss) (setq ss nil)))               
  49.                (setq ss (make_wall ptlist-w wid-flag num-pt))
  50.                (setq wid-flag nil)
  51.                )
  52.                (setq flag (not flag));退出循环
  53.            )
  54.            )  ;_Mouse Right button
  55.            );cond 右击事件      
  56.            );while
  57.       ;捕捉左键,进行缩放测试
  58. (princ)
  59. )
由于核心是放代码。故弱化解析。有兴趣的,可以留言沟通。代码详见附件。
测试效果也没时间做精细了。希望热心人做出gif回复上。

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

评分

参与人数 3明经币 +7 收起 理由
xyp1964 + 3 赞一个!
lyqiezi + 1 很给力!
Gu_xl + 3 很给力!

查看全部评分

"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2014-5-7 11:20 | 显示全部楼层
本帖最后由 xyp1964 于 2014-5-7 11:45 编辑

揭秘 setup函数
  1. (defun setup (la)
  2.   (if (= (tblsearch "layer" la) nil)
  3.     (Command "-layer" "m" la "")
  4.     (Command "-layer" "t" la "")
  5.   )
  6.   (setvar "clayer" la)
  7. )

点评

大赞!  发表于 2014-5-7 11:26
回复 支持 1 反对 0

使用道具 举报

发表于 2020-4-22 10:55 | 显示全部楼层
寻找了很久了,多谢大神分享,大赞。
发表于 2021-5-25 10:41 | 显示全部楼层
看上去很智能的插件。赞一个
发表于 2014-5-5 23:41 | 显示全部楼层
先下好,慢慢学习,转PKPM模型是直接用PKPM的程序吗?
发表于 2014-5-6 09:00 | 显示全部楼层
下载了所有附件还是缺少函数,no function definition: SETUP

点评

setup函数为图层设置函数,未提供,以后会单独介绍之。请注释掉那行。  发表于 2014-5-6 09:43
 楼主| 发表于 2014-5-6 09:48 | 显示全部楼层
tanle2020 发表于 2014-5-6 09:00
下载了所有附件还是缺少函数,no function definition: SETUP

对于setup函数出现的错误,可以注释之,或用(setvar "clayer" 图层名)替换之,前提是该图层存在。
同时,也敬请期待下篇文章对setup函数的解析。
发表于 2014-5-6 10:14 | 显示全部楼层
楼主牛得很厉害,赞。
院长不用多长时间就会过来踢馆了。

点评

值得踢说明相当不错  发表于 2014-5-6 13:11
发表于 2014-5-6 13:59 | 显示全部楼层
赞~~~~~~~~~~~
发表于 2014-5-7 07:57 | 显示全部楼层
支持,虽然不是结构专业
发表于 2014-5-7 09:11 | 显示全部楼层
G都给3分肯定差不了!

点评

G版一直很慷慨的。拙作还是敬请大家斧正才是!  发表于 2014-5-7 09:42
发表于 2014-5-7 09:51 | 显示全部楼层
用(setvar "clayer""墙")替换了图层名,仍画不出

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

点评

另外在,通用函数里,autohatch_en里,也有一句setup函数,同样注释掉。 (setup "COL_HATCH");设置当前图层。  发表于 2014-5-7 10:15
直接注释掉这一句。 (setup "col"); 设置图层 也敬请期待,setup函数解析一文  发表于 2014-5-7 10:12
发表于 2014-5-7 11:15 | 显示全部楼层
要是有个完整的傻瓜型的直接能用就好了
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-2-28 13:51 , Processed in 0.192378 second(s), 33 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表