简易钢材重量计算

mvehu 发表于 2016-1-2 10:12:48

本帖最后由 mvehu 于 2016-1-5 20:13 编辑

用来计算矩管、圆管、圆钢、钢板、折弯件、角钢（3#、4#）等工作中经常接触到的钢材重量，并加总。类似于材料明细表中重量的功能。

语法：[<number>-]<form><n>x<n>...

<number>数量；<form>类型：实心圆棒q 空心圆环o 方管d 几字钢j 钢板i 折弯件z 角钢v <length>长度

比如2根50x50方管，壁厚2mm，长度1000mm，输入表达式 2-d50x50x2l1000
如果是1根，前面的1-可省略。

再比如1根圆管，直径33，壁厚3mm，长度6000mm，输入表达式 o33x3l6000

1块钢板240x240,10mm厚，表达式 i240x240x10
1根折弯件，各边长分别是30、20、45，板厚1mm，长4000mm，表达式 z30x20x45x1l4000

使用了正则表达式验证输入是否符合语法。（不支持边长、直径参数带小数点，壁厚可带小数点.)

6楼有新修改的代码，增加了重新编辑计算已有算式的命令。 1楼的当作历史版本吧。

(defun weight (density guige-list / form z-length num)
                                    ;接受密度和一个规格表 (型材类型代号规格参数... )
                                    ;计算重量
(setq form (car guige-list))       ;型材代号
(cond
((= form 'o)                      ; 空心圆环 (o 32 2 length)
(* (/ pi 4)
   4
   (nth 2 guige-list)
   (- (nth 1 guige-list) (nth 2 guige-list))
   (nth 3 guige-list)
   density
   )
)
((= form 'q)                      ;实心圆棒 (q 32 length)
(* (/ pi 4)
   (nth 1 guige-list)
   (nth 1 guige-list)
   (nth 2 guige-list)
   density
   )
)
((= form 'd)                      ;矩形管 (d 50 30 2 length)
(* 2
   (nth 3 guige-list)
   (+ (nth 1 guige-list) (nth 2 guige-list) (* -2 (nth 3 guige-list)))
   (nth 4 guige-list)
   density
   )
)
((= form 'j)                      ;几字钢（j 50 length)
(cond ((= (nth 1 guige-list) '38) (* (nth 2 guige-list) 1.6e-3))
                                    ;展开 130 ，1.03镀锌系数
      ((= (nth 1 guige-list) '50) (* (nth 2 guige-list) 1.94e-3))
                                    ;展开 160
      ((= (nth 1 guige-list) '70) (* (nth 2 guige-list) 2.6e-3))
      )
)                               ;展开 214
((= form 'i)                      ;板状物(i 边长边长厚度)
(* (nth 1 guige-list) (nth 2 guige-list) (nth 3 guige-list) density)
)
((= form 'z)                      ; 多边折弯件 (z 边长1 边长2 ... 厚度延长)
(setq z-length 0                ;封边各边长总长
      num 1
      )
(while (<= num (- (length guige-list) 3))
   (setq z-length (+ (nth num guige-list) z-length))
   (setq num (1+ num))
   )
(* density
   z-length
   (nth num guige-list)          ;厚度
   (nth (1+ num) guige-list)    ;延长
   )
)
((= form 'v)                      ;角钢（v 3 length)
(cond ((= (nth 1 guige-list) '3) (* (nth 2 guige-list) 1.09e-3))
                                    ;3号角钢6.5kg/6m
      ((= (nth 1 guige-list) '4) (* (nth 2 guige-list) 1.75e-3))
                                    ;4号角钢10.5kg/6m
      )
)
)
)

(defun regex-test (pat str key / regex test)
;; 测试字符串str是否存在字串符合正则表达式模式pat
;; pat 正则表达式 str 字符串
;; pat 中 \ 使用 \\
;; key "igm" i(Ignorecase)忽略大小写 g (Global)全局匹配 m (Multili) 多行模式
;; 注意：一般使用全局匹配 g
;; 可组合使用或单独使用或置空 ""
(vl-load-com)
(setq regex (vlax-create-object "Vbscript.RegExp")) ;引用正则表达式控件
(if (wcmatch key "*i*,*I*")
(vlax-put-property regex "IgnoreCase" 1) ;忽略大小写
(vlax-put-property regex "IgnoreCase" 0) ;不忽略大小写
)
(if (wcmatch key "*g*,*G*")
(vlax-put-property regex "Global" 1) ;匹配方式，全文字匹配
(vlax-put-property regex "Global" 0)
)
(if (wcmatch key "*m*,*M*")
(vlax-put-property regex "Multiline" 1) ;多行模式
(vlax-put-property regex "Multiline" 0)
)
(vlax-put-property regex "Pattern" pat)
(setq test (if (eq (vlax-invoke-method regex "test" str) :vlax-true)
            t
            nil
            )
   )
(vlax-release-object regex)
test
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun test-str (str)                ;判断str是否符合特定模式
(cond ((regex-test "^\\d+-o\\d+x\\d+\\.?\\d*l\\d+$" str "ig") t)
                                    ;1-o32x1.8l2000
   ((regex-test "^\\d+-q\\d+\\.?\\d*l\\d+$" str "ig") t) ;24-q16l500
   ((regex-test "^\\d+-d\\d+x\\d+x\\d+\\.?\\d*l\\d+$" str "ig") t) ;2-d50x50x2.5l1000
   ((regex-test "^\\d+-j(38|50|70)l\\d+$" str "ig") t) ;1-j38|50|70l1000
   ((regex-test "^\\d+-i\\d+x\\d+x\\d+$" str "ig") t) ;1-i100x100x10
   ((regex-test "^\\d+-z\\d+(x\\d+)+l\\d+$" str "ig") t) ;2-z10x10x20x2l1000
   ((regex-test "^\\d+-vl\\d+$" str "ig") t) ;24-v3|4l500
   ((= str "1-e") t)             ;结束
   (t nil)
   )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun parsel (str delim / LST POS)
;;字符串分割 delim是用来分割的字符
(setq lst nil)
(while (setq pos (vl-string-search delim str))
(setq lst (cons (substr str 1 pos) lst)
      str (substr str (+ pos 2))
      )
)
(if (> (strlen str) 0)
(setq lst (cons str lst))
)
(reverse lst)
)

(defun add1- (str)                   ;辅助函数如果字符串中不含"-"，则在开头添加"1-"
(if (not (vl-string-position (ascii "-") str))
(strcat "1-" str)
str
)
)

(defun str->weight
   (str-n / density str->list number guige-list str-weight canshu form)
                                    ;从字符串计算重量列表
                                    ;返回一个列表 (字符串：数量-类型-单重-总重总重）
(setq density 7.85e-6)             ;钢材密度
(setq str->list
      (read
      (strcat
         "("                      ;将字符串str-n分解成各参数的列表
         (vl-string-translate
            "-xl"                ;参数分割字符集 -xl
            " "
            (strcat
            (substr str-n
                     1
                     (+ 2 (vl-string-position (ascii "-") str-n))
                     )
            "-"
            (substr str-n
                     (+ 3 (vl-string-position (ascii "-") str-n))
                     )
            )
            )
         ")"
         )
      )
   )
(setq number (car str->list)    ; 该类型钢材数量
   guige-list (cdr str->list)    ;该类型钢材重量计算的规格表
   str-weight (weight density guige-list) ;钢材重量
   canshu (strcase
                  (substr str-n (+ 3 (vl-string-position (ascii "-") str-n)))
                  )
   )                            ;规格表转换大写
(setq form (cadr str->list))
(cond ((= form 'o) (setq form "圆钢管%%C"))
   ((= form 'q) (setq form "圆钢%%C"))
   ((= form 'd) (setq form "钢矩管\\U+25A1"))
   ((= form 'j) (setq form "几字钢J"))
   ((= form 'i) (setq form "钢板I"))
   ((= form 'z) (setq form "折弯件Z"))
   ((= form 'v) (setq form "角钢\\U+2220"))
   )
(list (strcat (rtos (nth 0 str->list))
            "个"
            form
            canshu
            ",单重："
            (rtos str-weight 2 3)
            "kg"
            ",总重： "
            (rtos (* str-weight number) 2 3)
            "kg。"
            )
   (* str-weight number)
   )
)

(defun c:sweight
   (/ str weight-list weight-sum num str-str-sum point text-size)
(princ
"语法：[<number>-]<form><n>x<n>... [<number>-]<form><n>x<n>..."
)
(princ
"\n<number>数量；<form>类型：实心圆棒q 中心圆环o 方管d 几字钢j 钢板i 折弯件z 角钢v <length>长度"
)
(princ
"\n例子：实心圆棒q16l500中心圆环2-o32x1.8l1000 方管3-d50x50x2l1500 \n
几字钢1-j38|50|70l1000 钢板i-100x100x3 折弯件z30x30x2l1000 角钢v3|4l500"
)
(setq weight-sum 0
   str-str-sum " "
   )
(while
(progn
   (while
   (not (test-str
            (setq
            str (add1- (getstring
                           t
                           "\n输入计算表达式[圆管O|圆钢Q|矩管D|几字钢J|钢板I|折弯Z|角钢V]："
                           )
                        )
            )
            )
         )
   (princ "\n输入语法有误，请重新输入")
   )
   (if (not (= str "1-e"))
   t
   )
   )
(setq str->weight-list (str->weight str))
(setq weight-sum(+ weight-sum (cadr str->weight-list))
      str-str-sum (strcat str-str-sum (car str->weight-list) "\\P")
      )
(princ (strcat (car str->weight-list)
               "=>以上重量加总"
               (rtos weight-sum 2 3)
               "kg"
               )
         )
)
(if
(not (= (getstring "是否将计算结果写入文档(n不写入)<默认写入>:") "n"))
(progn (setq str-str-sum
               (strcat (substr str-str-sum 2)
                        "----------------\\P总重："
                        (rtos weight-sum 2 2)
                        "kg"
                        )
               )
         (setq point (getpoint "输入文字起始位置"))
         (setq text-size          ;当前字体高度
               (cdr (assoc 40 (entget (tblobjname "style" (getvar "textstyle")))))
               )
         (command "mtext"
                  point
                  (polar point -0.1 (* 45 text-size))
                                    ; 设置多行文字宽度字体高度的45倍
                  str-str-sum
                  ""
                  )
         )
)
)

tanxindong 发表于 2025-1-18 14:09:00

比较实用，太给力了，收下也谢谢:hug:

帆航发表于 2020-3-20 11:43:49

简易钢材重量计算

bai2000 发表于 2016-1-3 21:30:39

本帖最后由 bai2000 于 2016-1-4 09:52 编辑

X 能改为*么？不符合输入数字的习惯
同时把工字钢、槽钢加进去？

mvehu 发表于 2016-1-4 22:06:44

本帖最后由 mvehu 于 2016-1-4 22:30 编辑

bai2000 发表于 2016-1-3 21:30 static/image/common/back.gif
X 能改为*么？不符合输入数字的习惯
同时把工字钢、槽钢加进去？
在笔记本电脑小键盘上，输入* 需要同时按两个键，而输入字母x只需要按一个键，比较方便。当然，如果修改成*，改代码也不难。你可以自己试试。

工字钢、槽钢，我工作上接触不到，理论计算公式也不知道啊。

mvehu 发表于 2016-1-4 22:26:16

本帖最后由 mvehu 于 2016-1-5 13:43 编辑

新增加了一个编辑已有算式的命令 resw

适合如下情况：已经有一个算式文本。现在要修改几个参数或者增加几种新的材料。修改参数，可以直接在文本上改。然后运行resw，选择算式文本，输入e，重新计算重量，或者输入追加的新的材料规格。

调试程序的时候发现两个奇怪问题。

1，在第一版程序中，输出结果时候用了一些如 \U+25A1 这样的Unicode Character□。但是用如下代码获取字符串时候
(setq vlax-string (vlax-ename->vla-object (car (entsel "请选择算式:"))))
(setq string (vlax-get-property vlax-string "TextString"))

有时获取的是 □，有时又变成了 \U+25A1 。导致程序有时能运行，有时又不成。搞不清原因，只得全改回英文字母 D V

2, 有一个测试输入字符串是否合法的函数 test-str ，已经在前面定义了。但是在resw 中调用的时候，总是报错，说没有定义。在控制台查询，也有定义！实在没办法，在调用 test-str 之前，又重新定义了一遍，这次通过了。【发现原因了。在resw函数定义时，误把test-str定义成了临时变量】

下面是全部新代码：

(defun weight (density guige-list / form z-length num)
                                    ;接受密度和一个规格表 (型材类型代号规格参数... )
                                    ;计算重量
(setq form (car guige-list))       ;型材代号
(cond
((= form 'o)                      ; 空心圆环 (o 32 2 length)
(* (/ pi 4)
   4
   (nth 2 guige-list)
   (- (nth 1 guige-list) (nth 2 guige-list))
   (nth 3 guige-list)
   density
   )
)
((= form 'q)                      ;实心圆棒 (q 32 length)
(* (/ pi 4)
   (nth 1 guige-list)
   (nth 1 guige-list)
   (nth 2 guige-list)
   density
   )
)
((= form 'd)                      ;矩形管 (d 50 30 2 length)
(* 2
   (nth 3 guige-list)
   (+ (nth 1 guige-list) (nth 2 guige-list) (* -2 (nth 3 guige-list)))
   (nth 4 guige-list)
   density
   )
)
((= form 'j)                      ;几字钢（j 50 length)
(cond ((= (nth 1 guige-list) '38) (* (nth 2 guige-list) 1.6e-3))
                                    ;展开 130 ，1.03镀锌系数
      ((= (nth 1 guige-list) '50) (* (nth 2 guige-list) 1.94e-3))
                                    ;展开 160
      ((= (nth 1 guige-list) '70) (* (nth 2 guige-list) 2.6e-3))
      )
)                               ;展开 214
((= form 'i)                      ;板状物(i 边长边长厚度)
(* (nth 1 guige-list) (nth 2 guige-list) (nth 3 guige-list) density)
)
((= form 'z)                      ; 多边折弯件 (z 边长1 边长2 ... 厚度延长)
(setq z-length 0                ;封边各边长总长
      num 1
      )
(while (<= num (- (length guige-list) 3))
   (setq z-length (+ (nth num guige-list) z-length))
   (setq num (1+ num))
   )
(* density
   z-length
   (nth num guige-list)          ;厚度
   (nth (1+ num) guige-list)    ;延长
   )
)
((= form 'v)                      ;角钢（v 3 length)
(cond ((= (nth 1 guige-list) '3) (* (nth 2 guige-list) 1.09e-3))
                                    ;3号角钢6.5kg/6m
      ((= (nth 1 guige-list) '4) (* (nth 2 guige-list) 1.75e-3))
                                    ;4号角钢10.5kg/6m
      )
)
)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;正则表达式

(defun regex-extract (pat str key / regex S tmp str1)
;; 提取正则表达式匹配到的内容
;; pat 正则表达式 str 字符串
;; pat 中 \ 使用 \\
;; key "igm" i(Ignorecase)忽略大小写 g (Global)全局匹配 m (Multili) 多行模式
;; 注意：一般使用全局匹配 g
;; 可组合使用或单独使用或置空 ""
(vl-load-com)
(setq regex (vlax-create-object "Vbscript.RegExp")) ;引用正则表达式控件
(if (wcmatch key "*i*,*I*")
(vlax-put-property regex "IgnoreCase" 1) ;忽略大小写
(vlax-put-property regex "IgnoreCase" 0) ;不忽略大小写
)
(if (wcmatch key "*g*,*G*")
(vlax-put-property regex "Global" 1) ;匹配方式，全文字匹配
(vlax-put-property regex "Global" 0)
)
(if (wcmatch key "*m*,*M*")
(vlax-put-property regex "Multiline" 1) ;多行模式
(vlax-put-property regex "Multiline" 0)
)
(vlax-put-property regex "Pattern" pat)
(setq s (vlax-invoke-method regex "Execute" str))
;;将规则运用到STR字符，得到提取出的文字内容
(VLAX-FOR tmp s                   ;遍历集合对象
(setq str1 (cons (vlax-get-property tmp "value") str1))
)
;;将内容转换为LISP语言就可以直接观察了
(vlax-release-object regex)
(REVERSE str1)
)

(defun regex-test (pat str key / regex test)
;; 测试字符串str是否存在字串符合正则表达式模式pat
;; pat 正则表达式 str 字符串
;; pat 中 \ 使用 \\
;; key "igm" i(Ignorecase)忽略大小写 g (Global)全局匹配 m (Multili) 多行模式
;; 注意：一般使用全局匹配 g
;; 可组合使用或单独使用或置空 ""
(vl-load-com)
(setq regex (vlax-create-object "Vbscript.RegExp")) ;引用正则表达式控件
(if (wcmatch key "*i*,*I*")
(vlax-put-property regex "IgnoreCase" 1) ;忽略大小写
(vlax-put-property regex "IgnoreCase" 0) ;不忽略大小写
)
(if (wcmatch key "*g*,*G*")
(vlax-put-property regex "Global" 1) ;匹配方式，全文字匹配
(vlax-put-property regex "Global" 0)
)
(if (wcmatch key "*m*,*M*")
(vlax-put-property regex "Multiline" 1) ;多行模式
(vlax-put-property regex "Multiline" 0)
)
(vlax-put-property regex "Pattern" pat)
(setq test (if (eq (vlax-invoke-method regex "test" str) :vlax-true)
            t
            nil
            )
   )
(vlax-release-object regex)
test
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun test-str (str)                ;判断str是否符合特定模式
(cond ((regex-test "^\\d+-o\\d+x\\d+\\.?\\d*l\\d+$" str "ig") t)
                                    ;1-o32x1.8l2000
   ((regex-test "^\\d+-q\\d+\\.?\\d*l\\d+$" str "ig") t) ;24-q16l500
   ((regex-test "^\\d+-d\\d+x\\d+x\\d+\\.?\\d*l\\d+$" str "ig") t)
                                    ;2-d50x50x2.5l1000
   ((regex-test "^\\d+-j(38|50|70)l\\d+$" str "ig") t)
                                    ;1-j38|50|70l1000
   ((regex-test "^\\d+-i\\d+x\\d+x\\d+$" str "ig") t) ;1-i100x100x10
   ((regex-test "^\\d+-z\\d+(x\\d+)+l\\d+$" str "ig") t)
                                    ;2-z10x10x20x2l1000
   ((regex-test "^\\d+-vl\\d+$" str "ig") t) ;24-v3|4l500
   ((= str "1-e") t)             ;结束
   (t nil)
   )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun parsel (str delim / LST POS)
;;字符串分割 delim是用来分割的字符
(setq lst nil)
(while (setq pos (vl-string-search delim str))
(setq lst (cons (substr str 1 pos) lst)
      str (substr str (+ pos 2))
      )
)
(if (> (strlen str) 0)
(setq lst (cons str lst))
)
(reverse lst)
)

(defun add1- (str)                   ;辅助函数如果字符串中不含"-"，则在开头添加"1-"
(if (not (vl-string-position (ascii "-") str))
(strcat "1-" str)
str
)
)

(defun str->weight
   (str-n / density str->list number guige-list str-weight canshu form)
                                    ;从字符串计算重量列表
                                    ;返回一个列表 (字符串：数量-类型-单重-总重总重）
(setq density 7.85e-6)             ;钢材密度
(setq str->list
      (read
      (strcat
         "("                      ;将字符串str-n分解成各参数的列表
         (vl-string-translate
            "-xXLl"                ;参数分割字符集 -xl
            " "
            (strcat
            (substr str-n
                     1
                     (+ 2 (vl-string-position (ascii "-") str-n))
                     )
            "-"
            (substr str-n
                     (+ 3 (vl-string-position (ascii "-") str-n))
                     )
            )
            )
         ")"
         )
      )
   )
(setq number (car str->list)    ; 该类型钢材数量
   guige-list (cdr str->list)    ;该类型钢材重量计算的规格表
   str-weight (weight density guige-list) ;钢材重量
   canshu (strcase
                  (substr str-n (+ 3 (vl-string-position (ascii "-") str-n)))
                  )
   )                            ;规格表转换大写
(setq form (cadr str->list))
(cond ((= form 'o) (setq form "圆钢管%%C"))
   ((= form 'q) (setq form "圆钢%%C"))
   ((= form 'd) (setq form "钢矩管D"))
   ((= form 'j) (setq form "几字钢J"))
   ((= form 'i) (setq form "钢板I"))
   ((= form 'z) (setq form "折弯件Z"))
   ((= form 'v) (setq form "角钢V"))
   )
(list (strcat (rtos (nth 0 str->list))
            "个"
            form
            canshu
            ",单重："
            (rtos str-weight 2 3)
            "kg"
            ",总重： "
            (rtos (* str-weight number) 2 3)
            "kg。"
            )
   (* str-weight number)
   )
)

(defun c:sw (/ str weight-list weight-sum num str-str-sum point text-size)
(princ "语法：[<number>-]<form><n>x<n>...")
(princ
"\n<number>数量；<form>类型：实心圆棒q 空心圆环o 方管d 几字钢j 钢板i 折弯件z 角钢v <length>长度"
)
(princ
"\n例子：实心圆棒q16l500空心圆环2-o32x1.8l1000 方管3-d50x50x2l1500 \n
几字钢1-j38|50|70l1000 钢板i-100x100x8 折弯件z30x30x2l1000 角钢v3|4l500"
)
(setq weight-sum 0
   str-str-sum ""
   )
(while (progn (while (not (test-str (setq str
                                          (add1-
                                          (getstring
                                             t
                                             "\n输入计算表达式[圆管O|圆钢Q|矩管D|几字钢J|钢板I|折弯Z|角钢V]："
                                             )
                                          )
                                       )
                                 )
                        )
               (princ "\n输入语法有误，请重新输入")
               )
            (if (not (= str "1-e"))
               t
               )
            )
(setq str->weight-list (str->weight str))
(setq weight-sum(+ weight-sum (cadr str->weight-list))
      str-str-sum (strcat str-str-sum (car str->weight-list) "\\P")
      )
(princ (strcat (car str->weight-list)
               "=>以上重量加总"
               (rtos weight-sum 2 3)
               "kg"
               )
      )
)
(if
(not (= (getstring "是否将计算结果写入文档(n不写入)<默认写入>:") "n"))
(progn (setq str-str-sum
               (strcat str-str-sum
                        "----------------\\P总重："
                        (rtos weight-sum 2 2)
                        "kg"
                        )
               )
         (setq point (getpoint "输入文字起始位置"))
         (setq text-size          ;当前字体高度
               (cdr (assoc 40 (entget (tblobjname "style" (getvar "textstyle")))))
               )
         (command "mtext"
                  point
                  (polar point -0.1 (* 45 text-size))
                                    ; 设置多行文字宽度字体高度的45倍
                  str-str-sum
                  ""
                  )
         )
)
)

(defun c:resw (/          vlax-string string    text-weight
            num       weight-sum str-str-sum test-str
            str       str->weight-list
            )
;;重新计算已有文本
(VL-LOAD-COM)
(setq vlax-string (vlax-ename->vla-object (car (entsel "请选择算式:"))))
                                    ;已有文本的vlax对象
(setq string (vlax-get-property vlax-string "TextString"))
(defun string-trim (string / str s tmp) ;字符串重新格式化函数
(setq str (regex-extract "(^|\\\\P)[^,]+(?=,)" string "igm"))
(defun trim (str)
   (setq str (vl-string-subst "" "\\P" str))
   (setq str (vl-string-subst "-o" "个圆钢管%%C" str))
   (setq str (vl-string-subst "-d" "个钢矩管D" str))
   (setq str (vl-string-subst "-i" "个钢板I" str))
   (setq str (vl-string-subst "-j" "个几字钢J" str))
   (setq str (vl-string-subst "-z" "个折弯件Z" str))
   (setq str (vl-string-subst "-v" "个角钢V" str))
   (setq str (vl-string-subst "-q" "个圆钢%%C" str))
   str
   )
(setq tmp nil)
(foreach s str (setq tmp (cons (trim s) tmp)))
(reverse tmp)
)
(setq string (string-trim string))
(setq text-weight (mapcar 'str->weight string))
(setq num 0
   weight-sum 0
   )
(repeat (length text-weight)       ;计算已有算式的总重
(setq weight-sum (+ (cadr (nth num text-weight)) weight-sum))
(setq num (1+ num))
)
(setq str-str-sum "")             ;计算已有算式的字符串说明汇总
(repeat (length text-weight)
(setq str-str-sum (strcat str-str-sum (caar text-weight) "\\P"))
(setq text-weight (cdr text-weight))
)
(princ str-str-sum)
(princ (strcat "=>以上重量加总" (rtos weight-sum 2 3) "kg"))

;;;;;;;;;;;;;;;;;;;;;;;;！！！非常奇怪！！！ test-str函数前面已定义，可运行时，总是说无定义。只得在此重新定义一下。
(defun test-str (str)             ;判断str是否符合特定模式
(cond ((regex-test "^\\d+-o\\d+x\\d+\\.?\\d*l\\d+$" str "ig") t)
                                    ;1-o32x1.8l2000
      ((regex-test "^\\d+-q\\d+\\.?\\d*l\\d+$" str "ig") t)
                                    ;24-q16l500
      ((regex-test "^\\d+-d\\d+x\\d+x\\d+\\.?\\d*l\\d+$" str "ig") t)
                                    ;2-d50x50x2.5l1000
      ((regex-test "^\\d+-j(38|50|70)l\\d+$" str "ig") t)
                                    ;1-j38|50|70l1000
      ((regex-test "^\\d+-i\\d+x\\d+x\\d+$" str "ig") t)
                                    ;1-i100x100x10
      ((regex-test "^\\d+-z\\d+(x\\d+)+l\\d+$" str "ig") t)
                                    ;2-z10x10x20x2l1000
      ((regex-test "^\\d+-vl\\d+$" str "ig") t) ;24-v3|4l500
      ((= str "1-e") t)          ;结束
      (t nil)
      )
)

(while (progn (while (not (test-str (setq str
                                          (add1-
                                          (getstring
                                             t
                                             "\n输入计算表达式[圆管O|圆钢Q|矩管D|几字钢J|钢板I|折弯Z|角钢V]："
                                             )
                                          )
                                       )
                                 )
                        )
               (princ "\n输入语法有误，请重新输入")
               )
            (if (not (= str "1-e"))
               t
               )
            )
(setq str->weight-list (str->weight str))
(setq weight-sum(+ weight-sum (cadr str->weight-list))
      str-str-sum (strcat str-str-sum (car str->weight-list) "\\P")
      )
(princ (strcat (car str->weight-list)
               "=>以上重量加总"
               (rtos weight-sum 2 3)
               "kg"
               )
      )
)
(setq str-str-sum
      (strcat str-str-sum
            "----------------\\P总重："
            (rtos weight-sum 2 2)
            "kg"
            )
   )
(vlax-put-property vlax-string "TextString" str-str-sum)
(vlax-object-released-p vlax-string)
)

;;;(princ "\nsw 重量计算\nresw 重新计算")
;;;(princ)

bai2000 发表于 2016-1-5 12:12:52

"resw"运行不了，
加5号角钢在
((= (nth 1 guige-list) '4) (* (nth 2 guige-list) 1.75e-3))
;4号角钢10.5kg/6m
((= (nth 1 guige-list) '5) (* (nth 2 guige-list) 3.77e-3))
;5号角钢22.62kg/6m
也运行错误

mvehu 发表于 2016-1-5 13:55:42

本帖最后由 mvehu 于 2016-1-5 22:32 编辑

bai2000 发表于 2016-1-5 12:12 static/image/common/back.gif
"resw"运行不了，
加5号角钢在
((= (nth 1 guige-list) '4) (* (nth 2 guige-list) 1.75e-3))

重新修改了一下代码，把sw和resw合并成一个命令。

编辑已有算式时，输入开关 r 即可。

增加5号角钢，不仅要增加你写的代码，在函数 test-str 处也要修改一下。test-str使用正则表达式来判断输入的算式命令是否合法。开始的代码角钢只有3、4两个型号，需要增加型号5。

(defun test-str       (str)                      ;判断str是否符合特定模式
(cond
((regex-test "^\\d+-o\\d+x\\d+\\.?\\d*l\\d+$" str "ig") t)
                                    ;1-o32x1.8l2000
((regex-test "^\\d+-q\\d+\\.?\\d*l\\d+$" str "ig") t) ;24-q16l500
((regex-test "^\\d+-d\\d+x\\d+x\\d+\\.?\\d*l\\d+$" str "ig") t)
                                    ;2-d50x50x2.5l1000
((regex-test "^\\d+-j(38|50|70)l\\d+$" str "ig") t)
                                    ;1-j38|50|70l1000
((regex-test "^\\d+-i\\d+x\\d+x\\d+$" str "ig") t) ;1-i100x100x10
((regex-test "^\\d+-z\\d+(x\\d+)+l\\d+$" str "ig") t)
                                    ;2-z10x10x20x2l1000
((regex-test "^\\d+-vl\\d+$" str "ig") t) ;增加5号角钢以前的正则表达式 "^\\d+-vl\\d+$"
((= str "1-r") t)
((= str "1-e") t)                      ;结束
(t nil)))

你可以试试下面的代码。合并了sw和resw。已经增加了5号角钢。不过话说，你那里能买到国标的角钢？我的算式里3、4号角钢都是非标的。

(defun weight(density guige-list / form z-length num)
                                    ;接受密度和一个规格表 (型材类型代号规格参数... )
                                    ;计算重量
(setq form (car guige-list))             ;型材代号
(cond
((= form 'o)                      ; 空心圆环 (o 32 2 length)
(*    (/ pi 4)
   4
   (nth 2 guige-list)
   (- (nth 1 guige-list) (nth 2 guige-list))
   (nth 3 guige-list)
   density))
((= form 'q)                      ;实心圆棒 (q 32 length)
(*    (/ pi 4)
   (nth 1 guige-list)
   (nth 1 guige-list)
   (nth 2 guige-list)
   density))
((= form 'd)                      ;矩形管 (d 50 30 2 length)
(*    2
   (nth 3 guige-list)
   (+ (nth 1 guige-list)
      (nth 2 guige-list)
      (* -2 (nth 3 guige-list)))
   (nth 4 guige-list)
   density))
((= form 'j)                      ;几字钢（j 50 length)
(cond ((= (nth 1 guige-list) '38) (* (nth 2 guige-list) 1.6e-3))
                                    ;展开 130 ，1.03镀锌系数
      ((= (nth 1 guige-list) '50) (* (nth 2 guige-list) 1.94e-3))
                                    ;展开 160
      ((= (nth 1 guige-list) '70) (* (nth 2 guige-list) 2.6e-3))))
                                    ;展开 214
((= form 'i)                      ;板状物(i 边长边长厚度)
(*    (nth 1 guige-list)
   (nth 2 guige-list)
   (nth 3 guige-list)
   density))
((= form 'z)                      ; 多边折弯件 (z 边长1 边长2 ... 厚度延长)
(setq z-length 0                      ;封边各边长总长
      num 1)
(while (<= num (- (length guige-list) 3))
   (setq z-length (+ (nth num guige-list) z-length))
   (setq num (1+ num)))
(*    density
   z-length
   (nth num guige-list)             ;厚度
   (nth (1+ num) guige-list)    ;延长
   ))
((= form 'v)                      ;角钢（v 3 length)
(cond ((= (nth 1 guige-list) '3) (* (nth 2 guige-list) 1.09e-3))
                                    ;3号角钢6.5kg/6m
      ((= (nth 1 guige-list) '4) (* (nth 2 guige-list) 1.75e-3))
                                    ;4号角钢10.5kg/6m
      ((= (nth 1 guige-list) '5) (* (nth 2 guige-list) 3.77e-3))
                                    ;5号角钢22.62kg/6m
      ))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;正则表达式

(defun regex-extract(pat str key / regex S tmp str1)
;; 提取正则表达式匹配到的内容
;; pat 正则表达式 str 字符串
;; pat 中 \ 使用 \\
;; key "igm" i(Ignorecase)忽略大小写 g (Global)全局匹配 m (Multili) 多行模式
;; 注意：一般使用全局匹配 g
;; 可组合使用或单独使用或置空 ""
(vl-load-com)
(setq regex (vlax-create-object "Vbscript.RegExp"))
                                    ;引用正则表达式控件
(if (wcmatch key "*i*,*I*")
(vlax-put-property regex "IgnoreCase" 1) ;忽略大小写
(vlax-put-property regex "IgnoreCase" 0) ;不忽略大小写
)
(if (wcmatch key "*g*,*G*")
(vlax-put-property regex "Global" 1) ;匹配方式，全文字匹配
(vlax-put-property regex "Global" 0))
(if (wcmatch key "*m*,*M*")
(vlax-put-property regex "Multiline" 1) ;多行模式
(vlax-put-property regex "Multiline" 0))
(vlax-put-property regex "Pattern" pat)
(setq s (vlax-invoke-method regex "Execute" str))
;;将规则运用到STR字符，得到提取出的文字内容
(VLAX-FOR tmp       s                      ;遍历集合对象
(setq str1 (cons (vlax-get-property tmp "value") str1)))
;;将内容转换为LISP语言就可以直接观察了
(vlax-release-object regex)
(REVERSE str1))

(defun regex-test(pat str key / regex test)
;; 测试字符串str是否存在字串符合正则表达式模式pat
;; pat 正则表达式 str 字符串
;; pat 中 \ 使用 \\
;; key "igm" i(Ignorecase)忽略大小写 g (Global)全局匹配 m (Multili) 多行模式
;; 注意：一般使用全局匹配 g
;; 可组合使用或单独使用或置空 ""
(vl-load-com)
(setq regex (vlax-create-object "Vbscript.RegExp"))
                                    ;引用正则表达式控件
(if (wcmatch key "*i*,*I*")
(vlax-put-property regex "IgnoreCase" 1) ;忽略大小写
(vlax-put-property regex "IgnoreCase" 0) ;不忽略大小写
)
(if (wcmatch key "*g*,*G*")
(vlax-put-property regex "Global" 1) ;匹配方式，全文字匹配
(vlax-put-property regex "Global" 0))
(if (wcmatch key "*m*,*M*")
(vlax-put-property regex "Multiline" 1) ;多行模式
(vlax-put-property regex "Multiline" 0))
(vlax-put-property regex "Pattern" pat)
(setq    test
      (if (eq (vlax-invoke-method regex "test" str) :vlax-true)
      t
      nil))
(vlax-release-object regex)
test)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun test-str       (str)                      ;判断str是否符合特定模式
(cond
((regex-test "^\\d+-o\\d+x\\d+\\.?\\d*l\\d+$" str "ig") t)
                                    ;1-o32x1.8l2000
((regex-test "^\\d+-q\\d+\\.?\\d*l\\d+$" str "ig") t) ;24-q16l500
((regex-test "^\\d+-d\\d+x\\d+x\\d+\\.?\\d*l\\d+$" str "ig") t)
                                    ;2-d50x50x2.5l1000
((regex-test "^\\d+-j(38|50|70)l\\d+$" str "ig") t)
                                    ;1-j38|50|70l1000
((regex-test "^\\d+-i\\d+x\\d+x\\d+$" str "ig") t) ;1-i100x100x10
((regex-test "^\\d+-z\\d+(x\\d+)+l\\d+$" str "ig") t)
                                    ;2-z10x10x20x2l1000
((regex-test "^\\d+-vl\\d+$" str "ig") t) ;24-v3|4|5l500
((= str "1-r") t)
((= str "1-e") t)                      ;结束
(t nil)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun parsel(str delim / LST POS)
;;字符串分割 delim是用来分割的字符
(setq lst nil)
(while (setq pos (vl-string-search delim str))
(setq lst (cons (substr str 1 pos) lst)
      str (substr str (+ pos 2))))
(if (> (strlen str) 0)
(setq lst (cons str lst)))
(reverse lst))

(defun add1-(str)                      ;辅助函数如果字符串中不含"-"，则在开头添加"1-"
(if (not (vl-string-position (ascii "-") str))
(strcat "1-" str)
str))

(defun str->weight(str-n    /       density str->list
                  number    guige-list str-weight canshu
                  form)             ;从字符串计算重量列表
                                    ;返回一个列表 (字符串：数量-类型-单重-总重总重）
(setq density 7.85e-6)             ;钢材密度
(setq    str->list
      (read
      (strcat
         "("                      ;将字符串str-n分解成各参数的列表
         (vl-string-translate
            "-xXLl"                      ;参数分割字符集 -xl
            " "
            (strcat
            (substr
               str-n
               1
               (+ 2
                  (vl-string-position (ascii "-") str-n)))
            "-"
            (substr
               str-n
               (+ 3
                  (vl-string-position (ascii "-") str-n)))))
         ")")))
(setq    number       (car str->list)    ; 该类型钢材数量
   guige-list (cdr str->list)    ;该类型钢材重量计算的规格表
   str-weight (weight density guige-list) ;钢材重量
   canshu       (strcase
                  (substr str-n
                        (+ 3 (vl-string-position (ascii "-") str-n)))))
                                    ;规格表转换大写
(setq form (cadr str->list))
(cond    ((= form 'o) (setq form "圆钢管%%C"))
   ((= form 'q) (setq form "圆钢%%C"))
   ((= form 'd) (setq form "钢矩管D"))
   ((= form 'j) (setq form "几字钢J"))
   ((= form 'i) (setq form "钢板I"))
   ((= form 'z) (setq form "折弯件Z"))
   ((= form 'v) (setq form "角钢V")))
(list    (strcat    (rtos (nth 0 str->list))
            "个"
            form
            canshu
            ",单重："
            (rtos str-weight 2 3)
            "kg"
            ",总重： "
            (rtos (* str-weight number) 2 3)
            "kg。")
   (* str-weight number)))

(defun c:sw(/       str    weight-sum
         num          str-str-sum       point             text-size
         text-edit          vlax-string       string    text-weight
         str->weight-list)
(princ "语法：[<number>-]<form><n>x<n>...")
(princ
"\n<number>数量；<form>类型：实心圆棒q 空心圆环o 方管d 几字钢j 钢板i 折弯件z 角钢v <length>长度")
(princ
"\n例子：实心圆棒q16l500空心圆环2-o32x1.8l1000 方管3-d50x50x2l1500 \n
几字钢1-j38|50|70l1000 钢板i-100x100x8 折弯件z30x30x2l1000 角钢v3|4l500")
(setq    weight-sum 0
   str-str-sum "")
(while (progn    (while (not (test-str (setq str
                                          (add1-
                                          (getstring
                                             "\n输入计算表达式[圆管O|圆钢Q|矩管D|几字钢J|钢板I|折弯Z|角钢V]：")))))
               (princ "\n输入语法有误，请重新输入"))
            (if (not (= str "1-e"))
               t))
(if    (not (= str "1-r"))
   (progn (setq str->weight-list (str->weight str))
         (setq weight-sum(+ weight-sum (cadr str->weight-list))
               str-str-sum (strcat str-str-sum
                                    (car str->weight-list)
                                    "\\P"))
         (princ (strcat (car str->weight-list)
                        "=>以上重量加总"
                        (rtos weight-sum 2 3)
                        "kg"))))
(if    (= str "1-r")
   (progn
   (setq text-edit t) ;设置标志位，重新编辑已有算式
   (VL-LOAD-COM)
   (setq vlax-string
            (vlax-ename->vla-object
            (car (entsel "请选择算式:")))) ;已有文本的vlax对象
   (setq string (vlax-get-property vlax-string "TextString"))
   (defun string-trim(string / str s tmp) ;字符串重新格式化函数
      (setq    str
            (regex-extract "(^|\\\\P)[^,]+(?=,)" string "igm"))
      (defun trim(str)
         (setq str (vl-string-subst "" "\\P" str))
         (setq str (vl-string-subst "-o" "个圆钢管%%C" str))
         (setq str (vl-string-subst "-d" "个钢矩管D" str))
         (setq str (vl-string-subst "-i" "个钢板I" str))
         (setq str (vl-string-subst "-j" "个几字钢J" str))
         (setq str (vl-string-subst "-z" "个折弯件Z" str))
         (setq str (vl-string-subst "-v" "个角钢V" str))
         (setq str (vl-string-subst "-q" "个圆钢%%C" str)))
      (setq tmp nil)
      (foreach s str (setq tmp (cons (trim s) tmp)))
      (reverse tmp))
   (setq string (string-trim string))
   (setq text-weight (mapcar 'str->weight string))
   (setq num 0
         weight-sum 0)
   (repeat    (length text-weight)    ;计算已有算式的总重
      (setq    weight-sum
            (+ (cadr (nth num text-weight)) weight-sum))
      (setq num (1+ num)))
   (setq str-str-sum "")             ;计算已有算式的字符串说明汇总
   (repeat    (length text-weight)
      (setq    str-str-sum
            (strcat str-str-sum
                     (caar text-weight)
                     "\\P"))
      (setq text-weight (cdr text-weight)))
   (princ str-str-sum)
   (princ (strcat "=>以上重量加总" (rtos weight-sum 2 3) "kg")))))
(if text-edit
(progn (setq str-str-sum
               (strcat str-str-sum
                     "----------------\\P总重："
                     (rtos weight-sum 2 3)
                     "kg"))
      (vlax-put-property vlax-string "TextString" str-str-sum)
      (vlax-object-released-p vlax-string)
      (setq text-edit nil))
(progn
   (if
   (not
      (=
         (getstring "是否将计算结果写入文档(n不写入)<默认写入>:")
         "n"))
      (progn    (setq str-str-sum
                  (strcat str-str-sum
                           "----------------\\P总重："
                           (rtos weight-sum 2 3)
                           "kg"))
            (setq point (getpoint "输入文字起始位置"))
            (setq text-size             ;当前字体高度
                  (cdr
                     (assoc
                        40
                        (entget (tblobjname "style" (getvar "textstyle"))))))
            (command "mtext"
                     point
                     (polar point -0.1 (* 45 text-size))
                                    ; 设置多行文字宽度字体高度的45倍
                     str-str-sum
                     ""))))))

(princ "\n启动命令 sw")

mvehu 发表于 2016-1-5 22:41:00

本帖最后由 mvehu 于 2016-1-6 09:27 编辑

前面 lucas_3333 网友说使用对话框会更加直观。

直观也许是有，但是熟悉型材代码后，速度绝对没有键盘输入快。

而且，命令行输入，理论上可输入的型材数量只受内存限制。而对话框就没这么方便了。

比如一个焊件，用了两种乃至三种规格的矩管，命令行上无非是输入两行或三行命令，对话框又如何容纳处理这种输入呢？

mhx999 发表于 2016-1-5 23:23:50

使用对话框和不使用对话框应该说各有优点，前者更加直观，后者熟练后会快一些，
看过院长@xyp1964的演示，几乎都是对话框，

mvehu 发表于 2016-1-8 10:45:14

本帖最后由 mvehu 于 2016-1-8 11:18 编辑

bai2000 发表于 2016-1-3 21:30 static/image/common/back.gif
X 能改为*么？不符合输入数字的习惯
同时把工字钢、槽钢加进去？
在标准键盘上试了试，输入*要比x方便。代码改了下，同时支持“*xl”三种分隔符。

同时钢板代码由i改成b。

bai2000 发表于 2016-1-9 20:25:09

谢楼主。改后程序好用多了，如果吧槽钢也加进去怎么做？，举个例子（8号槽钢米重8.03,10号槽钢米重10.00）

页: [1] 2

明经CAD社区's Archiver

简易钢材重量计算