[编程申请]：程序有错误，希望高手给修改一下

jwq690517

大家新年好：
    不好意思，一上班就打扰大家啊！同事给我一个计算材料表的程序，说是使用过程中有很多问题，叫我看看！可我还是菜鸟呢！没办法还是放到论坛上希望高手给解决一下！问题一：不能计算T型钢和方钢等不常用的型钢，实际使用中表现能计算，但是只是把上面一栏的计算结果复制下来，当然是错的！问题二：使用过这个程序后，再用其它lsp程序，就是错误提示，例如“错误: 函数错误: "10”",这个10是它计算的最后一个值！问题三：有时不能把重量数据写入数据文件！
    程序，数据文件和带材料表的图在附件内，因为程序只能计算这个形式的材料表，所以附件里有张带材料表的图。我的联系方式：jwq690517@163.com
    希望大侠们帮忙修改一下，如果能计算所有型钢（比如    和美国的，我只要在数据文件里边添加米重量即可）那就太好了！哪位大侠改好，请公布源程序及修改后的程序，我也想学学！祝大家新年好！


;========================================================

(defun main(P1 P2/)  
       (SETQ YY1(GETVAR "CMDECHO"));"CMDECHO"：对AUTOCAD的提示和命令是否有回答变量
       (setvar "cmdecho" 0)  
       (setq  tc(getvar  "clayer" ))   
       (setq  oo(getvar  "osmode"));"OSMODE"：控制目标捕捉方式变量      
       (setq  x "" xx  "" n 1 )      
       (setq s (ssget "w" p1 p2))
  (SETQ NN(SSLENGTH S))
  (SETQ N(SSLENGTH S))
  
;=====================构成过程表L,LL(以下)===============
  
  (setq ll nil)
  (setq l nil)
  (repeat N
     (setq n(- n 1))

     (setq a(ssname s n))
     (setq aa(entget a))
     (setq aaa(assoc 1 aa))
     (setq zb(assoc 10 aa))
     (setq y1(cdr zb))
     (setq y11(car y1))
     (setq y(cdr aaa))
     
     (setq biao(list y11 y))
     (setq ll(cons biao ll))
     (setq l(cons y11 l))
     (print l)
     (print ll)
     (print y11)
     (print yy)
     
     (print)
  );repeat
;==================给表L各数排序（以下）===============
(setq lt nil)
   (setq n(length l))
   
   (repeat n
     (setq lmin(apply ' min l))
     (setq lmax (apply 'max l))
     (setq l(subst lmin lmax l) )
     (setq lt(cons lmax lt) )
    )
    (setq l lt )
  (print l)
  (print)
;========================按序输值(以下)==================
(setq xh(atoI (cadr (assoc (car l)ll) )));序号
(PRINC"\n序号:")(PRINC)
(PRINT XH)(PRINT )
(SETQ GUG(CADR  (ASSOC (CADR L)LL)));规格
(PRINC"\n规格:")(PRINC)
(PRINT GUG)(PRINT )
(SETQ CD(ATOF ( CADR (ASSOC (CADDR L)LL))));长度
(PRINC"\n长度:")(PRINC)
(PRINT CD)(PRINT )
(SETQ SLZ(ATOF (CADR (ASSOC (CADDDR L)LL))));数量(正)
(PRINC"\n数量(正):")(PRINC)
(PRINT SLZ)(PRINT )
(IF (= NN 5)
  (SETQ SLF(ATOF (CADR (ASSOC (LAST L)LL))));数量(反)
  (SETQ SLF 0)
)
(PRINC"\n数量(反):")(PRINC)
(PRINT SLF)(PRINT )
      
   ;.............................................处理 * 与  X
     (setq xx1 "" x1 " " n1 1)
     (while  (/= x1 "")
        (setq xx1(strcat xx1 x1))
        (setq x1(substr GUG n1 1))
        (setq n1(+ n1 1))
        (if (or (= x1 "X") (= x1 "x")) (setq  x1  "*"))
     )
     (setq clxh3 (substr xx1 2))

     

  ;...........................................字高,距离(座标)

     (setq zg0(cdr (assoc 40 AA))
           pt0(cdr (assoc 10 AA))
           pt1(list (+ (car pt0) 33) (car (cdr pt0)))
           pt2(list (+ (car pt0) 50.5) (car (cdr pt0))))
(SETQ PT3(LIST (+ (CAR P2) ZG0) (+ (CADR P2) (/ ZG0 2))))
(SETQ PT6(LIST (+ (CAR P2) (* 5 ZG0)) (+ (CADR P2) (/ ZG0 2))))   
     (setq pt5(list (car pt3) (car(cdr pt3))))
     (setq pt8(list (car pt6) (car (cdr pt6))))
;-----------------------------------------------------------
     (cond ((= (substr clxh3 1 1) "-") (ban)) ; - 为板
           ((= (substr clxh3 1 3) "%%C") (yg));  圆钢
           ((= (substr clxh3 1 3) "%%c") (yg))
           ((= (substr clxh3 1 1) "L") (jg))  ; L 角钢
           ((= (substr clxh3 1 1) "[") (jg)) ; [ 槽钢
           ((= (substr clxh3 1 1)  "I") (jg))
           ((= (substr clxh3 1 1)  "C") (jg))
           ((= (substr clxh3 1 1)  "H") (jg))
           ((= (substr clxh3 1 2)  "Hb") (jg)))
     (setvar "OSMODE" 0)
      (command "layer"  "s" "text" \n)
      (command "text" pt5 zg0 0 vl0)
      (if (= vl1 "0") (setq vl1 "1"))
      (command "text" pt8  zg0 0  vl1)
      (setvar "osmode" oo)
      (setvar "clayer" tc)
)

;.................................................圆钢

(defun yg()

     (setq xx1 "" x1 " " n1 1)
     (while  (/= x1 "")
        (setq xx1(strcat xx1 x1))
        (setq x1(substr clxh3 n1 1))
        (setq n1(+ n1 1))
        (setq chang (atof (substr xx1 5)))
        (setq kuan 0)
        (if  (= x1 "*")
            (setq chang (atof (substr xx1 5))
                  kuan (atof (substr clxh3  n1))
                  x1  "")
        )

      )
     (setq r0 (/ chang 2))
     (setq r1 (- r0 kuan))
     (if (= kuan 0)
         (setq vl0 (rtos (* 3.1416  r0  r0  CD 7.85 0.001 0.001) 2 1))
         (setq vl0 (rtos (* 3.1416 (+ r0 r1) (- r0 r1) CD 7.85 0.001 0.001) 2 1))
     )
       (setq  vl1 (rtos (* (+ slz slf) (atof vl0)) 2 0))
)
;................................................. 板
(defun ban()
     (setq  flag0 "1")
     (if  ( = flag0 "2")
          (wb)
     (progn
     (setq xx1 "" x1 " " n1 1)
     (while  (/= x1 "")
        (setq xx1(strcat xx1 x1))
        (setq x1(substr clxh3 n1 1))
        (setq n1(+ n1 1))
        (if (or (= x1 "*") (= x1 "X"))
            (setq chang (atof (substr xx1 1))
                  kuan (atof (substr clxh3  n1))
                  vl0 (rtos (abs (* chang kuan CD 7.85 0.001 0.001)) 2 1)
                  vl1 (rtos (* (+ slz slf) (atof vl0) ) 2 0)
                  x1  "")
        )

      )
)
)
)

;................................................. wb
(defun wb()
      (setq xx1 "" x1 " " n1 1)
     (while  (/= x1 "")
        (setq xx1(strcat xx1 x1))
        (setq x1(substr clxh3 n1 1))
        (setq n1(+ n1 1))
        (if (or (= x1 "*") (= x1 "X"))
            (setq chang (atof (substr xx1 1))
                  kuan (atof (substr clxh3  n1))
                  vl0 (rtos (abs (* chang kuan CD 8.35 0.001 0.001)) 2 1)
                  vl1 (rtos (* (+ slz slf) (atof vl0) ) 2 0)
                  x1  "")
        )

      )



)
;................................................. 型钢
(defun jg()
     (setq flag0 "P")
     (if (= flag0  "q")
         (setq f(open "c:/sjc/jjj1/clk1.dat" "r") hang "-")
         (setq f(open "c:/sjc/jjj1/clk0.dat" "r") hang "-"))
     (while (and (/= hang nil) (/= clxh3 xx))
       (setq hang (read-line f) xx "" x "" n 1)
       (while (/= x " ")
           (setq xx(strcat xx x))
           (if (/= hang nil) (setq x(substr hang n 1)) (setq x " "))
           (setq n(+ n 1))
        )
      )
     (if (/= hang nil ) (setq mmvd (atof (substr hang n))))
     (close f)
     (if  (= hang nil)
        (progn
         (setq mmvd(getreal "\n库中没有此材料规格,请输入其每米重量:"))
         (setq f(open "c:/sjc/jjj1/clk0.dat" "a"))
         (write-line  (strcat clxh3  "    "  (rtos mmvd)) f)
         (close f)))
        (setq vl0 (rtos (* mmvd CD 0.001) 2 1))
        (setq vl1 (rtos (* (+ SLZ slf) (atof vl0) ) 2 0))
   
)
(defun c:jS(/)
  (SETQ P1(getpoint "选取材料表计算起点:"))
  (setq p2(getpoint "选取计算单元右下点:"))
  (main p1 p2)
  (SETQ PJC P1)
  (SETQ  JJCC(SSGET  "W" P1 P2))
  (WHILE (/= JJCC NIL)
         (progn
            (SETQ X1 (CAR P1)  Y1 (CADR P1) X2 (CAR P2) Y2 (CADR P2) )
            ( SETQ H(- Y1 Y2))
            (SETQ Y3(- Y2 H))
            (SETQ X4(- X1 (* 8 H)) Y4(+ Y1(* 1 H))
                X5(+ X2 (* 8 H)) Y5(- Y2 (* 1 H))
                P4 (LIST X4 Y4 0.0)
                P5 (LIST X5 Y5 0.0)
            )
            (COMMAND "ZOOM" "W" P4 P5 )
            (SETQ P1(LIST X1 Y2 0.0) )
            (SETQ P2(LIST X2 Y3 0.0)  )
            (MAIN P1 P2)
            (SETQ JJCC(SSGET "W" P1 P2))
           
         )
  
    )

  
)
(princ "谢谢 ")
(princ)

lidingyu

先回复一下，弄两分。分有点少 了

tonghedi2004

这个没几个会的啊，都在玩股票了。自已研究吧。

西洋建筑

呵呵，这个 难看的懂啊