高手帮我改改程序，谢谢！！！！

xingyun300 · 发表于 2012-3-22 20:31:10

本帖最后由 xingyun300 于 2012-3-22 20:32 编辑

如题如题如题如题如题如题如题如题如题

(DEFUN C:Mcal ()
(setq jd (getint "input 精度<0>:"))
(if (= jd nil) (setq jd 0))
  (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))

  (setq obj4 O3)
  (SETQ PRO2 (ENTGET OBJ4))
  (SETQ K3 (ASSOC 1 PRO2))
  (setq positiontemp (cdr (assoc 10 pro2)))
  (setq ts (cdr (assoc 7 pro2)))
  (SETQ K4 (CDR K3))
  (setq l2 (atoi k4))
  (setq g (/ (* (* s 0.00785) l) 1000))
  (setq g2 (rtos g 2 1))
  (setq gtotal (* g l2))
  (setq gtotal (rtos gtotal 2 1))
  (setvar "osmode" 0)
  (setq position (polar positiontemp 0 10))
  (command "text" "s" ts    "j"    "bl"
position TEXTHEIGHT2    "0"    g2
""
)  ;
  (setq position2 (POLAR position 0 25))
  (command "text" "s" ts    "j"    "bl"
position2 TEXTHEIGHT2    "0"
gtotal ""
)  ;
  (print)
  (print)
  (SETQ S NIL)
  (SETQ G NIL)
  (SETQ G2 NIL)
  (SETQ GTOTAL NIL)
  (SETQ L NIL)
  (setq positiontemp nil)
  (setq position nil)
  (setq position2 nil)
  (setq o1 nil)
  (setq o2 nil)
  (setq o3 nil)
   ) ;end progn
   ) ;end if
) ;end progn
) ;end if
(setq i3 (+ i3 1))
   )    ;end while
   (setq i3 0)
   (setq i2 (+ i2 1))
)    ;end while
(setq i2 0)
(setq i1 (+ i1 1))
  )    ;end while
)    ;END DEFUN

xingyun300 · 发表于 2012-3-22 23:13:31

本帖最后由 xingyun300 于 2012-3-23 15:12 编辑

大家帮帮忙呀！

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