明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 17383|回复: 62

[源码] 引线标注点筋与线筋源码解析(支持UCS)

    [复制链接]
发表于 2014-4-22 23:48 | 显示全部楼层 |阅读模式
本帖最后由 林霄云 于 2014-4-23 22:09 编辑

引线标注点筋与线筋源码解析(支持UCS)
我曾说,我会离开lisp。谁又知道我从软件工程转土木工程有多难,又知道我内心有燃烧过那热火。——记录与真实生活
闲话少说,看正文。
思路
将标注点筋和线筋(一个标根数一个是标间距)集成在一起。应该做如下几件事:
1,选择后的选择集,自动判断是标注点筋还是线筋。
如果有点筋,标注点筋,如果没有点筋,标注线筋。
2,引线自动生成。
对于点筋,取点筋中点,如果是块,该是插入点,作为引线一端。对于线筋,取选择框中点距对象最近的点。且各自成前处理函数,生成点表。
取点筋点表
  1. (defun get_bar_ptlist( ss / pt_list pt en ent ptli )
  2. ;函数get_bar_ptlist,参数ss 选择集。返回值,点筋点表。
  3. ;Desiged by 林霄云 2014年2月10日
取线筋点表
  1. (defun get_linebar_pt( ss / pt sslist )
  2. ;Designed by 林霄云 2014年4月20日
  3. ;取线筋接触点。多选时,仅支持取第一根
3,动态处理文字位置,且为当前UCS下,支持90度旋转
对文字及文字下划线,拖动模式,更新其坐标点。旋转时,亦更新相应坐标点。
4,支持平行引线
当点筋标注时,在左击确认时,增加剩余平行引线。
5,最后间距按全局比例设置。
如果按固定的1:100出图,文字与文字下划线设为100便可。但支持墙柱配筋大样和墙身配筋大样,必然得支持自动复合相应的比例间距。
主函数解析:
dimbar(ptlist dotflag),ptlist为引线端点点表,由前述两函数获得,dotflag为点筋与否标识。
函数内的flag为动态退出标志;ang为文字角度
  1. (defun dimbar (ptlist dotflag / len pt str qline qtext box box-len tline flag ptr ptu-u ang pto1 pto2 pto pt-x pt-y i )
  2. (setq flag t )
  3. (setq ang 0)

  4. ;务必支持全局比例hnu:dimscale
  5. (if (null hnu:dimscale)
  6. (setq hnu:dimscale 100)
  7. );if

  8. (setq len (length ptlist))
  9. (setq pt (car ptlist));只处理一根引线作为动态。
  10. (setup "symbol");这句为设置图层,setup为一函数,以后提供

  11. (if dotflag (setq str (strcat (itoa len) "%%13220")) (setq str "%%1328@200"));if 处理输入
  12. (if (null dotflag) (make_insert pt "_ARCHTICK" (* 1.5 hnu:dimscale) pi (getvar "clayer")));if 处理线筋符号
  13.   

  14. (setq qline (make_line (list pt (setq ptu (offset_point pt hnu:dimscale 0 0))) (getvar "clayer") ))  ;qline 斜引线,初始值,pt,与任意点
  15. (setq qtext (make_text_b ptu ang (* 3.0 hnu:dimscale) 1 str (getvar "clayer")))            ;qtext 文字,高度与全局比例相关,对齐方式,中
  16. (setq box (get_textbox qtext)
  17.      box-len (+  hnu:dimscale (* 0.5 (distance (car box) (cadr box)))))
  18.   
  19. (setq tline (make_line (list ptu (setq pte (offset_point ptu box-len 0 0)))(getvar "clayer")))       ;tline 文字下划线,初始值随意

  20. (prompt "\n确定文字位置,逆时针旋转R,顺时针旋转E,撤销U")

  21.       (while (and (setq ptr (grread t 15 2))
  22.               (not (and (= 2 (car ptr)); 键盘事件
  23.                     (or (= 13 (cadr ptr)) (= 32 (cadr ptr))) ;_Enter Space
  24.             ))
  25.              (not (or (= (car ptr) 11) (= (car ptr) 25)));_Mouse Right button
  26.            flag
  27.                           )   
  28.                  ; (redraw)
  29.       (cond ((= (car ptr) 3);_Mouse Left button
  30.           (setq ptu-u (cadr ptr))
  31.           (setq ptu-w (trans ptu-u 1 0))
  32.           (set-dxf qtext 11 ptu-w)
  33.           (set-dxf tline 10 (setq pto1 (offset_point ptu-w (- box-len) (- hnu:dimscale) ang)))
  34.           (set-dxf tline 11 (setq pto2 (offset_point ptu-w box-len (- hnu:dimscale) ang)))
  35.           (if (< (distance pt pto1) (distance pt pto2))(setq pto pto1)(setq pto pto2))
  36.           (set-dxf qline 11 pto)
  37.           ;点筋加入引线
  38.           (if (<= len 4);一般点筋少于等于4进行如此标注。
  39.           (progn
  40.           (setq i 0)
  41.           (repeat (1- len)
  42.           (setq i (1+ i))
  43.           (setq pt-x (nth i ptlist) )
  44.           (setq pt-y (inters pt-x (offset_point pt-x 100 0 (angle (get-dxf 10 qline)(get-dxf 11 qline))) pto1 pto2 nil))
  45.           (make_line (list pt-x pt-y) (getvar "clayer"))
  46.           (if (< (distance pto1 pt-y)(distance pto2 pt-y))
  47.           (if (< (distance pto1 pto2)(distance pto2 pt-y));确保在点在外面
  48.           (set-dxf tline 10 pt-y)
  49.           )
  50.           (if (< (distance pto1 pto2)(distance pto1 pt-y));确保在点在外面
  51.           (set-dxf tline 11 pt-y)
  52.           )
  53.           )
  54.           );repeat
  55.           ));if len
  56.           ;点筋加入引线
  57.           (setq flag nil)
  58.            ))
  59.       (cond ((= (car ptr) 5)
  60.           (setq ptu-u (cadr ptr))      ;很明显ptu-w为uCS下
  61.           (setq ptu-w (trans ptu-u 1 0))  ;很明显ptu-w为wCS下
  62.               
  63.           (set-dxf qtext 11 ptu-w)                           ;设置 qtext位置。
  64.           (set-dxf tline 10 (setq pto1 (offset_point ptu-w (- box-len) (- hnu:dimscale) ang)))  ;修正文字下划线tline位置。
  65.           (set-dxf tline 11 (setq pto2 (offset_point ptu-w box-len (- hnu:dimscale) ang)))    ;修正文字下划线tline位置
  66.           (if (<= (distance pt pto1) (distance pt pto2))(setq pto pto1)(setq pto pto2))      ;修正引线qline位置,其一端为文字下划线最近点
  67.           (set-dxf qline 11 pto)      
  68.           ))
  69.         (cond ((= (car ptr) 2);键盘事件
  70.          ; (if (or (= (ascii "S") (cadr ptr)) (= (ascii "s") (cadr ptr))) (command "scale" ss "" pt 0.5))
  71.          ; (if (or (= (ascii "A") (cadr ptr)) (= (ascii "a") (cadr ptr))) (command "scale" ss "" pt 2))
  72.           (if (or (= (ascii "R") (cadr ptr)) (= (ascii "r") (cadr ptr)))
  73.           (progn (command "rotate" qtext tline "" ptu-u 90) (setq ang (+ ang (* 0.5 pi)))
  74.           (setq pto1 (get-dxf 10 tline)
  75.             pto2 (get-dxf 11 tline))
  76.           (if (<= (distance pt pto1) (distance pt pto2))(setq pto pto1)(setq pto pto2))    ;修正引线qline位置,其一端为文字下划线最近点
  77.           (set-dxf qline 11 pto))
  78.           )
  79.           (if (or (= (ascii "E") (cadr ptr)) (= (ascii "e") (cadr ptr)))
  80.           (progn (command "rotate" qtext tline "" ptu-u -90) (setq ang (- ang (* 0.5 pi)))   
  81.           (setq pto1 (get-dxf 10 tline)
  82.             pto2 (get-dxf 11 tline))
  83.           (if (<= (distance pt pto1) (distance pt pto2))(setq pto pto1)(setq pto pto2))    ;修正引线qline位置,其一端为文字下划线最近点
  84.           (set-dxf qline 11 pto))
  85.           )
  86.          ; (if (or (= (ascii "E") (cadr ptr)) (= (ascii "e") (cadr ptr))) (command "rotate" ss "" pt -90))
  87.           (if (or (= (ascii "U") (cadr ptr)) (= (ascii "u") (cadr ptr)))
  88.           (progn
  89.           (entdel qtext)(entdel qline)(entdel tline)  (setq flag nil))
  90.           ) ;删除ss,同时退出循环。
  91.             ))
  92.            );while

  93. )
主函数做的事情是,接收输入,生成文字,文字下划线,引线。然后动态调整其端点。
值得注意的是,1,get_textbox为我以前文章中的取文本四角点,offset_point为比polar更直观的求点自定义函数。2,make_text_b为,make_line自定义生成对象的函数,get-dxf,set-dxf为组码获得与更新。3,动态中,鼠标当前点,使用UCS,WCS系两点保存。
调用函数代码
  1. (defun C:dba( / ss ptlist )
  2. ;Designed by 林霄云 2014年4月20日
  3. ;dim bar 标注点钢筋与线钢筋

  4. (setq ss (ssget '((0 . "INSERT,*LINE")))) ;最好加上钢筋图层控制
  5. (if ss
  6. (progn
  7. (setq ptlist (get_bar_ptlist ss))       ;有点筋么?
  8. (if ptlist
  9. (progn
  10. (dimbar ptlist t )
  11. );progn
  12. (progn
  13. (setq pt (get_linebar_pt ss))      ;有线筋么?
  14. (if pt
  15. (dimbar (list pt) nil )
  16. )
  17. );progn
  18. );if

  19. ));if ss

  20. (princ)
  21. );defun
还是得强调钱处理函数,代码给上,处理点筋点表
  1. (defun get_bar_ptlist( ss / pt_list pt en ent ptli )
  2. ;函数get_bar_ptlist,参数ss 选择集。返回值,点筋点表。
  3. ;Desiged by 林霄云 2014年2月10日
  4. ;(setq ss (ssget '((0 . "INSERT,LWPOLYLINE"))));由用户任意选择TEXT实体 用于测试
  5. (setq pt_list nil)
  6. (foreach en (SS2ENLIST ss)
  7. (setq ent (entget en))
  8. (setq typ (get-dxf 0 en))
  9. (cond
  10. ((= typ "INSERT")
  11. (if (= (get-dxf 2 en) "点筋") (setq pt (get-dxf 10 en)) (setq pt nil));if ;块插入点,WCS
  12. )
  13. ((= typ "LWPOLYLINE")

  14. ;如果是点筋,取中点
  15. (if (and (= (get-dxf 90 en) 2)
  16.      (= (abs(get-dxf 42 en)) 1))  
  17. (setq pt (mid_point (car (setq ptli (get_pline_vertex en))) (cadr ptli)))
  18. (setq pt nil)
  19. );if
  20. )
  21. );cond
  22. (if pt
  23. (setq pt_list (cons pt pt_list))
  24. )
  25. );foreach
  26. (reverse pt_list)
  27. )
比较难搞的线筋点表,敢情是最原创的东西,使用ssnamex函数。
  1. (defun get_linebar_pt( ss / pt sslist )
  2. ;Designed by 林霄云 2014年4月20日
  3. ;取线筋接触点。多选时,仅支持取第一根
  4. ;(setq ss (ssget '((0 . "INSERT,LWPOLYLINE"))))

  5. (setq sslist (ssnamex ss 0))
  6. (cond  ((= (caar sslist) 1)(setq pt (cadr (last (car sslist)))))
  7.      ((or (= (caar sslist) 2)  (= (caar sslist) 3)) (setq pt (mid_point (last(cadr (last sslist))) (last (cadddr (last sslist)))))
  8.      ;(command "line" "non" (last(cadr (last sslist))) "non" (last(caddr (last sslist))) "non" (last(cadddr (last sslist))) "non" (last(last(last sslist)))  "c") ;测试代码
  9.      )
  10. );cond
  11. ;如果是线筋,取最近点
  12. (setq pt (vlax-curve-getClosestPointTo (vlax-ename->vla-object (ssname ss 0)) pt t))  ;pt均为WCS下。
  13. ;(command "line" "non" (list 0 0) "non" (trans pt 0 1) "")
  14. )
鉴于代码中预留的解析比较详细,就不赘言了。所有的思路与步骤都已经给上。
结果
详测试图。
结论
基本完美的实现了,动态的,支持UCS的,智能判断的(文字处理,不提供输入,二是进行默认处理,是我自己的见解)点筋线筋标注集成命令。
(本文是我原创的最后一个功能,以后可能不做了,但已有的未发表的,将择机择日发布,附件中是还待整理的通用函数)
预告
1,墙线绘制源码解析(支持UCS,偏心或居中布置,厚度设置,自动填充)
2,梁线绘制源码解析(支持偏心或居中布置,宽度设置,梁线十字裁剪,梁截面标注,生成梁中轴线)

本帖子中包含更多资源

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

x

评分

参与人数 3明经币 +6 金钱 +21 收起 理由
langjs + 2 + 21 很厉害哦,虽然用不到,绝对好东西。
xyp1964 + 3 赞一个!
lucas_3333 + 1 辛苦了,写这么一大篇,只是隔行与隔山,完.

查看全部评分

"觉得好,就打赏"
还没有人打赏,支持一下
 楼主| 发表于 2014-4-23 13:29 | 显示全部楼层
根据两点原则,1、不过度设计,避免多余错误。2、不过多操作。
基于此,我不断的看自己作品的演示图,以期有更合适的操作,更清晰的概念。
对于引线是多引线还是单引线,原文为
  1. ;点筋加入引线
  2.           (if (<= len 4);一般点筋少于等于4进行如此标注。
复制代码
现修改为
  1. ;点筋加入引线
  2.           (if (> len 1);
复制代码
得到更清晰的效果是,左击,便是多引线。其他情况,为单引线。更为清晰。于是,提示改为
  1. (prompt "\n确定文字位置,逆时针旋转R,顺时针旋转E,撤销U,左击为多引线")
复制代码
回复 支持 1 反对 0

使用道具 举报

发表于 2014-4-23 00:30 | 显示全部楼层
辛苦了,写这么一大篇,只是隔行与隔山,完全看不懂。

点评

相信你自己,会有一天看懂的。我写的是考虑了较多方面的因素了(但不是全部),所以参杂一起,像极了一道综合题  发表于 2014-4-23 10:50

评分

参与人数 1明经币 +1 收起 理由
林霄云 + 1 慢慢来

查看全部评分

回复 支持 1 反对 0

使用道具 举报

发表于 2016-5-3 21:53 | 显示全部楼层
版主我加载了,不知道命令是什么?怎么用呀
回复 支持 0 反对 1

使用道具 举报

发表于 2014-4-23 09:59 | 显示全部楼层
虽然不懂,但也要强烈支持
发表于 2014-4-23 10:10 | 显示全部楼层
非常有用,感谢楼主的无私精神
发表于 2014-4-23 10:36 | 显示全部楼层
不错!
最好提供一个dwg测试文件
 楼主| 发表于 2014-4-23 10:47 | 显示全部楼层
xyp1964 发表于 2014-4-23 10:36
不错!
最好提供一个dwg测试文件

可以不要的

本帖子中包含更多资源

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

x
发表于 2014-4-23 10:51 | 显示全部楼层
非常有用,感谢楼主的无私精神,期待墙线的源码放出!
 楼主| 发表于 2014-4-23 11:12 | 显示全部楼层
  1. (if (null dotflag) (make_insert pt "_ARCHTICK" (* 1.5 hnu:dimscale) pi (getvar "clayer")));if 处理线筋符号
复制代码
在后面的撤销过程中,亦应有相应的删除操作。
  1. (if (null dotflag) (entdel (ssname (ssget (trans pt 0 1) '((0 . "INSERT")(2 . "_ARCHTICK"))) 0)));pt "_ARCHTICK" ;ssget ucs坐标系的点,处理第一个。
复制代码

本帖子中包含更多资源

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

x
发表于 2014-4-23 13:15 | 显示全部楼层
林兄很给力啊。
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-6-22 20:26 , Processed in 0.167271 second(s), 31 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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