[必看]：计算钢筋工程量必看！！！

linps

对你可能有用！！！！！！！！

它山之石

附带一个AUTOCAD 下用的LISP计算程序js.lsp请享用!

此程序用来计算工程数量表中的计算和合计数量.

使用方法:1.先在AUTOCAD下加载js.lsp程序.
        2.在下COMMAND下执行js
        3.窗口选择第一列数据(如钢筋长度)
        4.窗口选择第二列数据(如每米重)
        5.给定一个基点
        6.输入系数和小数点位数
        回车后计算结果就出来了,并直接写在图纸上了.
        如果只选第一个框,出来的结果就是整个框中的合计数量了.
  
      My Email:tyy.lilin@sohu.com

天堂烈车

看了,很有用,谢谢分享,就是使用起来很复杂,希望会有更简单方法

chern0228

看了,很有用,谢谢分享,就是使用起来很复杂,希望会有更简单方法

monkey12

非常感谢楼主分享!!先试一下

zexib

先看看先哈.先谢谢!

anchor631

不会用啊，能不能说详细点，这个工具是不是主要算你自己选去数字的总和？然后乘系数。

chgj19842003

用过了  还可以
谢谢

bridgewind

不错，直接贴出吧：
(defun *error* (ERROR)
     (princ "error:")
     (princ "CAO ZUO ERROE")
     (PRINC "\n please try a time")
     )
