看人家写关于PKPM层高表程序 求大神给看看 为什么不能运行啊 ！！！

yf793826152

;;cg 生成层高表
;;函数 (del_space_k1 str) 多个连续空格变成1个

;;===============================================
;;cg 生成层高表
(defun c:CG ()
  ;;(标准层号 颜色)
  (setq layer_color
           '((1 10)  (2 2)    (3 3)    (4 4)
             (5 152) (6 6)    (7 81)   (8 40)
             (9 14)  (10 10)  (11 11)  (12 14)
             (13 14)
            )
  )
  ;;设置顶部3层的名称
  ;;(setq up_3_fl (mapcar 'list (list "屋面" "机房" "天面")))
  ;;(setq up_3_fl nil)

  ;;|;对话框，外部文件
  ;;---------------------- (read_txt_cg)
  (defun read_txt_cg ()
    (setq fn_cg (findfile "层高表_外部文件.txt") )
    (setq lst-file_0 '("-6.2" "1" "d:\\2012\\" "屋面 机房 天面"))
    (setq lst-file_1 (file->lst fn_cg))
    ;;返回： lst-file
    (if        (null lst-file_1)
      (setq lst-file lst-file_0)
      (setq
        lst-file
         (mapcar
           '(lambda (n)
              (setq lo (vl-string-search ":" n))
              (substr n (+ 2 lo))
            )
           lst-file_1
         )
      )
    )
    (if        (or (member nil lst-file) (< (length lst-file) 4))
      (setq lst-file lst-file_0)
    )
    ;;---------------
    (setq csbg_CG (atof (car lst-file)))
    (SETQ dxs_cg (atoi (cadr lst-file)))
    (IF        (< dxs_cg 0)
      (SETQ dxs_cg (atoi (cadr lst-file_0)))
    )
    (SETQ path_sel (nth 2 lst-file))
    (SETQ up_3_fl (mapcar 'list (fsxm-split (nth 3 lst-file) " ")))
)
  ;;---------------------- (write_txt_cg)
  (defun write_txt_cg ()
    (setq up_3_write (fsxm-join (mapcar 'car up_3_fl) " "))
    ;;(setq csbg_CG0 -6.2) ;_  
    (setq lst-write0
           (list (rtos csbg_CG0 2 3)
                 (itoa dxs_cg)
                 path_sel
                 up_3_write
           )
    )
    (setq lst-pre '("底板标高" "地下室层数" "初始路径" "顶部三层"))
    (setq lst-write (mapcar '(lambda (x y)
                               (strcat x ":" y)
                             )
                            lst-pre
                            lst-write0
                    )
    )
    (setq f (open fn_cg "w"));_ fn_cg 接力read_txt_cg
    (mapcar '(lambda (x) (write-line x f)) lst-write)
    (close f)
  )  
  (command "undo" "be")
  (mkla-c "Defpoints" 190)
  (mkla-c "层高表" 7)
  ;;==============================
  ;;设置全局变量  
  ;;csbg_CG0 dxs_cg  path_sel
  ;;--------------
  ;;以下，2选1
;;;  (setq csbg_CG csbg_CG0)
;;;  (if (null csbg_CG)
;;;    (setq csbg_CG -6.2)
;;;  );首层底标高
  (read_txt_cg)
  ;;(setq csbg_CG (atof 变量))
  ;;--------------
  ;;(if (null dxs_cg)    (setq dxs_cg 1)  );地下室层数
  ;;==============================


  ;;主程序开始---------------------------------------------------
  (PXT_ER)
  (setq        xtblm '("osmode" "clayer" "cecolor" "orthomode" "plinewid")
        xtblz (mapcar 'getvar xtblm)
  )
  (setvar "osmode" 0)
  ;;设置路径---------------------------
  ;;参考字宽.lsp 注意CFGPATH文件无后缀
  ;;设置PKPM可能的安装路径，最常用的放在前面
  ;;(setq fn-lst (list "C:\\PKPM\\CFG\\" "CFGPATH"))
  (setq        fn-lst (list
                 '("C:\\PKPM\\CFG\\" "CFGPATH")
                 '("d:\\PKPM\\CFG\\" "CFGPATH")
                 '("c:\\PKPM_2011\\CFG\\" "CFGPATH")
                 '("D:\\PKPM_2011\\CFG\\" "CFGPATH")
               )
  )
  (setq i 0)
  (setq fn (strcat (car (nth i fn-lst)) (cadr (nth i fn-lst))))
  (setq yn (findfile fn))
  (while (and (not yn) (nth (1+ i) fn-lst))
    ;; findfile未找到，同时下一个元素存在(nth (1+ i)
    (setq i (1+ i))
    (setq fn (strcat (car (nth i fn-lst)) (cadr (nth i fn-lst))))
    (setq yn (findfile fn))
  )
  (if (null yn)
    ;;如果PKPM安装路径不在fn-lst中
    (progn
      (setq path "d:\\")
      (setq fn (getfiled "选择wmass文件" (strcat path "wmass") "OUT" 8)
            path (vl-string-right-trim "WMASS.OUT" fn))
    )
    (progn
      (setq txt-lst (file->lst-jss fn)
            pathlst (cdr (member "WORK" txt-lst))
            path    (strcat (car pathlst) "\\")
      ) ;_用PKPM的目录
      (setq fn (STRCAT PATH "WMASS.OUT"))
      ;;如果未找到WMASS.OUT
      (IF (NOT (FINDFILE FN))
        (setq
          fn (getfiled "选择wmass文件" (strcat path "wmass") "OUT" 8)
          path (vl-string-right-trim "WMASS.OUT" fn)
        )
      )
    )
  )
  ;; 返回 path fn
  ;;----------------------------  
  ;;(setq fn "D:\\2012\\中山坦洲\\PM\\PM-1栋\\WMASS.OUT")

  ;;-------------------------- (get_lst0_cg)
  ;;返回：lst0
  (defun get_lst0_cg (fn)   
    (setq re nil
          i  1
    )
    (setq f (open fn "r"))
    (while (setq line (read-line f))
      (if (wcmatch line "*#(  #)*,*##(  #)*,*#( ##)*,*##( ##)*")
        (progn
          (setq re (cons line re))
        )
      )
      (setq i (1+ i))
    )
    (close f)
    (setq re (reverse re))
    ;;(楼层号 标准层号 层高)
    (setq
      lst-fu (mapcar '(lambda (n)
                        (setq lst (string_to_numbers n))
                        (list (car lst) (cadr lst) (last (!last lst)))
                      )
                     re
             )
    )
;;;  (SETQ        A
;;;         "   1(  1)   1   111(30/ 360)   31(40/ 360)   75(40/ 360)   1.000    1.000"
;;;  )
;;;  (SETQ        A1 (vl-string-trim " " A))   
    (setq
      lst-fu
       (mapcar
         '(lambda (n)
            (del_space_k1 (vl-string-trim " " n))
          )
         re
       )
    )
    (setq
      lst0
       (mapcar
         '(lambda (n)
            (setq ab (string_to_numbers n))
            (list (nth 0 ab)                ;层号
                  (nth 1 ab)                ;标准层号
                  (nth 4 ab)                ;梁砼
                  (nth 7 ab)                ;柱砼
                  (nth 10 ab)                ;墙砼
                  (rtos (atof (nth 12 ab)) 2 2) ;层高       
            )
          )
         lst-fu
       )
    )   
  )
  ;;返回：lst0
  ;;--------------------------
  (get_lst0_cg fn)

  (princ (strcat"\n地下室层数_" (itoa dxs_cg)))
  (princ (strcat"  当前路径_" path))
  (setq pt nil)
;;;  (while (not pt)
;;;    (initget "F P")
;;;    (setq pt (getpoint "\n[F地下室层数/P选择路径]文字插入点:"))
;;;  )
  (initget "F P")
  (setq pt (getpoint "\n[F地下室层数/P选择路径]文字插入点:"))
;;;  (if (null path_sel)
;;;    (setq path_sel "d:\\2012\\")
;;;  )
  (while (member pt '("F" "P" nil))
    (COND
      ((= pt "P")      
       (setq fn
              (getfiled "选择wmass文件" (strcat path_sel "wmass") "OUT" 8)
             path (vl-string-right-trim "WMASS.OUT" fn)
       )
       (if fn
         (progn
         (setq path_sel (substr fn 1 (- (strlen fn) 9)))
         (get_lst0_cg fn))
       )
      )
      ((= pt "F")
       (setq
         dxs2
          (getint (strcat "\n请输入地下室层数<" (itoa dxs_cg) ">"))
       )
       (while (and dxs2 (< dxs2 0))
         (setq
           dxs2        (getint        (strcat        "\n非法输入，请输入地下室层数<"
                                (itoa dxs_cg)
                                ">"
                        )
                )
         )
       )
       (if dxs2
         (setq dxs_cg dxs2)
         (setq dxs_cg dxs_cg)
       )
      )
    )
    (princ (strcat"\n地下室层数_" (itoa dxs_cg)))
    (princ (strcat"  当前路径_" path))
    (initget "F P")
    (setq pt (getpoint "\n[F地下室层数/P选择路径]文字插入点:"))
  );_ while
  (setq csbg2 (getreal (strcat "\n底层面标高<" (rtos csbg_CG 2 3) ">:")))
  (setq        csbg_CG (if csbg2
               csbg2
               csbg_CG
             )
  )
  (setq csbg_CG3 (- csbg_CG (atof (last (car lst0)))))
  (setq csbg_CG0 csbg_CG)
  (setq
    bglst2
     (mapcar
       '(lambda (n) (setq csbg_CG3 (+ csbg_CG3 (atof (last n)))))
       lst0
     )
  )
  (setq bglst (mapcar '(lambda (n) (list (rtos n 2 3))) bglst2))
  (setq
    bglst (mapcar '(lambda (n)
                     (if (equal n '("0.000"))
                       (setq n '("%%p0.000"))
                       n
                     )
                   )
                  bglst
          )
  )
  ;;-------------  
  ;;加入建筑层号
  (setq        dxs dxs_cg
        i_taolou 0
        i_dxs 0
        jzch_lst nil       
  )
  (repeat (- (length lst0) dxs)
    (setq jzch_lst (cons (setq i_taolou (1+ i_taolou)) jzch_lst))
  )
  (repeat dxs
    (setq jzch_lst (append jzch_lst (list (setq i_dxs (1- i_dxs)))))
  )
  (setq        jzch_lst (reverse jzch_lst)
        jzch_lst (mapcar '(lambda (n) (list (itoa n))) jzch_lst)
  )
  ;;----------------------------------------------
  ;当结构层数≥6时，替换顶三层为：屋面、机房、天面
  (if (>= (length jzch_lst) 6)
    (progn
      (setq jzch_lst (reverse jzch_lst))
      (repeat (length UP_3_FL) (setq jzch_lst (cdr jzch_lst)))
      (setq jzch_lst (reverse jzch_lst))
      (setq jzch_lst (append jzch_lst UP_3_FL))
    )
  )
  ;;----------------------------------------------
  ;;(setq lst1 (mapcar '(lambda (x y) (append x y)) lst0 bglst))
  ;;(setq lst2 (mapcar '(lambda (x y) (append x y)) lst1 jzch_lst))
  ;;注释以上两行，增加下行
  (setq lst2 (mapcar '(lambda (x y z) (append x y z)) lst0 bglst jzch_lst))
  ;;加入建筑层号
  ;;-------------  
  (setq        lst (mapcar '(lambda (n)
                       (setq iii -1)
                       (mapcar '(lambda        (ii)
                                  (setq iii (1+ III))
                                  (cond
                                    ((member iii '(2 3 4))
                                     (strcat "C" II)
                                    )
                                    ((member iii '(0))
                                     (strcat "PL" II)
                                    )
                                    ((member iii '(1))
                                     (strcat "标准层" II)
                                    )
                                    (t II)
                                  )
                                )
                               n
                       )
                     )
                    lst2
            )
  )
  (setq pt0 (polar pt (* 0.5 pi) 800))
  ;;lst= ("PL1" "标准层1" "C35" "C30" "C45" "1.50" "-4.700" "-1")
  (SETQ        WZLST (LIST "标准层"   "结构层"          "层号"   "梁板面标高(m)"
                    "层高(m)"     "柱砼"          "墙砼"     "梁板砼"
                   )
  )
  (setq i 0)
  (setq zg 275 gap 450)
  ;;剪力墙，柱
  (setq wall t column nil)
  (setq wall t column t)  
  (foreach n lst
    (setq p1 (polar pt0 _pi2 (* i 450)))
    (setq p2 (polar p1 0 1100)
          p3 (polar p2 0 1000)
          p4 (polar p3 0 1000)
          p5 (polar p4 0 1400)
          p6 (polar p5 0 1200)
          p7  (polar p6 0 800)
    )
    (if        (or (not wall) (not column))
      (setq p7 p6)
    )
    (setq p8  (polar p7 0 800)
          p88 (polar p8 (* 1.5 pi) 250)
          p77 (polar p7 (* 1.5 pi) (if (= i 0) 370 450));原先为450  
          p55 (polar p5 (* 1.5 pi) (if (= i 0) 370 450))
          p66 (polar p6 (* 1.5 pi) (if (= i 0) 370 450))
    )
    (entmake (list '(0 . "LINE")
                   (cons 10 (polar p3 (* 1.5 pi) 100))
                   (cons 11 (polar p8 (* 1.5 pi) 100))
             )
    )
    ;;(setq ptlst nil)
    ;; 1层号  2标准层号   3梁砼  4柱砼 5墙砼  6层高  7标高   8建筑层号
    ;;("PL31" "标准层10"  "C30"   "C30" "C30" "1.80" "87.500" "建筑层号")
    (cond
      ((and wall (not column))
       (setq p66 nil)
      )
      ((and column (not wall))
       (setq p77 nil)
      )
    )
    (setq ptlst (list p2 p1  p88    p66  p77 p55  p4  p3 ))
    ;(setq ptlst (list p2 p1  p88    nil  p77 p55  p4  p3 ));仅剪力墙
    ;(setq ptlst (list p2 p1  p88    p66  nil p55  p4  p3 ));仅柱
    ;;        1层号 2标准层号 3建筑层号 4梁砼 5柱砼 6墙砼 7层高 8标高
    (setq ptlst_head (list p1 p2 p3 (polar p4 pi 300) p5 p6 p7 p8))
    ;;写表头
    (IF        (= I 0)
      (progn
        (mapcar
          '(lambda (x y)
             (if (member x '("标准层" "结构层"))
               (setvar "clayer" "Defpoints")
             )
             (maketext x y 0 zg 0.7 0 "L" "Tssd_rein")
             (if (member x '("标准层" "结构层"))
               (setvar "clayer" "层高表")
             )
           )
          WZLST
          (mapcar '(lambda (n%) (POLAR n% (* 1.5 pi) 600)) ptlst_head)
        )       
        (entmake (list '(0 . "LWPOLYLINE")
                       '(100 . "AcDbEntity")
                       '(100 . "AcDbPolyline")
                       (cons 90 2)
                       (cons 43 50)
                       (cons 10 (polar p3 (* 1.5 pi) 700))
                       (cons 10 (polar (polar p8 0 550) (* 1.5 pi) 700))
                 )
        )
        (SETQ STR_BT "楼层结构标高、层高"
              INT_BT (polar p5 (* 1.5 pi) 1000)
        )
        (maketext STR_BT INT_BT 0 400 0.85 0 "M" "Tssd_rein")
        (setvar "clayer" "Defpoints")
        (maketext path (polar p3 (* 1.5 pi)1600) 0 400 0.85 0 "L" "Tssd_rein")
      )
    )
    (setq dis_Line (list 700 1400 1100))
    (cond
      ((= I 0)
        (setq p3_ (polar p3 (* 1.5 pi) 100))
        (setq pa1 (polar p3_ 0 (car dis_Line))
              pa2 (polar pa1 0 (cadr dis_Line))
              pa3 (polar pa2 0 (caddr dis_Line))
        )
      )
      ((= I (1- (length lst)))
        (setq p3_ (polar p3 (* 1.5 pi) 100))
        (setq pb1 (polar p3_ 0 (car dis_Line))
              pb2 (polar pb1 0 (cadr dis_Line))
              pb3 (polar pb2 0 (caddr dis_Line))
        )
      )
    )
    ;;(dim-lst ptlst)
    (setq strlst n)   
    ;;strlst= ("PL31" "标准层10" "C30" "C30" "C30" "1.80" "87.500" "30")
    ;;          2       1         88     66    77    5      4       3
    (setq iii -1)   
    (mapcar '(lambda (x y)
               (setq iii (1+ III))
               (cond
                 ((member iii '(0 1 2 3 4 7))
                   ;;与"标准层10"对应
                   (setq color (substr (cadr strlst) 7))
                   (if (setq colst (assoc (atoi color) layer_color))
                     (setvar "cecolor" (itoa (cadr colst)))
                   )
                 )
                 (t (setvar "cecolor" "BYLAYER"))
               )
               (cond ((member iii '(0 1)) (setvar "clayer" "Defpoints"))
                     ((and (= i 0) (member iii '(3 4 5)))
                      (setvar "clayer" "Defpoints")
                     )
               )
               (if y  (maketext x y 0 zg 0.75 0 "L" "Tssd_rein"))
               (cond ((member iii '(0 1)) (setvar "clayer" "层高表"))
                     ((and (= i 0) (member iii '(3 4 5)))
                      (setvar "clayer" "层高表")
                     )
               )               
               (setvar "cecolor" "BYLAYER")
             )
            strlst
            ptlst
    )
    (setq i (1+ i))
  );_ foreach n lst
  (if (>= (length lst) 2)
    (progn
      (entmake (list '(0 . "LINE") (cons 10 pa1) (cons 11 pb1)))
      (entmake (list '(0 . "LINE") (cons 10 pa2) (cons 11 pb2)))
      (entmake (list '(0 . "LINE") (cons 10 pa3) (cons 11 pb3)))
    )
  )
  (write_txt_cg)
  (mapcar 'setvar xtblm xtblz)
  (command "undo" "e")
  (princ)
)
;;main
;;--------------------------------


;|
(SETQ str "1(  1)    1   111(30/ 360)    31(40/ 360)    75(40/ 360)    1.000    1.000"  )
;;(del_space_k1 str) 多个连续空格变成1个
;;返回："1( 1) 1 111(30/ 360) 31(40/ 360) 75(40/ 360) 1.000 1.000"
|;
(defun del_space_k1 (str / Return_cg I_del_kg Full_Str Char_kg)
  (setq        Return_cg ""
        I_del_kg 1
  )
  (setq Full_Str str)
  (while (<= I_del_kg (strlen Full_Str))
    (setq Char_kg (substr Full_Str I_del_kg 1))
    (IF        (= Char_kg " ")
      (IF (/= (substr Full_Str (1- I_del_kg) 1) " ")
        (setq Return_cg (strcat Return_cg Char_kg))
      )
      (setq Return_cg (strcat Return_cg Char_kg))
    )
    (setq I_del_kg (+ I_del_kg 1))
  )
  Return_cg
)

fan_zh

看了一下，缺少子程序，括号也不匹配

yf793826152

如何修改呢  求指教啊