明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1902|回复: 5

大家看看这个内部程序怎么运行不了

[复制链接]
发表于 2012-3-10 11:21:57 | 显示全部楼层 |阅读模式
本帖最后由 xingyun300 于 2012-3-10 11:23 编辑

(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))


                (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))
                (alert "HJ's copyright 2003.    SINOMA_CDI
            email: hj42@163.com")
                (command "text"          "s"           ts            "j"             "bl"
                         position TEXTHEIGHT2            "0"             g2
                         ""
                        )                ;
                (alert "HJ's copyright 2003.    SINOMA_CDI
            email: hj42@163.com")
                (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





在别人的CAD文件里就能运行,在我的CAD中就运行不了,看看怎么会事呀!
发表于 2012-3-10 12:46:44 | 显示全部楼层
非注册用户!限制使用!
发表于 2012-3-10 13:26:12 | 显示全部楼层
(defun c:Mcal (/ b col1 col2 col3 d email: entity1 entity2 entity3 g g2 gtotal h hj42@163.com i1 i2 i3 k k2 k3 k4 l l2 len n1 n2 n3 no
               no1 o1 o2 o3 obj2 obj3 obj4 pi position position2 positiontemp pro pro1 pro1_coordinate pro1_coory pro2
               pro2_coordinate pro2_coory pro3 pro3_coordinate pro3_coory s s1 s2 section start textheight1 textheight2 tf time total
               ts tw word
            )                               ; (setq reg (findfile "//jz37/$clbjs$/jz37.reg"))
                                       ; (if (= reg nil)
                                       ;  (progn
                                       ;    (alert "非注册用户!限制使用!")
                                       ;    (quit)
                                       ;  )                                        ;end progn
                                       ;  (alert "注册用户!欢迎使用!")
                                       ; )                                        ;end if
  (alert "\n约定:\n H型钢截面表示为“截面高度x截面宽度x腹版厚度x翼缘厚度,并以字母 H 开头;\n C型钢截面表示为“截面高度x截面宽度x卷边高度x厚度,并以字母 C 开头;\n 热轧槽钢截面以字符 [ 开头;\n 热轧角钢截面以字母 L 开头;\n 热轧工字钢截面以字母 I 开头;\n 钢管、钢筋截面以字符 %%C 开头;\n 钢板以字符 - 开头;")
  (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))
                (alert "HJ's copyright 2003.    SINOMA_CDI  email: hj42@163.com")
                (command "text" "j" "bl" position textheight2 "0" g2) ;
                (alert "HJ's copyright 2003.    SINOMA_CDI  email: hj42@163.com")
                (setq position2 (polar position 0 25))
                (command "text" "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
  (princ)
)
;;; end defun
发表于 2012-3-10 13:34:06 | 显示全部楼层
这个程序是做什么的?
好像是依据所选规格计算,然后在屏幕上输出两个结果。
如果是这样,程序也运行正常噢。
 楼主| 发表于 2012-3-10 14:22:20 | 显示全部楼层
是计算钢板,型钢重量的插件,在别人的CAD里能运行,到我的CAD里运行时结果是0,大家看看是什么问题呀!
 楼主| 发表于 2012-3-10 20:45:29 | 显示全部楼层
效果不在一个平面上呢

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2025-9-25 02:50 , Processed in 0.208497 second(s), 27 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表