[编程申请]：钢筋统计

echoroseluo · 发表于 2003-8-29 13:24:59

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

*-*b
准备写一个钢筋数量统计的程序，有什么好的建议

coolzhb · 发表于 2003-8-29 13:26:19

最初由 echoroseluo 发布
[B]*-*b
准备写一个钢筋数量统计的程序，有什么好的建议 [/B]

这个程序想实现什么作用，我们现在一般出图都不出钢筋表了。

echoroseluo · 发表于 2003-8-29 13:41:40

出钢筋图时，我们还要求做钢筋统计，其实我也不知道有什么用，可能方便计算工程量

xiaos · 发表于 2003-8-29 13:54:12

我也不知道

lt_zzy · 发表于 2003-8-29 14:00:42

我感觉要能够对钢筋进行动态的操作，可能统计出一级钢筋，二级钢筋的数量。能够对钢筋进行标注，能够自动计算钢筋的总长度。

coolzhb · 发表于 2003-8-29 14:05:35

最初由 lt_zzy 发布
[B]我感觉要能够对钢筋进行动态的操作，可能统计出一级钢筋，二级钢筋的数量。能够对钢筋进行标注，能够自动计算钢筋的总长度。 [/B]

我在这里好像看到了一个lisp，名字叫:ca.lsp，搜索一下

echoroseluo · 发表于 2003-8-29 14:11:54

关键是要能统计出不同直径、形式的钢筋数量和长度，这两样东西统计出来后，钢筋的重量就比较好做了

lt_zzy · 发表于 2003-8-29 14:22:16

最初由 coolzhb 发布
[B]

我在这里好像看到了一个lisp，名... [/B]

我找到了，但是已经提示附件已经过期了，不知道那一位朋友有。请提示一下，谢谢！

<table border="1" cellpadding="0" cellspacing="0" style="border-collapse: collapse" bordercolor="#111111" width="700" id="AutoNumber1" height="498">
<tr>
<td width="100%" height="489">
<iframe name="I1" width="100%" height="100%" src="http://www.xdcad.net/forum/showthread.php?s=&postid=10244#post10244">
浏览器不支持嵌入式框架或配置为不显示嵌入式框架
</iframe>
</td>
</tr>
</table>

复制代码

coolzhb · 发表于 2003-8-29 14:46:18

我有的，贴一个给大家看看！

