自动标注剪力墙边缘构件详图表中纵向钢筋的面积

dyjwyqz5221

使用的前提条件：
1、表格边框均为闭合多段线：’((0 . "LWPOLYLINE")(8 . "0-表格线框")(90 . 4)(-4 . "&=")(70 . 1))
2、纵向钢筋符号的格式应为："%%132%%140R%%141|%%130%%140RH%%141|%%130|%%131|%%132|%%133"中的一种。
不是这种格式时，可以更换字体并替换。有空再发钢筋符号的替换程序。

每个详图仅标注最下面的钢筋面积，其余均不标注。

[Actionscript3] 纯文本查看 复制代码

(defun c:mj-jlqzj(/ ss-tab)
        ;;;钢筋圆面积
        (defun Circle_Area(dia)
                (* pi dia dia 0.25)
        );;;defun
        ;;;计算钢筋面积字符串,里面有多个及括号时，均适用，+、/号时相加
        (defun yqz::reBarArea(e / str lst)
                (setq str (xdrx_string_regexpr "\\s+|[\\(\\（\\[\\{\\<\\《\\{\\【]([^%]+)[\\)\\）\\]\\}\\>\\》\\}\\】]" (xdrx_text_string e) "" "")
                        str (xdrx_string_regexpr "%%132%%140R%%141|%%130%%140RH%%141|%%130|%%131|%%132|%%133" str "x" "")
                        str (xdrx_string_regexps "[^\\(\\)\\[\\]\\{\\}\\<\\>\\;\\（\\）\\【\\】\\《\\》\\{\\}\\；]+" str "")
                        lst
                        (vl-remove nil
                                (mapcar
                                        '(lambda(x)
                                                 (mapcar 'atoi (xdrx_string_regexps "[0-9]+" x ""))
                                        );;;lambda(x)        
                                        str
                                );;;mapcar
                        );;;vl
                );;;setq
                (XD::LIST->STRING
                        (mapcar
                                '(lambda(x)
                                        (rtos
                                                (apply '+
                                                        (mapcar 
                                                                '(lambda(a b) 
                                                                        (* a (Circle_Area b))
                                                                )
                                                                (XD::List:ODD x) (XD::List:Even x)
                                                        );;;mapcar        
                                                );;;apply
                                                2 0
                                        );;;rtos
                                );;;lambda
                                lst
                        );;;mapcar
                        ";"
                )        
        );;;defun        
        (defun _pross(ss-tab / lst)
                (xdrx_begin)
                (xdrx_sysvar_push '("osmode" 0 "cmdecho" 0));;;捕捉和命令关闭
                (xdrx_runtime t)
                (mapcar
                        '(lambda(x / box ss-zj)
                                (setq box (xdrx_entity_box x)
                                        ss-zj (ssget "wp" box '((0 . "text")(1 . "~*[@NG-]*")(1 . "*%%*")))
                                );;;setq
                                (if ss-zj
                                        (setq e-zj
                                                (car
                                                        (vl-sort (xdrx_pickset->ents ss-zj)
                                                                '(lambda(a b)
                                                                        (< (cadr (xdrx_GetPropertyValue a "position"))
                                                                                (cadr (xdrx_GetPropertyValue b "position"))
                                                                        )
                                                                )
                                                        )
                                                )
                                                lst (cons e-zj lst)
                                        );;;setq
                                );;;if
                        );;;lambda
                        (xdrx_pickset->ents ss-tab)
                );;;mapcar
                (if lst
                        (progn
                                (xdrx_setmark)
                                (mapcar
                                        '(lambda(x / box)
                                                (setq box (xdrx_text_box x));;;文字的世界坐标系实际包围盒
                                                (XD::Text:Make 
                                                                (list (xdrx_line_midp (car box) (cadr box)));;;取下面两个点的中点
                                                                (yqz::reBarArea x)
                                                                "yqz-style"
                                                                250.
                                                                0.70
                                                                (xdrx_GetPropertyValue x "rotation")
                                                                "TC";;;与前面的选点中上对齐
                                                )        
                                        );;;lambda(x)
                                        lst
                                );;;mapcar
                                (xdrx_entity_setproperty (xdrx_getss) "layer" "mj-jlqzj" "color" 2)
                                (xdrx_prompt "\n恭喜：共标注 "(length lst)" 处纵向钢筋面积！用时 "(xdrx_runtime)" 秒。")
                        );;;progn
                        (xdrx_prompt "\n敬告：未找到纵向钢筋！用时 "(xdrx_runtime)" 秒。")
                );;;if
                (xdrx_sysvar_pop)
                (xdrx_end)
                (princ)
        );;;while
        (while (setq ss-tab (xdrx-ssget "\n框选剪力墙边缘构件详图<右键退出>:" ":L" '((0 . "LWPOLYLINE")(8 . "0-表格线框")(90 . 4)(-4 . "&=")(70 . 1))))
                (_pross ss-tab)
        );;;while
        (princ)
);;;defun

既然青春留不住

lyylym