(DEFUN C:Mcal ()
;(setq reg (findfile "//jz37/$CLBJS$/jz37.reg"))
;(if (= reg nil)
; (progn
; (alert "非注册用户!限制使用!")
; (quit)
; ) ;end progn
; (alert "注册用户!欢迎使用!")
;) ;end if
(alert "约定: H型钢截面表示为“截面高度x截面宽度x腹版厚度x翼缘厚度,并以字母 H 开头;
C型钢截面表示为“截面高度x截面宽度x卷边高度x厚度,并以字母 C 开头;
热轧槽钢截面以字符 [ 开头;
热轧角钢截面以字母 L 开头;
热轧工字钢截面以字母 I 开头;
钢管、钢筋截面以字符 %%C 开头;
钢板以字符 - 开头;")
(print)
(SETVAR "CMDECHO" 0)
(alert "批量选择构件规格:")
(SETQ I1 0) ;规格
(SETQ col1 (ssget '((0 . "TEXT"))))
(SETQ N1 (SSLENGTH col1))
;(alert "构件规格选择完毕!")
(alert "批量选择构件长度:")
(SETQ I2 0) ;长度
(SETQ col2 (ssget '((0 . "TEXT"))))
(SETQ N2 (SSLENGTH col2))
;(alert "构件长度选择完毕!")
(alert "批量选择构件数量:")
(SETQ I3 0) ;数量
(SETQ col3 (ssget '((0 . "TEXT"))))
(SETQ N3 (SSLENGTH col3))
;(alert "构件数量选择完毕!")
(while (< i1 n1)
(SETQ entity1 (SSNAME col1 i1))
(SETQ PRO1 (ENTGET entity1))
(SETQ pro1_coordinate (ASSOC 10 PRO1))
(setq pro1_coory (car (cdr (cdr pro1_coordinate))))
(while (< i2 n2)
(SETQ entity2 (SSNAME col2 i2))
(SETQ PRO2 (ENTGET entity2))
(SETQ pro2_coordinate (ASSOC 10 PRO2))
(setq pro2_coory (car (cdr (cdr pro2_coordinate))))
(while (< i3 n3)
(SETQ entity3 (SSNAME col3 i3))
(SETQ PRO3 (ENTGET entity3))
(SETQ pro3_coordinate (ASSOC 10 PRO3))
(setq pro3_coory (car (cdr (cdr pro3_coordinate))))
(if (< (abs (- pro1_coory pro2_coory)) 2)
(progn
(if (< (abs (- pro2_coory pro3_coory)) 2)
(progn
;(print pro1_coory)
(setq o1 entity1)
;(print pro2_coory)
(setq o2 entity2)
;(print pro3_coory)
(setq o3 entity3)
(setq obj2 O1)
(SETQ PRO (ENTGET OBJ2)) ;获取实体列表
(SETQ K (ASSOC 1 PRO))
(SETQ TEXTHEIGHT1 (ASSOC 40 PRO))
(SETQ TEXTHEIGHT2 (CDR TEXTHEIGHT1))
(SETQ K2 (STRCASE (CDR K)))
(setq total (strlen k2))
(setq no 1)
(setq time 0)
(setq no1 (substr k2 1 1))
(if (= no1 "H") ;"H"型钢
(progn
(SETQ K3 (CONS 1 K2)) ;将小写转化为大写
(SETQ OBJ3 (SUBST K3 K PRO))
(ENTMOD OBJ3) ;刷新列表
(princ "H型钢")
(print)
(setq start 2)
(while (< no total)
(setq no (+ 1 no))
(setq word (substr k2 no 1))
(if (= word "X")
(progn
(setq time (+ time 1))
(setq len (- no start))
(setq section (substr k2 start len))
(setq start (+ no 1))
(if (= time 1)
(setq H (atoi section))
) ;end if
(if (= time 2)
(setq B (atoi section))
) ;end if
(if (= time 3)
(setq tw (atoi section))
) ;end if
) ;end progn
) ;end if
(if (= no total)
(progn
(setq len (+ (- no start) 1))
(setq section (substr k2 start len))
(setq tf (atoi section))
) ;end progn
) ;end if
;(print word)
) ;end while
(setq s1 (* b tf))
(setq s2 (* tw (- h (* 2 tf))))
(setq s (+ s2 (* 2 s1)))
) ;end progn
) ;end if
(if (= no1 "C") ;"C"型钢
(progn
(SETQ K3 (CONS 1 K2)) ;将小写转化为大写
(SETQ OBJ3 (SUBST K3 K PRO))
(ENTMOD OBJ3) ;刷新列表
(princ "C型钢")
(print)
(setq start 2)
(while (< no total)
(setq no (+ 1 no))
(setq word (substr k2 no 1))
(if (= word "X")
(progn
(setq time (+ time 1))
(setq len (- no start))
(setq section (substr k2 start len))
(setq start (+ no 1))
(if (= time 1)
(setq H (atoi section))
) ;end if
(if (= time 2)
(setq B (atoi section))
) ;end if
(if (= time 3)
(setq tw (atoi section))
) ;end if
) ;end progn
) ;end if
(if (= no total)
(progn
(setq len (+ (- no start) 1))
(setq section (substr k2 start len))
(setq tf (atoF section))
) ;end progn
) ;end if
;(print word)
) ;end while
;(setq s1 (* b tf))
;(setq s2 (* tw (- h (* 2 tf))))
;(setq s (+ s2 (* 2 s1)))
(SETQ S (* (+ (* H TF) (* (* 2 (+ B TW) TF))) 0.92))
) ;end progn
) ;end if
(if (= no1 "I") ;工字钢
(progn
(princ "工字钢( I10 ~ I63c )")
(print)
(if (= k2 "I10")
(setq s 1433)
)
(if (= k2 "I12.6")
(setq s 1810)
)
(if (= k2 "I14")
(setq s 2150)
)
(if (= k2 "I16")
(setq s 2611)
)
(if (= k2 "I18")
(setq s 3074)
)
(if (= k2 "I20A")
(setq s 3555)
)
(if (= k2 "I20B")
(setq s 3955)
)
(if (= k2 "I22A")
(setq s 4210)
)
(if (= k2 "I22B")
(setq s 4650)
)
(if (= k2 "I25A")
(setq s 4851)
)
(if (= k2 "I25B")
(setq s 5351)
)
(if (= k2 "I28A")
(setq s 5537)
)
(if (= k2 "I28B")
(setq s 6097)
)
(if (= k2 "I32A")
(setq s 6712)
)
(if (= k2 "I32B")
(setq s 7352)
)
(if (= k2 "I32C")
(setq s 7992)
)
(if (= k2 "I36A")
(setq s 7644)
)
(if (= k2 "I36B")
(setq s 8364)
)
(if (= k2 "I36C")
(setq s 9084)
)
(if (= k2 "I40A")
(setq s 8607)
)
(if (= k2 "I40B")
(setq s 9407)
)
(if (= k2 "I40C")
(setq s 10207)
)
(if (= k2 "I45A")
(setq s 10240)
)
(if (= k2 "I45B")
(setq s 11140)
)
(if (= k2 "I45C")
(setq s 12040)
)
(if (= k2 "I50A")
(setq s 11925)
)
(if (= k2 "I50B")
(setq s 12925)
)
(if (= k2 "I50C")
(setq s 13925)
)
(if (= k2 "I56A")
(setq s 13538)
)
(if (= k2 "I56B")
(setq s 14658)
)
(if (= k2 "I56C")
(setq s 15778)
)
(if (= k2 "I63A")
(setq s 15459)
)
(if (= k2 "I63B")
(setq s 16719)
)
(if (= k2 "I63C")
(setq s 17979)
)
) ;progn
) ;end if
(if (= no1 "L") ;等边角钢
(progn
(princ "等边角钢( L20X3 ~ L200X24 )")
(print)
(IF (= K2 "L20X3")
(setq s 113.2)
)
(IF (= K2 "L20X4")
(setq s 145.9)
)
(IF (= K2 "L25X3")
(setq s 143.2)
)
(IF (= K2 "L25X4")
(setq s 185.9)
)
(IF (= K2 "L30X3")
(setq s 174.9)
)
(IF (= K2 "L30X4")
(setq s 227.6)
)
(IF (= K2 "L36X3")
(setq s 210.9)
)
(IF (= K2 "L36X4")
(setq s 275.6)
)
(IF (= K2 "L36X5")
(setq s 338.2)
)
(IF (= K2 "L40X3")
(setq s 235.9)
)
(IF (= K2 "L40X4")
(setq s 308.6)
)
(IF (= K2 "L40X5")
(setq s 379.2)
)
(IF (= K2 "L45X3")
(setq s 265.9)
)
(IF (= K2 "L45X4")
(setq s 346.8)
)
(IF (= K2 "L45X5")
(setq s 429.2)
)
(IF (= K2 "L45X6")
(setq s 507.6)
)
(IF (= K2 "L50X3")
(setq s 297.1)
)
(IF (= K2 "L50X4")
(setq s 389.7)
)
(IF (= K2 "L50X5")
(setq s 480.3)
)
(IF (= K2 "L50X6")
(setq s 568.8)
)
(IF (= K2 "L56X3")
(setq s 334.3)
)
(IF (= K2 "L56X4")
(setq s 439)
)
(IF (= K2 "L56X5")
(setq s 541.5)
)
(IF (= K2 "L56X8")
(setq s 836.7)
)
(IF (= K2 "L63X4")
(setq s 497.8)
)
(IF (= K2 "L63X5")
(setq s 614.3)
)
(IF (= K2 "L63X6")
(setq s 728.8)
)
(IF (= K2 "L63X8")
(setq s 951.5)
)
(IF (= K2 "L63X10")
(setq s 1165.7)
)
(IF (= K2 "L70X4")
(setq s 557)
)
(IF (= K2 "L70X5")
(setq s 687.5)
)
(IF (= K2 "L70X6")
(setq s 816)
)
(IF (= K2 "L70X7")
(setq s 942.4)
)
(IF (= K2 "L70X8")
(setq s 837.3)
)
(IF (= K2 "L75X5")
(setq s 741.2)
)
(IF (= K2 "L75X6")
(setq s 879.7)
)
(IF (= K2 "L75X7")
(setq s 1016)
)
(IF (= K2 "L75X8")
(setq s 1150.3)
)
(IF (= K2 "L75X10")
(setq s 1412.6)
)
(IF (= K2 "L80X5")
(setq s 791)
)
(IF (= K2 "L80X6")
(setq s 940)
)
(IF (= K2 "L80X7")
(setq s 1086)
)
(IF (= K2 "L80X8")
(setq s 1230)
)
(IF (= K2 "L80X10")
(setq s 1513)
)
(IF (= K2 "L90X6")
(setq s 1064)
)
(IF (= K2 "L90X7")
(setq s 1230)
)
(IF (= K2 "L90X8")
(setq s 1394)
)
(IF (= K2 "L90X10")
(setq s 1717)
)
(IF (= K2 "L90X12")
(setq s 2031)
)
(IF (= K2 "L100X6")
(setq s 1193)
)
(IF (= K2 "L100X7")
(setq s 1380)
)
(IF (= K2 "L100X8")
(setq s 1564)
)
(IF (= K2 "L100X10")
(setq s 1926)
)
(IF (= K2 "L100X12")
(setq s 2280)
)
(IF (= K2 "L100X14")
(setq s 2626)
)
(IF (= K2 "L100X16")
(setq s 2963)
)
(IF (= K2 "L110X7")
(setq s 1520)
)
(IF (= K2 "L110X8")
(setq s 1724)
)
(IF (= K2 "L110X10")
(setq s 2126)
)
(IF (= K2 "L110X12")
(setq s 2520)
)
(IF (= K2 "L110X14")
(setq s 2906)
)
(IF (= K2 "L125X8")
(setq s 1975)
)
(IF (= K2 "L125X10")
(setq s 2437)
)
(IF (= K2 "L125X12")
(setq s 2891)
)
(IF (= K2 "L125X14")
(setq s 3337)
)
(IF (= K2 "L140X10")
(setq s 2737)
)
(IF (= K2 "L140X12")
(setq s 3251)
)
(IF (= K2 "L140X14")
(setq s 3757)
)
(IF (= K2 "L140X16")
(setq s 4254)
)
(IF (= K2 "L160X10")
(setq s 3150)
)
(IF (= K2 "L160X12")
(setq s 3744)
)
(IF (= K2 "L160X14")
(setq s 4330)
)
(IF (= K2 "L160X16")
(setq s 4907)
)
(IF (= K2 "L180X12")
(setq s 4224)
)
(IF (= K2 "L180X14")
(setq s 4890)
)
(IF (= K2 "L180X16")
(setq s 5547)
)
(IF (= K2 "L180X18")
(setq s 6195)
)
(IF (= K2 "L200X14")
(setq s 5464)
)
(IF (= K2 "L200X16")
(setq s 6201)
)
(IF (= K2 "L200X18")
(setq s 6930)
)
(IF (= K2 "L200X20")
(setq s 7650)
)
(IF (= K2 "L200X24")
(setq s 9066)
)
) ;progn
) ;end if
(if (= no1 "L") ;不等边角钢
(progn
(princ "不等边角钢( L25X16X3 ~ L200X125X18 )")
(print)
(if (= k2 "L25X16X3")
(setq s 116.2)
)
(if (= k2 "L25X16X4")
(setq s 149.9)
)
(if (= k2 "L32X20X3")
(setq s 149.2)
)
(if (= k2 "L32X20X4")
(setq s 193.9)
)
(if (= k2 "L40X25X3")
(setq s 189)
)
(if (= k2 "L40X25X4")
(setq s 246.7)
)
(if (= k2 "L45X28X3")
(setq s 4214.9)
)
(if (= k2 "L45X28X4")
(setq s 280.6)
)
(if (= k2 "L50X32X3")
(setq s 243.1)
)
(if (= k2 "L50X32X4")
(setq s 317.7)
)
(if (= k2 "L56X36X3")
(setq s 274.3)
)
(if (= k2 "L56X36X4")
(setq s 359)
)
(if (= k2 "L56X36X5")
(setq s 441.5)
)
(if (= k2 "L63X40X4")
(setq s 405.8)
)
(if (= k2 "L63X40X5")
(setq s 499.3)
)
(if (= k2 "L63X40X6")
(setq s 90.8)
)
(if (= k2 "L63X40X7")
(setq s 680.2)
)
(if (= k2 "L70X45X4")
(setq s 454.7)
)
(if (= k2 "L70X45X5")
(setq s 560.9)
)
(if (= k2 "L70X45X6")
(setq s 664.4)
)
(if (= k2 "L70X45X7")
(setq s 765.7)
)
(if (= k2 "L75X50X5")
(setq s 612.5)
)
(if (= k2 "L75X50X6")
(setq s 726)
)
(if (= k2 "L75X50X8")
(setq s 946.7)
)
(if (= k2 "L75X50X10")
(setq s 1159)
)
(if (= k2 "L80X50X5")
(setq s 637.5)
)
(if (= k2 "L80X50X6")
(setq s 756)
)
(if (= k2 "L80X50X7")
(setq s 872.4)
)
(if (= k2 "L80X50X8")
(setq s 986.7)
)
(if (= k2 "L90X56X5")
(setq s 721.2)
)
(if (= k2 "L90X56X6")
(setq s 855.7)
)
(if (= k2 "L90X56X7")
(setq s 988)
)
(if (= k2 "L90X56X8")
(setq s 1118.3)
)
(if (= k2 "L100X63X6")
(setq s 962)
)
(if (= k2 "L100X63X7")
(setq s 1111)
)
(if (= k2 "L100X63X8")
(setq s 1258)
)
(if (= k2 "L100X63X10")
(setq s 1547)
)
(if (= k2 "L100X80X6")
(setq s 1064)
)
(if (= k2 "L100X80X7")
(setq s 1230)
)
(if (= k2 "L100X80X8")
(setq s 1394)
)
(if (= k2 "L100X80X10")
(setq s 1717)
)
(if (= k2 "L110X70X6")
(setq s 1064)
)
(if (= k2 "L110X70X7")
(setq s 1230)
)
(if (= k2 "L110X70X8")
(setq s 1394)
)
(if (= k2 "L110X70X10")
(setq s 1717)
)
(if (= k2 "L125X80X7")
(setq s 1410)
)
(if (= k2 "L125X80X8")
(setq s 1599)
)
(if (= k2 "L125X80X10")
(setq s 1971)
)
(if (= k2 "L125X80X12")
(setq s 2335)
)
(if (= k2 "L140X90X8")
(setq s 1804)
)
(if (= k2 "L140X90X10")
(setq s 2226)
)
(if (= k2 "L140X90X12")
(setq s 2640)
)
(if (= k2 "L140X90X14")
(setq s 3046)
)
(if (= k2 "L160X100X10")
(setq s 2531)
)
(if (= k2 "L160X100X12")
(setq s 3005)
)
(if (= k2 "L160X100X14")
(setq s 3471)
)
(if (= k2 "L160X100X16")
(setq s 3928)
)
(if (= k2 "L180X110X10")
(setq s 2837)
)
(if (= k2 "L180X110X12")
(setq s 3371)
)
(if (= k2 "L180X110X14")
(setq s 3897)
)
(if (= k2 "L180X110X16")
(setq s 4414)
)
(if (= k2 "L200X125X12")
(setq s 3791)
)
(if (= k2 "L200X125X14")
(setq s 4387)
)
(if (= k2 "L200X125X16")
(setq s 4974)
)
(if (= k2 "L200X125X18")
(setq s 5553)
)
) ;progn
) ;end if
(if (= no1 "[") ;槽钢
(progn
(princ "槽钢( [5 ~ [40c )")
(print)
(if (= k2 "[5")
(setq s 692)
)
(if (= k2 "[6.3")
(setq s 845)
)
(if (= k2 "[8")
(setq s 1024)
)
(if (= k2 "[10")
(setq s 1274)
)
(if (= k2 "[12.6")
(setq s 1569)
)
(if (= k2 "[14A")
(setq s 1851)
)
(if (= k2 "[14B")
(setq s 2131)
)
(if (= k2 "[16A")
(setq s 2195)
)
(if (= k2 "[16B")
(setq s 2515)
)
(if (= k2 "[18A")
(setq s 2569)
)
(if (= k2 "[18B")
(setq s 2929)
)
(if (= k2 "[20A")
(setq s 2883)
)
(if (= k2 "[20B")
(setq s 3283)
)
(if (= k2 "[22A")
(setq s 3184)
)
(if (= k2 "[22B")
(setq s 3624)
)
(if (= k2 "[25A")
(setq s 3491)
)
(if (= k2 "[25B")
(setq s 3991)
)
(if (= k2 "[25C")
(setq s 4491)
)
(if (= k2 "[28A")
(setq s 4002)
)
(if (= k2 "[28B")
(setq s 4562)
)
(if (= k2 "[28C")
(setq s 5122)
)
(if (= k2 "[32A")
(setq s 4850)
)
(if (= k2 "[32B")
(setq s 5490)
)
(if (= k2 "[32C")
(setq s 6130)
)
(if (= k2 "[36A")
(setq s 6089)
)
(if (= k2 "[36B")
(setq s 6809)
)
(if (= k2 "[36C")
(setq s 7529)
)
(if (= k2 "[40A")
(setq s 7504)
)
(if (= k2 "[40B")
(setq s 8304)
)
(if (= k2 "[40C")
(setq s 9104)
)
) ;progn
) ;end if
(if (= no1 "-") ;钢板
(progn
(setq no 1)
(princ "钢板")
(print)
(while (< no total)
(setq word (substr k2 no 1))
(if (= word "X")
(progn
(setq len (- no 2))
(setq H (substr k2 2 len))
(setq H (atoi h))
(setq t (substr k2 (+ no 1) (- total no)))
(setq t (atoi t))
(setq s (* h t))
) ;end progn
) ;end if
(setq no (+ 1 no))
) ;end while
) ;end progn
) ;end if
(if (= no1 "%") ;钢管
(PROGN
(IF (> TOTAL 5)
(PROGN
(PRINC "钢管")
(PRINT)
(while (< no total)
(setq word (substr k2 no 1))
(if (= word "X")
(progn
(setq len (- no 4))
(setq D (substr k2 4 len))
(setq D (atoi D))
(setq t (substr k2 (+ no 1) (- total no)))
(setq t (atoi t))
(setq s (* (* pi (- D t)) t))
) ;end progn
) ;end if
(setq no (+ 1 no))
) ;end while
) ;END PROGN
(PROGN
(PRINC "钢筋")
(SETQ D (SUBSTR K2 4 (- TOTAL 3)))
(SETQ D (ATOI D))
(SETQ S (/ (* PI (* D D)) 4))
);END PROGN
);END IF
);END PROGN
) ;END IF
(setq obj2 O2)
(SETQ PRO (ENTGET OBJ2))
(SETQ K (ASSOC 1 PRO))
(SETQ K2 (CDR K))
(setq l (atoi k2))