[FONT=courier new]
;;钢筋表计算程序，版本：4.12。
;;输入直径、单根长、根数。钢筋直径可用"%%c32、%%13132、f32"等形式，长度及根数可输入简单四则运算
;;符号，如"30*(22+3)、30x3X4"形式，可用"X"或"x"代替"*"，但不可用中文符号。
;;命令：ＣＡ -- 计算钢筋表。
;;命令：ＤＴＷ -- 由直径计算单位重。
;;命令：ＣＡＴ -- 计算钢筋总重。
;;命令：ＣＡＳ -- 统计钢筋长度或重量。
;;自由软件，欢迎复制、修改。作者：南京市市政设计研究院嵇龙(ll_j@21cn.com)
;; 025－3283626
(defun newerr(s)
(if (= s "Function cancelled")
(progn
(setq *error* olderr)
(if oldsnp (setvar "osmode" oldsnp))
(if oldzin (setvar "dimzin" oldzin))
)
)
(princ)
)
(defun ca_main()
(princ (strcat "\n\n当前为" ca:row "列模式; 长度单位 " ca:c_m "；列间距 " (rtos ca:h_ 2 1) "; 文本字高 " (rtos ca:hh 2 2) "; 对齐方式 " ca:jm "。\n"))
(initget 1 "U N C F H J")
(setq pt1 (getpoint (strcat "列数N/单位U/变更列间距C/自由列间距F/文本字高H/对齐方式J/<给出钢筋总长" ca:jm "对齐点>: ")))
(cond
((= pt1 "U")
(if (= ca:c_m "cm") (setq ca:c_m "mm" ca:cmm 0.001) (setq ca:c_m "cm" ca:cmm 0.01))
(ca_main)
)
((= pt1 "N")
(if (= ca:r_w 3) (setq ca:r_w 2 ca:row "二") (setq ca:r_w 3 ca:row "三"))
(ca_main)
)
((= pt1 "C")
(setq c (getdist (strcat "\n给定列间距< " (rtos ca:h_ 2 1)" >: ")))
(if (/= c nil) (setq ca:h_ c))
(ca_main)
)
((= pt1 "F")
(setq n6_ 0)
(if (= ca:r_w 3)
(progn
(initget 1)
(setq ptx1 (car (getpoint (strcat "\n给出钢筋总长" ca:jm "对齐点: "))))
(initget 1)
(setq ptx2 (car (getpoint (strcat "\n给出钢筋单位重" ca:jm "对齐点: "))))
(initget 1)
(setq ptx3 (car (getpoint (strcat "\n给出钢筋总重" ca:jm "对齐点: "))))
)
(progn
(initget 1)
(setq ptx1 (car (getpoint (strcat "\n给出钢筋总长" ca:jm "对齐点: "))))
(initget 1)
(setq ptx3 (car (getpoint (strcat "\n给出钢筋总重" ca:jm "对齐点: "))))
)
)
)
((= pt1 "H")
(setq c (getdist (strcat "\n给定字高< " (rtos ca:hh 2 2)" >: ")))
(if (/= c nil) (progn (setq ca:hh c) (setvar "textsize" c)))
(ca_main)
)
((= pt1 "J")
(setq ca:j_m (rem (1+ ca:j_m) 3))
(cond
((= ca:j_m 0) (setq ca:jm "左"))
((= ca:j_m 1) (setq ca:jm "中"))
((= ca:j_m 2) (setq ca:jm "右"))
(t nil)
)
(ca_main)
)
(t
(setq n6_ 0)
(if (= ca:r_w 3)
(setq ptx1 (car pt1)
ptx2 (+ ptx1 (* 0.95 ca:h_))
ptx3 (+ ptx1 (* 2.0 ca:h_))
)
(setq ptx1 (car pt1)
ptx3 (+ ptx1 (* 1.0 ca:h_))
)
)
)
)
(while (> l1 0)
(ca_smax se1 l1)
(setq e01 e20 n1 (atof (ca_f (cdr (assoc 1 e01)))) se1 se0)
(if (not ca:r) (setq ca:r (assoc 50 e01)))
(ca_smax se2 l1)
(setq e02 e20 n2 (ca_n (cdr (assoc 1 e02))) se2 se0)
(ca_smax se3 l1)
(setq e03 e20 n3 (ca_n (cdr (assoc 1 e03))) se3 se0)
(setq l1 (sslength se1)
y (/ (+ (caddr(ca_trans 10 e01)) (caddr(ca_trans 10 e02))
(caddr(ca_trans 10 e03))) 3)
)
(setq pt1(list ptx1 y 0)
pt2(list ptx2 y 0)
pt3(list ptx3 y 0)
)
(setq n4 (rtos (* n3 n2 ca:cmm) 2 2)
n5 (rtos (* pi n1 n1 0.0019625) 2 3)
n6 (rtos (* (atof n5) (atof n4)) 2 2)
n6_(+ n6_ (atof n6))
)
(ca_mktext n4 (trans pt1 1 0))
(if (= ca:r_w 3) (ca_mktext n5 (trans pt2 1 0)))
(ca_mktext n6 (trans pt3 1 0))
)
)
(defun ca_prw(/ p_w)
(setq pt (getpoint (strcat "\n合计钢筋总重" ca:jm "对齐点: ")))
(if (/= pt nil)
(ca_mktext (rtos n6_ 2 2) (trans pt 1 0))
(progn
(initget "Yes No")
(setq p_w (getkword "\n取消合计总重？ Yes or <No>?"))
(if (/= p_w "Yes")
(ca_prw)
)
)
)
)
(defun ca_trans(n ens)
(cons n (trans (cdr (assoc n ens)) 0 1))
)
(defun ca_f(e1)
(cond
((and (> (ascii e1) 48)(<= (ascii e1) 57)) e1)
((= (ascii e1) 37)
(setq e1(substr e1 3))
(cond
((= (ascii e1) 49) (setq e1 (substr e1 4)))
(t (setq e1 (substr e1 2)))
)
)
(t (setq e1 (substr e1 2)))
)
(eval e1)
)
(defun ca_n(e1 / t1 nt nt1)
(setq nt "" nt1 "")
(while (/= e1 "")
(setq t1 (substr e1 1 1) e1 (substr e1 2))
(if (or (= t1 ".") (and (>= (ascii t1) 48) (<= (ascii t1) 57)))
(setq nt1 (strcat nt1 t1))
(progn
(if (or (= t1 "x") (= t1 "X")) (setq t1 "*"))
(cond
((= (ascii nt1) 46) (setq nt1 (strcat "0" nt1)))
((= (type (read nt1)) 'INT) (setq nt1 (strcat nt1 ".0")))
(t nil)
)
(setq nt (strcat nt nt1 t1) nt1 "")
)
)
)
(if (/= nt1 "")
(progn
(cond
((= (ascii nt1) 46) (setq nt1 (strcat "0" nt1)))
((= (type (read nt1)) 'INT) (setq nt1 (strcat nt1 ".0")))
(t nil)
)
(setq nt (strcat nt nt1))
)
(setq nt (strcat nt nt1))
)
(setq e1 (c:cal nt))
)
(defun ca_smax(se l_ / e10 y0 i e1 e2 yi y0)
(setq e10 (ssname se 0)
e20 (entget e10)
y0 (caddr(assoc 10 e20))
i 0 se0 (ssadd)
)
(if (/= l_ 1)
(repeat (- l_ 1)
(setq i (+ i 1)
e1 (ssname se i)
e2 (entget e1)
yi (caddr(assoc 10 e2))
)
(if (> yi y0)
(progn (ssadd e10 se0) (setq e20 e2 y0 yi e10 e1))
(ssadd e1 se0)
)
)
)
)
(defun ca_mktext(str pt10 / sty)
(entmake
(list
'(0 . "TEXT")
(cons 1 str)
(cons 10 pt10)
(cons 11 pt10)
(cons 7 (setq sty (getvar "textstyle")))
(cons 40 ca:hh)
ca:r
(assoc 41 (tblsearch "style" sty))
(cons 51 (cdr (assoc 50 (tblsearch "style" sty))))
'(71 . 0)
(cons 72 ca:j_m)
; (cons 73 :j2)
)
)
)
(defun ca_dw()
(princ (strcat "\n当前文本字高 " (rtos ca:hh 2 2) "; 对齐方式 " ca:jm ".\n"))
(initget 1 "H J")
(setq pt1 (getpoint (strcat "\n文本字高H/对齐方式J/<给出钢筋" t1 ca:jm "对齐点: >")))
(cond
((= pt1 "H")
(setq c (getdist (strcat "\n给定字高< " (rtos ca:hh 2 2)" >: ")))
(if (/= c nil) (progn (setq ca:hh c) (setvar "textsize" c)))
(ca_dw)
)
((= pt1 "J")
(setq ca:j_m (rem (1+ ca:j_m) 3))
(cond
((= ca:j_m 0) (setq ca:jm "左"))
((= ca:j_m 1) (setq ca:jm "中"))
((= ca:j_m 2) (setq ca:jm "右"))
(t nil)
)
(ca_dw)
)
(t nil)
)
)
(defun cas_main ()
(princ (strcat "\n\n输出行间距 " (rtos ca:l_ 2 1) "；列间距 " (rtos ca:h_ 2 1)
"; 文本字高 " (rtos ca:hh 2 2) "。\n"))
(initget 1 "L C H")
(setq pt1 (getpoint (strcat "行间距L/列间距C/文本字高H/<给出输出基点>: ")))
(cond
((= pt1 "L")
(setq c (getdist (strcat "\n给定行间距< " (rtos ca:l_ 2 1) " >: ")))
(if (/= c nil) (setq ca:l_ c))
(cas_main)
)
((= pt1 "C")
(setq c (getdist (strcat "\n给定列间距< " (rtos ca:h_ 2 1) " >: ")))
(if (/= c nil) (setq ca:h_ c))
(cas_main)
)
((= pt1 "H")
(setq c (getdist (strcat "\n给定字高< " (rtos ca:hh 2 2) " >: ")))
(if (/= c nil) (progn (setq ca:hh c) (setvar "textsize" c)))
(cas_main)
)
(t
(while (> l1 0)
(ca_smax se1 l1)
(setq e01 e20
n1 (ca_f (cdr (assoc 1 e01)))
se1 se0
)
(if (not ca:r)
(setq ca:r (assoc 50 e01))
)
(ca_smax se2 l1)
(setq e02 e20
n2 (ca_n (cdr (assoc 1 e02)))
se2 se0
)
(setq l1 (sslength se1)
l0 (length cas:b)
i 0
ii 0
)
(if (> l0 0)
(progn
(repeat l0
(setq b0 (nth i cas:b))
(if (= (car b0) n1)
(setq n2 (+ n2 (cadr b0))
cas:b (subst (list n1 n2) b0 cas:b)
i (1+ i)
ii 1
)
(setq i (1+ i))
)
)
(if (= ii 0)
(setq cas:b (reverse (cons (list n1 n2) (reverse cas:b))))
)
)
(setq cas:b (cons (list n1 n2) cas:b))
)
)
(setq l0 (length cas:b)
i 0
pt1x (car pt1)
pt1y (cadr pt1)
pt2x (+ pt1x ca:h_)
)
(repeat l0
(setq pt1 (list pt1x (- pt1y (* i ca:l_)) 0)
pt2 (list pt2x (- pt1y (* i ca:l_)) 0)
n1 (- (apply 'min (mapcar 'atof (mapcar 'car cas:b))) 1)
n2 (apply 'max (mapcar 'atof (mapcar 'car cas:b)))
j (- l0 (length (member n2 (mapcar 'atof (mapcar 'car cas:b)))))
str1 (car (nth j cas:b))
str2 (rtos (cadr (nth j cas:b)) 2 2)
cas:b(subst (cons (rtos n1 2 0) (cadr (nth j cas:b))) (nth j cas:b) cas:b)
i (1+ i)
)
(ca_mktext str1 (trans pt1 1 0))
(ca_mktext str2 (trans pt2 1 0))
)
)
)
(princ)
)
(defun c:dtw(/ se1 se0 l1 pt1 e01 e02 y n1 e20 t1 olderr ca:r n ens oldsnp oldzin)
(command "color" (getvar "cecolor"))
(setq olderr *error*)
(setq oldsnp (getvar "osmode"))
(setq oldzin (getvar "dimzin"))
(setvar "osmode" 0)
(setvar "dimzin" 0)
(setq *error* newerr)
(princ "\n拾取钢筋直径:")
(setq se1 (ssget '((0 . "TEXT"))))
(if (/= se1 nil)
(progn
(setq l1 (sslength se1) t1 "单位重")
(if (= ca:jm nil) (setq ca:jm "右" ca:j_m 2))
(if (= ca:hh nil) (setq ca:hh (getvar "textsize")))
(ca_dw)
(while (> l1 0)
(ca_smax se1 l1)
(setq e01 e20
se1 se0
l1 (sslength se1)
y (caddr(ca_trans 10 e01))
n1 (atof (ca_f (cdr(assoc 1 e01))))
pt1(list (car pt1) y 0)
n1 (rtos (* pi n1 n1 0.0019625) 2 3)
)
(if (not ca:r) (setq ca:r (assoc 50 e01)))
(ca_mktext n1 (trans pt1 1 0))
)
)
(princ "\n未选择物体.")
)
(if oldsnp (setvar "osmode" oldsnp))
(if oldzin (setvar "dimzin" oldzin))
(setq *error* olderr)
(princ)
)
(defun c:cat(/ se1 l1 pt1 e01 n1 i olderr ca:r oldsnp oldzin)
(command "color" (getvar "cecolor"))
(setq olderr *error*)
(setq oldsnp (getvar "osmode"))
(setq oldzin (getvar "dimzin"))
(setvar "osmode" 0)
(setvar "dimzin" 0)
(setq *error* newerr)
(princ "\n拾取钢筋重量:")
(setq se1 (ssget '((0 . "TEXT"))))
(if (/= se1 nil)
(progn
(setq l1 (sslength se1) t1 "合计总重")
(if (= ca:jm nil) (setq ca:jm "右" ca:j_m 2))
(if (= ca:hh nil) (setq ca:hh (getvar "textsize")))
(ca_dw)
(setq i -1 nt 0)
(repeat l1
(setq i (+ i 1)
e01 (entget(ssname se1 i))
n1 (atof (cdr(assoc 1 e01)))
nt (+ nt n1)
)
(if (not ca:r) (setq ca:r (assoc 50 e01)))
)
(ca_mktext (rtos nt 2 2) (trans pt1 1 0))
)
(princ "\n未选择物体.")
)
(if oldsnp (setvar "osmode" oldsnp))
(if oldzin (setvar "dimzin" oldzin))
(setq *error* olderr)
(princ)
)
(defun c:cas(/ olderr se1 se2 a_ l0 l1 l2 pt1 pt2 pt1x pt2x pt1y cas:b j n1 n2
c l str1 str2 ii b0 n ca:r ens oldsnp oldzin)
(command "color" (getvar "cecolor"))
(setq olderr *error*)
(setq oldsnp (getvar "osmode"))
(setq oldzin (getvar "dimzin"))
(setvar "osmode" 0)
(setvar "dimzin" 0)
(setq *error* newerr)
(prompt "\n拾取钢筋直径: ")
(setq a_ 2 se1 (ssget '((0 . "TEXT"))))
(if (/= se1 nil) (progn (setq l1 (sslength se1) a_ 0)) (princ "\n未选择物体."))
(while (= a_ 0)
(prompt "\n拾取钢筋总长或总重: ")
(setq se2 (ssget '((0 . "TEXT"))))
(if (/= se2 nil) (setq l2 (sslength se2)))
(if (= l2 l1) (setq a_ 1) (princ "\n选择集长度不同! "))
)
(if (= ca:hh nil) (setq ca:hh (getvar "textsize")))
(if (= ca:h_ nil)
(progn
(if (>= ca:hh 1.0)
(setq ca:h_ (* (expt 10.0 (+ (fix (/ (log ca:hh) (log 10))) 1)) 2.0))
(setq ca:h_ (* (expt 10.0 (fix (/ (log ca:hh) (log 10)))) 2.0))
)
)
)
(if (= ca:l_ nil)
(progn
(if (>= ca:hh 1.0)
(setq ca:l_ (* (expt 10.0 (+ (fix (/ (log ca:hh) (log 10))) 1)) 0.8))
(setq ca:l_ (* (expt 10.0 (fix (/ (log ca:hh) (log 10)))) 0.8))
)
)
)
(setq cas:b nil ca:j_m 2)
(if (= a_ 1) (cas_main))
(if oldsnp (setvar "osmode" oldsnp))
(if oldzin (setvar "dimzin" oldzin))
(setq *error* olderr)
(princ)
)
(defun c:ca(/ se0 se1 se2 se3 l1 l2 l3 a_ e01 e02 e03 n6_ e20 y olderr c oldzin
pt1 pt2 pt3 ptx1 ptx2 ptx3 n1 n2 n3 n4 n5 n6 n ens ca:r oldsnp)
(command "color" (getvar "cecolor"))
(setq olderr *error*)
(setq oldsnp (getvar "osmode"))
(setq oldzin (getvar "dimzin"))
(setvar "osmode" 0)
(setvar "dimzin" 0)
(setq *error* newerr)
(prompt "\n拾取钢筋直径: ")
(setq a_ 2 se1 (ssget '((0 . "TEXT"))))
(if (/= se1 nil) (progn (setq l1 (sslength se1) a_ 0)) (princ "\n未选择物体."))
(while (= a_ 0)
(prompt "\n拾取钢筋长度: ")
(setq se2 (ssget '((0 . "TEXT"))))
(if (/= se2 nil) (setq l2 (sslength se2)))
(if (= l2 l1) (setq a_ 1) (princ "\n选择集长度不同! "))
)
(if (/= se1 nil) (setq a_ 0))
(while (= a_ 0)
(prompt "\n拾取钢筋根数: ")
(setq se3 (ssget '((0 . "TEXT"))))
(if (/= se3 nil) (setq l3 (sslength se3)))
(if (= l3 l1) (setq a_ 1) (princ "\n选择集长度不同! "))
)
(if (= ca:cmm nil) (setq ca:cmm 0.01 ca:c_m "cm"))
(if (= ca:r_w nil) (setq ca:r_w 3 ca:row "三"))
(if (= ca:jm nil) (setq ca:jm "右" ca:j_m 2))
(if (= ca:hh nil) (setq ca:hh (getvar "textsize")))
(if (= ca:h_ nil)
(progn
(if (>= ca:hh 1.0)
(setq ca:h_ (* (expt 10.0 (+ (fix (/ (log ca:hh) (log 10))) 1)) 2.0))
(setq ca:h_ (* (expt 10.0 (fix (/ (log ca:hh) (log 10)))) 2.0))
)
)
)
(if (= a_ 1) (progn (ca_main) (ca_prw)))
(if oldsnp (setvar "osmode" oldsnp))
(if oldzin (setvar "dimzin" oldzin))
(setq *error* olderr)
(princ)
)
(if (or (= (type c:cal) 'LIST) (= (type c:cal) 'SUBR)) (arxload "geomcal.arx"))
(princ "\n**钢筋表计算。版本号 4.12,作者：南京市市政设计研究院嵇龙。**" )
(princ "\n**************************************************************")
(princ "\n CA -- 钢筋表计算。")
(princ " DTW -- 钢筋单位重计算。")
(princ "\n CAT -- 钢筋重量合计。")
(princ " CAS -- 统计钢筋长度或重量。")
(princ)
[/FONT]

[FONT=courier new] 
;;钢筋表计算程序，版本：4.12。 
;;输入直径、单根长、根数。钢筋直径可用"%%c32、%%13132、f32"等形式，长度及根数可输入简单四则运算 
;;符号，如"30*(22+3)、30x3X4"形式，可用"X"或"x"代替"*"，但不可用中文符号。 
;;命令：ＣＡ -- 计算钢筋表。 
;;命令：ＤＴＷ -- 由直径计算单位重。 
;;命令：ＣＡＴ -- 计算钢筋总重。 
;;命令：ＣＡＳ -- 统计钢筋长度或重量。 
;;自由软件，欢迎复制、修改。作者：南京市市政设计研究院 嵇龙(ll_j@21cn.com) 
;;                                                            025－3283626 
 
 
(defun newerr(s) 
  (if (= s "Function cancelled") 
    (progn 
      (setq *error* olderr) 
      (if oldsnp (setvar "osmode" oldsnp)) 
      (if oldzin (setvar "dimzin" oldzin)) 
    ) 
  ) 
  (princ) 
) 
 
(defun ca_main() 
  (princ (strcat "\n\n当前为" ca:row "列模式; 长度单位 " ca:c_m "；列间距 " (rtos ca:h_ 2 1) "; 文本字高 " (rtos ca:hh 2 2) "; 对齐方式 " ca:jm "。\n")) 
  (initget 1 "U N C F H J") 
  (setq pt1 (getpoint (strcat "列数N/单位U/变更列间距C/自由列间距F/文本字高H/对齐方式J/<给出钢筋总长" ca:jm "对齐点>: "))) 
  (cond 
    ((= pt1 "U") 
     (if (= ca:c_m "cm") (setq ca:c_m "mm" ca:cmm 0.001) (setq ca:c_m "cm" ca:cmm 0.01)) 
     (ca_main) 
    ) 
    ((= pt1 "N") 
     (if (= ca:r_w 3) (setq ca:r_w 2 ca:row "二") (setq ca:r_w 3 ca:row "三")) 
     (ca_main) 
    ) 
    ((= pt1 "C") 
     (setq c (getdist (strcat "\n给定列间距< " (rtos ca:h_ 2 1)" >: "))) 
     (if (/= c nil) (setq ca:h_ c)) 
     (ca_main) 
    ) 
    ((= pt1 "F") 
     (setq n6_ 0) 
     (if (= ca:r_w 3) 
       (progn 
         (initget 1) 
         (setq ptx1 (car (getpoint (strcat "\n给出钢筋总长" ca:jm "对齐点: ")))) 
         (initget 1) 
         (setq ptx2 (car (getpoint (strcat "\n给出钢筋单位重" ca:jm "对齐点: ")))) 
         (initget 1) 
         (setq ptx3 (car (getpoint (strcat "\n给出钢筋总重" ca:jm "对齐点: ")))) 
       ) 
       (progn 
         (initget 1) 
         (setq ptx1 (car (getpoint (strcat "\n给出钢筋总长" ca:jm "对齐点: ")))) 
         (initget 1) 
         (setq ptx3 (car (getpoint (strcat "\n给出钢筋总重" ca:jm "对齐点: ")))) 
       ) 
     )   
    ) 
    ((= pt1 "H") 
     (setq c (getdist (strcat "\n给定字高< " (rtos ca:hh 2 2)" >: "))) 
     (if (/= c nil) (progn (setq ca:hh c) (setvar "textsize" c))) 
     (ca_main) 
    ) 
    ((= pt1 "J") 
     (setq ca:j_m (rem (1+ ca:j_m) 3)) 
     (cond 
       ((= ca:j_m 0) (setq ca:jm "左")) 
       ((= ca:j_m 1) (setq ca:jm "中")) 
       ((= ca:j_m 2) (setq ca:jm "右")) 
       (t nil) 
     ) 
     (ca_main) 
    ) 
    (t 
     (setq n6_ 0) 
     (if (= ca:r_w 3) 
       (setq ptx1 (car pt1) 
              ptx2 (+ ptx1 (* 0.95 ca:h_)) 
             ptx3 (+ ptx1 (* 2.0 ca:h_)) 
       ) 
       (setq ptx1 (car pt1) 
             ptx3 (+ ptx1 (* 1.0 ca:h_)) 
       ) 
     )   
    ) 
  ) 
  (while (> l1 0) 
    (ca_smax se1 l1) 
    (setq e01 e20 n1 (atof (ca_f (cdr (assoc 1 e01)))) se1 se0) 
    (if (not ca:r) (setq ca:r (assoc 50 e01))) 
    (ca_smax se2 l1) 
    (setq e02 e20 n2 (ca_n (cdr (assoc 1 e02))) se2 se0) 
    (ca_smax se3 l1) 
    (setq e03 e20 n3 (ca_n (cdr (assoc 1 e03))) se3 se0) 
    (setq l1 (sslength se1) 
          y  (/ (+ (caddr(ca_trans 10 e01)) (caddr(ca_trans 10 e02)) 
                   (caddr(ca_trans 10 e03))) 3) 
    ) 
    (setq pt1(list ptx1 y 0) 
          pt2(list ptx2 y 0) 
          pt3(list ptx3 y 0) 
    ) 
    (setq n4 (rtos (* n3 n2 ca:cmm) 2 2) 
          n5 (rtos (* pi n1 n1 0.0019625) 2 3) 
          n6 (rtos (* (atof n5) (atof n4)) 2 2) 
          n6_(+ n6_ (atof n6)) 
    ) 
    (ca_mktext n4 (trans pt1 1 0)) 
    (if (= ca:r_w 3) (ca_mktext n5 (trans pt2 1 0))) 
    (ca_mktext n6 (trans pt3 1 0)) 
  ) 
) 
 
(defun ca_prw(/ p_w) 
  (setq pt (getpoint (strcat "\n合计钢筋总重" ca:jm "对齐点: "))) 
  (if (/= pt nil) 
    (ca_mktext (rtos n6_ 2 2) (trans pt 1 0)) 
    (progn 
      (initget "Yes No") 
      (setq p_w (getkword "\n取消合计总重？ Yes or <No>?")) 
      (if (/= p_w "Yes") 
        (ca_prw) 
      ) 
    ) 
  ) 
) 
 
(defun ca_trans(n ens) 
  (cons n (trans (cdr (assoc n ens)) 0 1)) 
) 
 
(defun ca_f(e1) 
  (cond 
    ((and (> (ascii e1) 48)(<= (ascii e1) 57)) e1) 
    ((= (ascii e1) 37) 
     (setq e1(substr e1 3)) 
     (cond 
       ((= (ascii e1) 49) (setq e1 (substr e1 4))) 
       (t (setq e1 (substr e1 2))) 
     ) 
    ) 
    (t (setq e1 (substr e1 2))) 
  ) 
  (eval e1) 
) 
 
(defun ca_n(e1 / t1 nt nt1) 
  (setq nt "" nt1 "") 
  (while (/= e1 "") 
    (setq t1 (substr e1 1 1) e1 (substr e1 2)) 
    (if (or (= t1 ".") (and (>= (ascii t1) 48) (<= (ascii t1) 57))) 
      (setq nt1 (strcat nt1 t1)) 
      (progn 
        (if (or (= t1 "x") (= t1 "X")) (setq t1 "*")) 
        (cond 
          ((= (ascii nt1) 46) (setq nt1 (strcat "0" nt1))) 
          ((= (type (read nt1)) 'INT) (setq nt1 (strcat nt1 ".0"))) 
          (t nil) 
        ) 
        (setq nt (strcat nt nt1 t1) nt1 "") 
      ) 
    ) 
  ) 
  (if (/= nt1 "") 
    (progn 
      (cond 
        ((= (ascii nt1) 46) (setq nt1 (strcat "0" nt1))) 
        ((= (type (read nt1)) 'INT) (setq nt1 (strcat nt1 ".0"))) 
        (t nil) 
      ) 
      (setq nt (strcat nt nt1)) 
    ) 
    (setq nt (strcat nt nt1)) 
  ) 
  (setq e1 (c:cal nt))    
) 
 
(defun ca_smax(se l_ / e10 y0 i e1 e2 yi y0) 
  (setq e10 (ssname se 0) 
        e20 (entget e10) 
        y0 (caddr(assoc 10 e20)) 
        i 0 se0 (ssadd) 
  ) 
  (if (/= l_ 1) 
    (repeat (- l_ 1) 
      (setq i  (+ i 1) 
            e1 (ssname se i) 
            e2 (entget e1) 
            yi (caddr(assoc 10 e2)) 
      ) 
      (if (> yi y0) 
        (progn (ssadd e10 se0) (setq e20 e2 y0 yi e10 e1)) 
        (ssadd e1 se0) 
      ) 
    ) 
  ) 
) 
 
(defun ca_mktext(str pt10 / sty) 
  (entmake 
    (list 
      '(0 . "TEXT") 
      (cons 1 str) 
      (cons 10 pt10) 
      (cons 11 pt10) 
      (cons 7 (setq sty (getvar "textstyle"))) 
      (cons 40 ca:hh) 
      ca:r 
      (assoc 41 (tblsearch "style" sty)) 
      (cons 51 (cdr (assoc 50 (tblsearch "style" sty)))) 
      '(71 . 0) 
      (cons 72 ca:j_m) 
;      (cons 73 :j2) 
    ) 
  ) 
) 
 
 
(defun ca_dw() 
  (princ (strcat "\n当前文本字高 " (rtos ca:hh 2 2) "; 对齐方式 " ca:jm ".\n")) 
  (initget 1 "H J") 
  (setq pt1 (getpoint (strcat "\n文本字高H/对齐方式J/<给出钢筋" t1 ca:jm "对齐点: >"))) 
  (cond 
    ((= pt1 "H") 
     (setq c (getdist (strcat "\n给定字高< " (rtos ca:hh 2 2)" >: "))) 
     (if (/= c nil) (progn (setq ca:hh c) (setvar "textsize" c))) 
     (ca_dw) 
    ) 
    ((= pt1 "J") 
     (setq ca:j_m (rem (1+ ca:j_m) 3)) 
     (cond 
       ((= ca:j_m 0) (setq ca:jm "左")) 
       ((= ca:j_m 1) (setq ca:jm "中")) 
       ((= ca:j_m 2) (setq ca:jm "右")) 
       (t nil) 
     ) 
     (ca_dw) 
    ) 
    (t nil) 
  ) 
) 
 
(defun cas_main        () 
  (princ (strcat "\n\n输出行间距 " (rtos ca:l_ 2 1) "；列间距 " (rtos ca:h_ 2 1) 
                 "; 文本字高 " (rtos ca:hh 2 2) "。\n")) 
  (initget 1 "L C H") 
  (setq        pt1 (getpoint (strcat "行间距L/列间距C/文本字高H/<给出输出基点>: "))) 
  (cond 
    ((= pt1 "L") 
     (setq c (getdist (strcat "\n给定行间距< " (rtos ca:l_ 2 1) " >: "))) 
     (if (/= c nil) (setq ca:l_ c)) 
     (cas_main) 
    ) 
    ((= pt1 "C") 
     (setq c (getdist (strcat "\n给定列间距< " (rtos ca:h_ 2 1) " >: "))) 
     (if (/= c nil) (setq ca:h_ c)) 
     (cas_main) 
    ) 
    ((= pt1 "H") 
     (setq c (getdist (strcat "\n给定字高< " (rtos ca:hh 2 2) " >: "))) 
     (if (/= c nil) (progn (setq ca:hh c) (setvar "textsize" c))) 
     (cas_main) 
    ) 
    (t 
     (while (> l1 0) 
       (ca_smax se1 l1) 
       (setq e01 e20 
             n1         (ca_f (cdr (assoc 1 e01))) 
             se1 se0 
       ) 
       (if (not ca:r) 
         (setq ca:r (assoc 50 e01)) 
       ) 
       (ca_smax se2 l1) 
       (setq e02 e20 
             n2         (ca_n (cdr (assoc 1 e02))) 
             se2 se0 
       ) 
       (setq l1        (sslength se1) 
             l0        (length cas:b) 
             i        0 
             ii        0 
       ) 
       (if (> l0 0) 
         (progn 
           (repeat l0 
             (setq b0 (nth i cas:b)) 
             (if (= (car b0) n1) 
               (setq n2           (+ n2 (cadr b0)) 
                     cas:b (subst (list n1 n2) b0 cas:b) 
                     i           (1+ i) 
                     ii           1 
               ) 
               (setq i (1+ i)) 
             ) 
           ) 
           (if (= ii 0) 
             (setq cas:b (reverse (cons (list n1 n2) (reverse cas:b)))) 
           ) 
         ) 
         (setq cas:b (cons (list n1 n2) cas:b)) 
       ) 
     ) 
     (setq l0        (length cas:b) 
           i        0 
           pt1x        (car pt1) 
           pt1y        (cadr pt1) 
           pt2x        (+ pt1x ca:h_) 
     ) 
     (repeat l0 
       (setq pt1  (list pt1x (- pt1y (* i ca:l_)) 0) 
             pt2  (list pt2x (- pt1y (* i ca:l_)) 0) 
             n1   (- (apply 'min (mapcar 'atof (mapcar 'car cas:b))) 1) 
             n2   (apply 'max (mapcar 'atof (mapcar 'car cas:b))) 
             j    (- l0 (length (member n2 (mapcar 'atof (mapcar 'car cas:b))))) 
             str1 (car (nth j cas:b)) 
             str2 (rtos (cadr (nth j cas:b)) 2 2) 
             cas:b(subst (cons (rtos n1 2 0) (cadr (nth j cas:b))) (nth j cas:b) cas:b) 
             i    (1+ i) 
       ) 
       (ca_mktext str1 (trans pt1 1 0)) 
       (ca_mktext str2 (trans pt2 1 0)) 
     ) 
    ) 
  ) 
  (princ) 
) 
 
(defun c:dtw(/ se1 se0 l1 pt1 e01 e02 y n1 e20 t1 olderr ca:r n ens oldsnp oldzin) 
  (command "color" (getvar "cecolor")) 
  (setq olderr *error*) 
  (setq oldsnp (getvar "osmode")) 
  (setq oldzin (getvar "dimzin")) 
  (setvar "osmode" 0) 
  (setvar "dimzin" 0) 
  (setq *error* newerr) 
  (princ "\n拾取钢筋直径:") 
  (setq se1 (ssget '((0 . "TEXT")))) 
  (if (/= se1 nil) 
    (progn 
      (setq l1 (sslength se1) t1 "单位重") 
      (if (= ca:jm nil) (setq ca:jm "右" ca:j_m 2)) 
      (if (= ca:hh nil) (setq ca:hh (getvar "textsize"))) 
      (ca_dw)    
      (while (> l1 0) 
        (ca_smax se1 l1) 
        (setq e01 e20 
              se1 se0 
              l1 (sslength se1) 
              y  (caddr(ca_trans 10 e01)) 
              n1 (atof (ca_f (cdr(assoc 1 e01)))) 
              pt1(list (car pt1) y 0) 
              n1 (rtos (* pi n1 n1 0.0019625) 2 3) 
        ) 
        (if (not ca:r) (setq ca:r (assoc 50 e01))) 
        (ca_mktext n1 (trans pt1 1 0)) 
      ) 
    ) 
    (princ "\n未选择物体.") 
  ) 
  (if oldsnp (setvar "osmode" oldsnp)) 
  (if oldzin (setvar "dimzin" oldzin)) 
  (setq *error* olderr) 
  (princ) 
) 
 
(defun c:cat(/ se1 l1 pt1 e01 n1 i olderr ca:r oldsnp oldzin) 
  (command "color" (getvar "cecolor")) 
  (setq olderr *error*) 
  (setq oldsnp (getvar "osmode")) 
  (setq oldzin (getvar "dimzin")) 
  (setvar "osmode" 0) 
  (setvar "dimzin" 0) 
  (setq *error* newerr) 
  (princ "\n拾取钢筋重量:") 
  (setq se1 (ssget '((0 . "TEXT")))) 
  (if (/= se1 nil) 
    (progn 
      (setq l1 (sslength se1) t1 "合计总重") 
      (if (= ca:jm nil) (setq ca:jm "右" ca:j_m 2)) 
      (if (= ca:hh nil) (setq ca:hh (getvar "textsize"))) 
      (ca_dw)    
      (setq i -1 nt 0) 
      (repeat l1 
        (setq i (+ i 1) 
              e01 (entget(ssname se1 i)) 
              n1 (atof (cdr(assoc 1 e01))) 
              nt (+ nt n1) 
        ) 
        (if (not ca:r) (setq ca:r (assoc 50 e01))) 
      ) 
      (ca_mktext (rtos nt 2 2) (trans pt1 1 0)) 
    ) 
    (princ "\n未选择物体.") 
  ) 
  (if oldsnp (setvar "osmode" oldsnp)) 
  (if oldzin (setvar "dimzin" oldzin)) 
  (setq *error* olderr) 
  (princ) 
) 
 
(defun c:cas(/ olderr se1 se2 a_ l0 l1 l2 pt1 pt2 pt1x pt2x pt1y cas:b j n1 n2 
             c l str1 str2 ii b0 n ca:r ens oldsnp oldzin) 
  (command "color" (getvar "cecolor")) 
  (setq olderr *error*) 
  (setq oldsnp (getvar "osmode")) 
  (setq oldzin (getvar "dimzin")) 
  (setvar "osmode" 0) 
  (setvar "dimzin" 0) 
  (setq *error* newerr) 
  (prompt "\n拾取钢筋直径: ") 
  (setq a_ 2 se1 (ssget '((0 . "TEXT")))) 
  (if (/= se1 nil) (progn (setq l1 (sslength se1) a_ 0)) (princ "\n未选择物体.")) 
  (while (= a_ 0) 
    (prompt "\n拾取钢筋总长或总重: ") 
    (setq se2 (ssget '((0 . "TEXT")))) 
    (if (/= se2 nil) (setq l2 (sslength se2))) 
    (if (= l2 l1) (setq a_ 1) (princ "\n选择集长度不同! ")) 
  ) 
  (if (= ca:hh nil) (setq ca:hh (getvar "textsize"))) 
  (if (= ca:h_ nil) 
    (progn 
      (if (>= ca:hh 1.0) 
        (setq ca:h_ (* (expt 10.0 (+ (fix (/ (log ca:hh) (log 10))) 1)) 2.0)) 
        (setq ca:h_ (* (expt 10.0 (fix (/ (log ca:hh) (log 10)))) 2.0)) 
      ) 
    ) 
  ) 
  (if (= ca:l_ nil) 
    (progn 
      (if (>= ca:hh 1.0) 
        (setq ca:l_ (* (expt 10.0 (+ (fix (/ (log ca:hh) (log 10))) 1)) 0.8)) 
        (setq ca:l_ (* (expt 10.0 (fix (/ (log ca:hh) (log 10)))) 0.8)) 
      ) 
    ) 
  ) 
  (setq cas:b nil ca:j_m 2) 
  (if (= a_ 1) (cas_main)) 
  (if oldsnp (setvar "osmode" oldsnp)) 
  (if oldzin (setvar "dimzin" oldzin)) 
  (setq *error* olderr) 
  (princ) 
) 
 
(defun c:ca(/ se0 se1 se2 se3 l1 l2 l3 a_ e01 e02 e03 n6_ e20 y olderr c oldzin 
            pt1 pt2 pt3 ptx1 ptx2 ptx3 n1 n2 n3 n4 n5 n6 n ens ca:r oldsnp) 
  (command "color" (getvar "cecolor")) 
  (setq olderr *error*) 
  (setq oldsnp (getvar "osmode")) 
  (setq oldzin (getvar "dimzin")) 
  (setvar "osmode" 0) 
  (setvar "dimzin" 0) 
  (setq *error* newerr) 
  (prompt "\n拾取钢筋直径: ") 
  (setq a_ 2 se1 (ssget '((0 . "TEXT")))) 
  (if (/= se1 nil) (progn (setq l1 (sslength se1) a_ 0)) (princ "\n未选择物体.")) 
  (while (= a_ 0) 
    (prompt "\n拾取钢筋长度: ") 
    (setq se2 (ssget '((0 . "TEXT")))) 
    (if (/= se2 nil) (setq l2 (sslength se2))) 
    (if (= l2 l1) (setq a_ 1) (princ "\n选择集长度不同! ")) 
  ) 
  (if (/= se1 nil) (setq a_ 0)) 
  (while (= a_ 0) 
    (prompt "\n拾取钢筋根数: ") 
    (setq se3 (ssget '((0 . "TEXT")))) 
    (if (/= se3 nil) (setq l3 (sslength se3))) 
    (if (= l3 l1) (setq a_ 1) (princ "\n选择集长度不同! ")) 
  ) 
  (if (= ca:cmm nil) (setq ca:cmm 0.01 ca:c_m "cm")) 
  (if (= ca:r_w nil) (setq ca:r_w 3 ca:row "三")) 
  (if (= ca:jm nil) (setq ca:jm "右" ca:j_m 2)) 
  (if (= ca:hh nil) (setq ca:hh (getvar "textsize"))) 
  (if (= ca:h_ nil) 
    (progn 
      (if (>= ca:hh 1.0) 
        (setq ca:h_ (* (expt 10.0 (+ (fix (/ (log ca:hh) (log 10))) 1)) 2.0)) 
        (setq ca:h_ (* (expt 10.0 (fix (/ (log ca:hh) (log 10)))) 2.0)) 
      ) 
    ) 
  ) 
  (if (= a_ 1) (progn (ca_main) (ca_prw))) 
  (if oldsnp (setvar "osmode" oldsnp)) 
  (if oldzin (setvar "dimzin" oldzin)) 
  (setq *error* olderr) 
  (princ) 
) 
 
 
 
(if (or (= (type c:cal) 'LIST) (= (type c:cal) 'SUBR)) (arxload "geomcal.arx")) 
(princ "\n**钢筋表计算。版本号 4.12,作者：南京市市政设计研究院 嵇龙。**" ) 
(princ "\n**************************************************************") 
(princ "\n CA -- 钢筋表计算。") 
(princ " DTW -- 钢筋单位重计算。") 
(princ "\n CAT -- 钢筋重量合计。") 
(princ " CAS -- 统计钢筋长度或重量。") 
(princ) 
 
  [/FONT]

echoroseluo · 发表于 2003-8-29 16:12:56

收获颇丰哈，谢谢各位的帮助，我赶紧去试一下

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

[编程申请]：钢筋统计

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

Re: [编程申请]：钢筋统计

浏览过的版块