(defun getss(/ SS N I NAME0 NAME X0 X1)
     (INITGET (+ 1 2 4))
     (setq ss (ssget '((0 . "TEXT"))))
     (if (= ss nil) (setq ss (ssadd)))
     (setq ssa (ssadd))
     (while (/= (setq n (sslength ss)) 0)
            (progn
            (setq i 1)
            (setq name0 (ssname ss 0))
            (setq x0 (caddr (assoc 10 (entget name0))))
            (while (< i n)
                  (progn
                  (setq name (ssname ss i))
                  (setq X1 (caddr (assoc 10 (entget name))))
                  (if (< X0 X1)
                       (progn
                       (setq name0 name)
                       (setq  X0  X1)
                  ))
                  (setq i (+ 1 i))
              ))
              (setq ssa (ssadd name0 ssa))      
              (setq ss (ssdel name0 ss))
       ))
       )

(DEFUN C:JS(/  NN II ENT NAME TXT PP P0 PP0 NAME1
              P ST ZH ZW ANG I N W TEMP)
     (SETVAR "BLIPMODE" 1)
     (SETVAR "CMDECHO" 0)
     (PROMPT "\n    FIRST-SSGET:")
     (INITGET (+ 1 2 4))
     (getss)
     (SETQ SS1 ssa)
     (PROMPT "\n    SECOND-SSGET:")
     (getss)
     (SETQ SS2 ssa)
     
     (INITGET (+ 1 2 4))
     (IF (= (SSLENGTH SS2) 0)
         (SETQ JSF (GETSTRING "\n    JI SUAN FU:?<+>  "))
         (SETQ JSF (GETSTRING "\n    JI SUAN FU:?<*>  ")))
     (WHILE (AND (/= JSF "+") (/= JSF "-") (/= JSF "*") (/= JSF "/") (/= JSF ""))
            (GETSTRING "\n    JI SUAN FU:?<*>  "))
     (IF (AND (= (SSLENGTH SS2) 0) (= JSF "")) (SETQ JSF "+"))
     (IF (AND (/= (SSLENGTH SS2) 0) (= JSF "")) (SETQ JSF "*"))
     
     (SETQ P0 (CDR (ASSOC 10 (ENTGET (SSNAME SS1 0)))))
     (INITGET (+ 1 2 4))
     (SETQ PP0 (GETPOINT "\n    TEXT-POINT:?"))
     (SETVAR "BLIPMODE" 0)
     (IF (= (SSLENGTH SS2) 0)            
           (PROGN
                 (SETQ XI (GETREAL "\n   XU CHU DE XI SHU [/] :?<1>"))           
                 (IF (= XI NIL) (SETQ XI 1)))
           (PROGN
                 (SETQ XI (GETREAL "\n   XU CHU DE XI SHU [/]:? <100>"))
                 (IF (= XI NIL) (SETQ XI 100))
            ))

     (SETQ WS (GETINT "\n    XIAO SHU WEI:?<2> "))
     (IF (= WS NIL) (SETQ WS 2))
     (SETQ NN1 (SSLENGTH SS1))
     (SETQ II 0)
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     (IF (= (SSLENGTH SS2) 0)(PROGN
         (WHILE (< II NN1)
           (SETQ ENT1 (ENTGET (SETQ NAME1 (SSNAME SS1 II))))
           (IF (= II 0) (SETQ NAME0 NAME1))
           (SETQ TXT1 (CDR (ASSOC 1 ENT1)))
           (SETQ TXT1 (ATOF TXT1))
           (IF (= II 0) (SETQ TXT TXT1))
           (IF (/= II 0) (PROGN
             (COND ((= JSF "+") (SETQ TXT (+ TXT TXT1)))
                   ((= JSF "-") (SETQ TXT (- TXT TXT1)))
                   ((= JSF "*") (SETQ TXT (* TXT TXT1)))     
                   ((= JSF "/") (SETQ TXT (/ TXT TXT1)))
                   )
            ))
        (SETQ II (+ II 1))
        )
        (COMMAND "COPY" NAME0 "" P0 PP0)
        (SETQ TXT (/ TXT XI))
        (SETQ TXT (RTOS TXT 2 WS))
         (setq txt-style (cdr (assoc 7 (entget name0))))
         (setq style-higth (cdr (assoc 40 (tblsearch "style" txt-style))))
         (if (= style-higth 0.0)
            (COMMAND "CHANGE" "L" "" "" "" "" "" "" TXT )
            (command "change" "l" "" "" "" "" "" txt))
        ))
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     (IF (AND (/= SS2 NIL) (/= SS1 NIL)) (PROGN
       (SETQ NN2 (SSLENGTH SS2))
       (IF (>= NN1 NN2) (SETQ NN NN2) (SETQ NN NN1))
       (WHILE (< II NN)
           (SETQ ENT1 (ENTGET (SETQ NAME1 (SSNAME SS1 II))))
           (SETQ ENT2 (ENTGET (SETQ NAME2 (SSNAME SS2 II))))
           (SETQ TXT1 (CDR (ASSOC 1 ENT1)))
           (SETQ TXT2 (CDR (ASSOC 1 ENT2)))
           (SETQ TXT1 (ATOF TXT1))
           (SETQ TXT2 (ATOF TXT2))
           (COND ((= JSF "+") (SETQ TXT (+ TXT1 TXT2)))
                   ((= JSF "-") (SETQ TXT (- TXT1 TXT2)))
                   ((= JSF "*") (SETQ TXT (* TXT1 TXT2)))     
                   ((= JSF "/") (SETQ TXT (/ TXT1 TXT2)))
                   )
           (COMMAND "COPY" NAME1 "" P0 PP0)
           (SETQ TXT (/ TXT XI))
           (SETQ TXT (RTOS TXT 2 WS))
           (setq txt-style (cdr (assoc 7 (entget name1))))
           (setq style-higth (cdr (assoc 40 (tblsearch "style" txt-style))))
           (if (= style-higth 0.0)
            (COMMAND "CHANGE" "L" "" "" "" "" "" "" TXT )
            (command "change" "l" "" "" "" "" "" txt))
           (SETQ II (+ II 1))
           )
         ))
       (SETVAR "BLIPMODE" 1)
       (SETVAR "CMDECHO" 1)
       (PRINC)
           )
(DEFUN C:TCH(/ SS NN II ENT NAME TXT PP0 P0 P XI JSF WS)
     (SETVAR "BLIPMODE" 1)
     (SETVAR "CMDECHO" 0)
     (INITGET (+ 1 2 4))
     (GETSS)
     (SETQ SS SSA)
     (INITGET (+ 1 2 4))
     (SETQ JSF (GETSTRING "\n   JI SUAN FU:?<*>  "))
     (WHILE (AND (/= JSF "+") (/= JSF "-") (/= JSF "*") (/= JSF "/") (/= JSF ""))
            (GETSTRING "JI SUAN FU:?<*>  "))
     (IF (= JSF "") (SETQ JSF "*"))
     (SETQ XI (GETREAL "\n  XI SHU:?"))
     (SETQ P0 (CDR (ASSOC 10 (ENTGET (SSNAME SS 0)))))
     (SETVAR "BLIPMODE" 1)
     (INITGET (+ 1 2 4))
     (SETQ PP0 (GETPOINT "\n  TEXT-POINT:?"))
     (SETVAR "BLIPMODE" 0)
     (SETQ WS (GETINT "\n  XIAO SHU WEI:?<1> "))
     (IF (= WS NIL) (SETQ WS 1))
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     (SETQ NN (SSLENGTH SS))
     (SETQ II 0)
     (WHILE (< II NN)
           (SETQ ENT (ENTGET (SETQ NAME (SSNAME SS II))))
           (SETQ TXT (CDR (ASSOC 1 ENT)))
           (SETQ TXT (ATOF TXT))
           (COND ((= JSF "+") (SETQ TXT (+ TXT XI)))
                 ((= JSF "-") (SETQ TXT (- TXT XI)))
                 ((= JSF "*") (SETQ TXT (* TXT XI)))     
                 ((= JSF "/") (SETQ TXT (/ TXT XI)))
                   )
           (COMMAND "COPY" NAME "" P0  PP0)
           (SETQ TXT (RTOS TXT 2 WS))
           (setq txt-style (cdr (assoc 7 (entget name))))
           (setq style-higth (cdr (assoc 40 (tblsearch "style" txt-style))))
           (if (= style-higth 0.0)
            (COMMAND "CHANGE" "L" "" "" "" "" "" "" TXT )
            (command "change" "l" "" "" "" "" "" txt))
           (SETQ II (+ II 1))
           )
       (SETVAR "BLIPMODE" 1)
       (SETVAR "CMDECHO" 1)
       (PRINC)
           )
(DEFUN C:HZZ(/  NN II ENT NAME TXT PP P0 PP0 NAME1
              P ST ZH ZW ANG I N W TEMP)
     (SETVAR "BLIPMODE" 1)
     (SETVAR "CMDECHO" 0)
     (PROMPT "\n    FIRST-SSGET:")
     (INITGET (+ 1 2 4))
     (getss)
     (SETQ SS1 ssa)
     (PROMPT "\n    SECOND-SSGET:")
     (getss)
     (SETQ SS2 ssa)
     
     (SETQ P0 (CDR (ASSOC 10 (ENTGET (SETQ NAME0 (SSNAME SS1 0))))))
     (INITGET (+ 1 2 4))
     (SETQ PP0 (GETPOINT "\n    TEXT-POINT:?"))
     
     (INITGET(+ 1 2 4))
     (SETQ XI (GETREAL "\n   HUI ZONG GAN JIN-- DAN WEI ZHONG:? <0.888>"))
     (IF (= XI NIL) (SETQ XI 0.888))

     (SETVAR "BLIPMODE" 0)
     (SETQ WS (GETINT "\n    XIAO SHU WEI:?<2> "))
     (IF (= WS NIL) (SETQ WS 2))
     
     (SETQ NN1 (SSLENGTH SS1))
     (SETQ II 0)
     (SETQ TXT 0)
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     (IF (AND (/= SS2 NIL) (/= SS1 NIL)) (PROGN
       (SETQ NN2 (SSLENGTH SS2))
       (IF (>= NN1 NN2) (SETQ NN NN2) (SETQ NN NN1))
       (WHILE (< II NN)
           (SETQ ENT1 (ENTGET (SETQ NAME1 (SSNAME SS1 II))))
           (SETQ ENT2 (ENTGET (SETQ NAME2 (SSNAME SS2 II))))
           (SETQ TXT1 (CDR (ASSOC 1 ENT1)))
           (SETQ TXT2 (CDR (ASSOC 1 ENT2)))
           (SETQ TXT1 (ATOF TXT1))
           (SETQ TXT2 (ATOF TXT2))
           (IF (= TXT1 XI) (SETQ TXT (+ TXT TXT2)))
           (SETQ II (+ II 1))
           )
         ))
        (COMMAND "COPY" NAME0 "" P0 PP0)
        (SETQ TXT (RTOS TXT 2 WS))
           (setq txt-style (cdr (assoc 7 (entget name0))))
           (setq style-higth (cdr (assoc 40 (tblsearch "style" txt-style))))
           (if (= style-higth 0.0)
            (COMMAND "CHANGE" "L" "" "" "" "" "" "" TXT )
            (command "change" "l" "" "" "" "" "" txt))

       (SETVAR "BLIPMODE" 1)
       (SETVAR "CMDECHO" 1)
       (PRINC)
           )

wwddzz

看了,很有用,谢谢分享！

zood50

看了,很有用,谢谢分享