[编程申请]：请编一个结构钢筋面积自动显示程序

lyylyy

做结构的同仁可能都会遇到这种情况，用tssd修改梁、柱配筋后，在校对时若是对照如tbsa等程序的配筋简图，对配筋面积往往需花费不少时间。
  请高手帮助编写一个钢筋面积自动显示程序，如：1Ф12(113mm2),2Ф12+1Ф25(716mm2),（括号内显示钢筋面积），并能通过一个开关命令，显示或关闭括号及括号内数值。
  先谢了！

它山之石

　　是个好主意。俺的想法是利用反应器，给每个钢筋标注值（如1Ф12）设一个附加值（即钢筋面积），当改动钢筋标注值时，面积相应自动修改。再加一个控制钢筋面积值显示的开关命令就行了。
　　只是俺对反应器不太熟悉，不知能否实现。如有哪位高手能做出这种功能就太好了。

eachy

最初由 它山之石 发布
[B]　　是个好主意。俺的想法是利用反应器，给每个钢筋标注值（如1Ф12）设一个附加值（即钢筋面积），当改动钢筋标注值时，面积相应自动修改。再加一个控制钢筋面积值显示的开关命令就行了。
　　只是俺对反应器不太?... [/B]

可以作到，只是我不知钢筋面积怎么算，还有那个钢筋符号每个人可能不同。

xuwenzhong

支持版主的意见，把它编出来献给大家！谢谢！

f5612140

讀文字處理比較實際
1Ф12(113mm2)  =   1 * PI * 12 * 12 / 4
2Ф12+1Ф25(716mm2)  =  2 * PI * 12 * 12 / 4  +  1 * PI * 25 * 25 /4

water02

感觉5楼得思路简单可行，对字符串进行处理运算

xuwenzhong

不错！好东东！

zxq0220

1：显示
[php]
(DEFUN C:SHOWBAR ()
(SETQ SS (SSGET "X" '((0 . "TEXT")))
       I 0)
(REPEAT (SSLENGTH SS)
  (SETQ ENT (ENTGET (SSNAME SS I))
        STR (CDR (ASSOC 1 ENT))
        SL (STRLEN STR)
        J 1 S3 0 I (1+ I))
  (WHILE (< J SL)
   (SETQ S1 "" S2 "")
   (WHILE (AND (>= (SETQ ST (SUBSTR STR J 1)) "0") (<= ST "9"))
    (SETQ S1 (STRCAT S1 ST) J (1+ J))
   )
   (SETQ J (+ J 2))
   (WHILE (AND (>= (SETQ ST (SUBSTR STR J 1)) "0") (<= ST "9"))
    (SETQ S2 (STRCAT S2 ST) J (1+ J))
   )
   (SETQ S3 (+ (FIX (* (ATOI S1) PI (ATOI S2) (ATOI S2) 0.25)) S3))
   (SETQ J (1+ J))
  )
  (PRINC S3)
  (SETQ ENT (SUBST (CONS 1 (STRCAT STR "(" (ITOA (FIX S3)) "mm2)")) (CONS 1 STR) ENT))
  (ENTMOD ENT)
)
(PRINC)
)
[/php]
2：关闭
[php]
(DEFUN C:DISAPPEARBAR ()
(SETQ SS (SSGET "X" '((0 . "TEXT")))
       I 0)
(REPEAT (SSLENGTH SS)
  (SETQ ENT (ENTGET (SSNAME SS I))
        STR (CDR (ASSOC 1 ENT))
        SL (STRLEN STR)
        J 1 I (1+ I))
  (WHILE (AND (< J SL) (/= (SUBSTR STR J 1) "(")) (SETQ J (1+ J)))
  (IF (< J SL) (PROGN
   (SETQ ENT (SUBST (CONS 1 (SUBSTR STR 1 (1- J))) (CONS 1 STR) ENT))
   (ENTMOD ENT)
  ))
)
(PRINC)
)
[/php]

ZHGWF

8楼你好，我试了一下，好像不行。
要是可以的话就太好了。

蓝静如水

这是一个非常好的想法，对于结构专业的人很有帮助。麻烦哪位高人百忙之中抽空帮帮忙。

zxq0220

回复ZHGWF:
程序在R14上调试通过。只是简单的将钢筋符号当成双字节跳过处理。
不知您用的钢筋符号是什么符号？ACAD用的是什么版本？
如果可能将您的图传上来让我看看，或发到我的邮箱zxq0220@sohu.com中。

ZHGWF

你好，已传到你的邮箱里了。

zxq0220

最初由 ZHGWF 发布
[B]你好，已传到你的邮箱里了。 [/B]

看到邮件，附件已下载。正在处理中......
更改后显示面积：
[php]
(DEFUN C:SHOWBAR ()
(SETQ SS (SSGET "X" '((0 . "TEXT")))
       I 0)
(REPEAT (SSLENGTH SS)
  (SETQ ENT (ENTGET (SSNAME SS I))
        STR (CDR (ASSOC 1 ENT))
        SL (STRLEN STR)
        J 1 S3 0 I (1+ I))
  (IF (AND (NOT (WCMATCH STR "*/*")) (WCMATCH STR "*!*")) (PROGN
   (WHILE (< J SL)
    (SETQ S1 "" S2 "")
    (WHILE (AND (>= (SETQ ST (SUBSTR STR J 1)) "0") (<= ST "9"))
     (SETQ S1 (STRCAT S1 ST) J (1+ J))
    )
    (SETQ J (+ J 1))
    (WHILE (AND (>= (SETQ ST (SUBSTR STR J 1)) "0") (<= ST "9"))
     (SETQ S2 (STRCAT S2 ST) J (1+ J))
    )
    (SETQ S3 (+ (FIX (* (ATOI S1) PI (ATOI S2) (ATOI S2) 0.25)) S3))
    (SETQ J (1+ J))
   )
   (SETQ ENT (SUBST (CONS 1 (STRCAT STR "(" (ITOA (FIX S3)) "mm2)")) (CONS 1 STR) ENT))
   (ENTMOD ENT)
  ))
)
(PRINC)
)
[/php]
关闭：
[php]
(DEFUN C:DISAPPEARBAR ()
(SETQ SS (SSGET "X" '((0 . "TEXT")))
       I 0)
(REPEAT (SSLENGTH SS)
  (SETQ ENT (ENTGET (SSNAME SS I))
        STR (CDR (ASSOC 1 ENT))
        SL (STRLEN STR)
        J 1 I (1+ I))
  (IF (AND (NOT (WCMATCH STR "*/*")) (WCMATCH STR "*!*")) (PROGN
   (WHILE (AND (< J SL) (/= (SUBSTR STR J 1) "(")) (SETQ J (1+ J)))
   (IF (< J SL) (PROGN
    (SETQ ENT (SUBST (CONS 1 (SUBSTR STR 1 (1- J))) (CONS 1 STR) ENT))
    (ENTMOD ENT)
   ))
  ))
)
(PRINC)
)
[/php]

ZHGWF

多谢zxq0220，让我明白了怎么回事，带“/”未能显示出来。
这种方法对校对很有帮助，是个不错的主意，可是对正在配梁筋，或修改梁配筋时不能动态显示配筋量。

蓝静如水

zxq0220你好，用了你写的程序，先表示感谢。但是我成功加载运行了贵程序后，图面没有任何变化，命令行也没有任何提示。请问是什么原因？谢谢！