简易钢材重量计算

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

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

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

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

<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+-v[34]l\\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>...[l<length>] [<number>-]<form><n>x<n>...[l<length>]"
)
(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][e结束计算]："
)
)
)
)
)
(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
""
)
)
)
)

(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+-v[34]l\\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>...[l<length>] [<number>-]<form><n>x<n>...[l<length>]" 
    ) 
  (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][e结束计算]：" 
                              ) 
                            ) 
                 ) 
               ) 
             ) 
        (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 
                     "" 
                     ) 
            ) 
     ) 
  )

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

简易钢材重量计算

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

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

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

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

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

bai2000 发表于 2016-1-3 21:30
X 能改为*么？不符合输入数字的习惯
同时把工字钢、槽钢加进去？

在笔记本电脑小键盘上，输入* 需要同时按两个键，而输入字母x只需要按一个键，比较方便。当然，如果修改成*，改代码也不难。你可以自己试试。

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

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

本帖最后由 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+-v[34]l\\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>...[l<length>]")
(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][e结束计算]："
)
)
)
)
)
(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+-v[34]l\\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][e结束计算]："
)
)
)
)
)
(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)

(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+-v[34]l\\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>...[l<length>]") 
  (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][e结束计算]：" 
                                                 ) 
                                               ) 
                                            ) 
                                      ) 
                            ) 
                  (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+-v[34]l\\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][e结束计算]：" 
                                                 ) 
                                               ) 
                                            ) 
                                      ) 
                            ) 
                  (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

"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

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

bai2000 发表于 2016-1-5 12:12
"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+-v[345]l\\d+$" str "ig") t) ;  增加5号角钢以前的正则表达式 "^\\d+-v[34]l\\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+-v[345]l\\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>...[l<length>]")
(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][e结束计算][r重算算式]：")))))
(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")

(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+-v[345]l\\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>...[l<length>]") 
  (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][e结束计算][r重算算式]："))))) 
                  (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

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

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

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

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

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

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

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

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

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

bai2000 发表于 2016-1-3 21:30
X 能改为*么？不符合输入数字的习惯
同时把工字钢、槽钢加进去？

在标准键盘上试了试，输入*要比x方便。代码改了下，同时支持“*xl”三种分隔符。

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

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

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

账号		自动登录	找回密码
密码			注册

[源码] 简易钢材重量计算

本帖子中包含更多资源

评分

相关帖子

本帖子中包含更多资源

评分

本帖子中包含更多资源

本帖子中包含更多资源

浏览过的版块