求LISP高手看看下面程序为何运行错误，帮忙改正下，谢谢！！！

○Only°尐影 · 发表于 2013-5-14 10:08:19

;;; ****************************************程序说明*************************************************
;;; * *
;;; * *
;;; * *
;;; * *
;;; * *
;;; * *
;;; *************************************************************************************************
(defun on_dlg1 ()
(setq biaohang (atoi (get_tile "cl_bl2"))
gjzhj (get_tile "cl_gch1")
dgchd (get_tile "cl_gch2")
gjgsh (get_tile "cl_gch3")
stscale (atoi (get_tile "cl_bl1"))
b_biao (get_tile "cl_file")
f_name (get_tile "cl_fname")
hzdm (get_tile "cl_hzdm")
gjzhj1 gjzhj
gjgsh1 gjgsh
dgchd1 dgchd
)
(if (equal b_biao "1")
(progn (setq fil (findfile f_name))
(if fil (setq f_name fil)
(progn (princ (strcat "\n 找不到数据文件" f_name "。请用对话框寻找！"))
(setq f_name (getfiled "目录表" "" "" 2))
)
)
)
)
(gc)
)
(defun huitu(p1 p2)
(setq topleft (list (- (car p1) 4.5) (- (cadr p1) 6.0))
topright (list (+ (car p2) 1.0) (- (cadr p1) 6.0))
pt1 topleft
pt2 topright
nn 0
)
(command "layer" "set" "表格" "")
(command "rectang" "w" 0.05 (list (car topleft) (- (cadr topleft) 11.0)) topright)
(repeat 7 (setq dts (nth nn '(1.5 1.0 1.0 1.5 1.5 1.5 1.5)))
(setq pt1 (list (car pt1) (- (cadr pt1) dts))
pt2 (list (car pt2) (- (cadr pt2) dts))
nn (+ nn 1)
)
(command "line" pt1 pt2 "")
)
(command "line" (list (car p1) (- (cadr p1) 6.0)) (list (car p1) (- (cadr p1) 17.0)) "")
(command "line" topleft (list (car p1) (- (cadr topleft) 1.5)) "")
(setq wth '("坡度(%)" "坡长(M)" "填土" "挖土"
"路面设计高程" "路基设计高程" "地面高程" "桩号" "平曲线")
nn 0
pt1 (list (- (car p1) 1.0) (- (cadr p1) 6.5))
dth '(1.0 1.25 1.5 1.5 1.5 1.5 0)
)
(repeat 9 (setq wtt (nth nn wth))
(if (< nn 2) (xiezhi pt1 "st" 0.4 0 (nth nn wth))
(xiezhi pt1 "st" 0.5 0 (nth nn wth))
)
(if (< nn 2) (if (= nn 0) (setq pt1 (list (- (car p1) 3.5) (- (cadr p1) 7.0)))
(setq pt1 (list (- (car p1) 2.25) (- (cadr p1) 8.0)))
)
(setq pt1 (list (car pt1) (- (cadr pt1) (nth (- nn 2) dth))))
)
(setq nn (+ nn 1))
)
(setq bchmax (+ (fix (cadr p2)) 3)
bchmin (- (fix (cadr p1)) 3)
anv (+ (- bchmax bchmin) 1)
anh (- (fix (car p2)) (fix (car p1)))
)
(command "line" (list (car p1) bchmax)
(list (car p1) bchmin)
"@-0.2,0"
(list (- (car p1) 0.2) bchmax) "c"
)
(command "layer" "set" "虚线" "")
(command "line" (list (+ (fix (car p1)) 1) bchmin)
(list (+ (fix (car p1)) 1) bchmax) ""
)
(setq temp1 (cdar (entget (entlast))))
(command "array" temp1 "" "r" 1 anh 1)
(command "line" (list (+ (fix (car p1)) 1) bchmax)
(list (fix (car p2)) bchmax) ""
)
(setq temp1 (cdar (entget (entlast))))
(command "array" temp1 "" "r" anv 1 -1)
(command "layer" "set" "表格" "")
(setq ptem1 (list (- (car p1) 0.1) bchmax)
ptem2 (list (car p1) bchmax)
ptem3 (list (- (car p1) 0.1) (- bchmax 1))
ptem4 (list (car p1) (- bchmax 1))
lo 1
)
(while (<= bchmin (cadr ptem4))
(command "solid" ptem1 ptem2 ptem3 ptem4 "")
(setq ptem5 (list (- (car p1) 1.3) (cadr ptem1))
wth (rtos (cadr ptem1) 2 0)
)
(command "text" "s" "txt" ptem5 0.3 0 wth)
(if (= bchmin (cadr ptem4))
(progn (setq ptem5 (list (- (car p1) 1.3) (cadr ptem4))
wth (rtos (cadr ptem4) 2 0)
)
(command "text" "s" "txt" ptem5 0.3 0 wth)
)
)
(if (= lo 1) (setq ptem1 (list (- (car ptem1) 0.1) (- (cadr ptem1) 1.0))
ptem2 (list (- (car ptem2) 0.1) (- (cadr ptem2) 1.0))
ptem3 (list (- (car ptem3) 0.1) (- (cadr ptem3) 1.0))
ptem4 (list (- (car ptem4) 0.1) (- (cadr ptem4) 1.0))
lo 0
)
(setq ptem1 (list (+ (car ptem1) 0.1) (- (cadr ptem1) 1.0))
ptem2 (list (+ (car ptem2) 0.1) (- (cadr ptem2) 1.0))
ptem3 (list (+ (car ptem3) 0.1) (- (cadr ptem3) 1.0))
ptem4 (list (+ (car ptem4) 0.1) (- (cadr ptem4) 1.0))
lo 1
)
)
)
(gc)
)
(defun c:dhk()
(setvar "cmdecho" 0)
(setq dcl_id (load_dialog "duan.dcl"))
(if (not (new_dialog "cl_box1" dcl_id)) (exit))
(set_tile "cl_bl2" "100")
(set_tile "cl_bl1" "1000")
(set_tile "cl_file" "1")
(if (/= nil gjzhj1) (progn (set_tile "cl_gch1" gjzhj1)
(set_tile "cl_gch2" dgchd1)
(set_tile "cl_gch3" gjgsh1)
)
)
(mode_tile "cl_gch1" 1)
(mode_tile "cl_gch2" 1)
(mode_tile "cl_gch3" 1)
(action_tile "cl_file" "(mode_tile \"cl_gch1\" 1)
(mode_tile \"cl_fname\" 0)
(mode_tile \"cl_gch2\" 1)
(mode_tile \"cl_gch3\" 1)")
(action_tile "cl_screen" "(mode_tile \"cl_gch1\" 0)
(mode_tile \"cl_gch2\" 0)
(mode_tile \"cl_fname\" 1)
(mode_tile \"cl_gch3\" 0)")
(action_tile "cancel" "(done_dialog 0)")
(action_tile "accept" "(on_dlg1)(done_dialog 1)")
(setq w_1 (start_dialog))
(bzht)
(if (= w_1 1) (if (equal b_biao "1") (if (equal hzdm "1") (zdmshuru)
(hdmshuru)
)
(prompt " ")
)
(print " ")
)
(unload_dialog dcl_id)
(setvar "cmdecho" 1)
)
(defun xiezhi (wp ss h r wtxt)
(command "text" "s" ss "m" wp h r wtxt)
)
(defun zdmshuru()
(setq rf (open f_name "r")
aa 1
bb 1
xmax -100.00
xmin 10000.00
ymax -100.00
ymin 10000.00
temp1 0.0
ltemp nil
lwstr nil
)
(command "layer" "set" "地面线" "")
(while (boundp 'aa)
(setq aa (read-line rf)
nn 1
tst "no"
stemp1 nil
)
(if (boundp 'aa)
(progn (setq slen (strlen aa) zhz1 nil zhz2 nil zhz3 nil zhz4 nil str1 nil)
(if (> bb 5)
(progn (while (<= nn slen)
(setq stemp2 (substr aa nn 1))
(if (and (not (equal stemp2 " "))
(or (equal stemp1 " ") (equal stemp1 nil))
)
(if (= zhz1 nil) (setq zhz1 nn)
(if (= zhz3 nil) (setq zhz3 nn))
)
)
(if (and (equal stemp2 " ")
(not (equal stemp1 " "))
(not (equal stemp1 nil))
)
(if (= zhz2 nil) (setq zhz2 (1- nn))
(if (= zhz4 nil) (setq zhz4 (1- nn)))
)
)
(if (equal stemp2 "%")
(setq tst "yes"
nn1 nn
)
)
(setq nn (1+ nn)
stemp1 stemp2
)
)
(if (= zhz4 nil) (setq zhz4 slen))
(setq py (atof (substr aa zhz3 (1+ (- zhz4 zhz3))))
str1 (substr aa zhz1 (1+ (- zhz2 zhz1)))
slen1 (strlen str1)
qq 1
)
(while (< qq slen1)
(setq tem1 (substr str1 qq 1))
(if (equal tem1 "+")
(progn (if (> qq 3)
(setq temp1 (atof (substr str1 (- qq 3) 3)))
(if (> qq 2)
(setq temp1 (atof (substr str1 (- qq 2) 2)))
(if (> qq 1)
(setq temp1 (atof (substr str1 (- qq 1) 1)))
)
)
)
(setq temp2 (atof (substr str1 (1+ qq) (- slen1 qq))))
)
)
(setq qq (1+ qq))
)
(setq px (/ (+ (* temp1 100) temp2) 10))
(if (equal tst "yes")
(setq wstr (substr aa (1+ nn1) (- slen nn1))
lwstr (append lwstr (list wstr px py))
)
)
)
)
)
)
(setq ptemp (list px py))
(if (and (boundp 'px) (boundp 'py))
(progn (if (< px xmin) (setq xmin px))
(if (> px xmax) (setq xmax px))
(if (< py ymin) (setq ymin py))
(if (> py ymax) (setq ymax py))
(if (or (= temp2 00.0000) (= temp2 20.0000) (= temp2 40.0000)
(= temp2 60.0000) (= temp2 80.0000))
(setq str2 (rtos py 2 2)
ltemp (append ltemp (list str1 str2 px))
)
)
)
)
(if (> bb 5) (if(= bb 6)(command "line" ptemp)(command ptemp)))
(setq bb (1+ bb))
)
(command "")
(setq ptemp1 (list (- xmin 1) ymin)
ptemp2 (list (+ xmax 1) ymax)
)
(gc)
(huitu ptemp1 ptemp2)
(close rf)
(setq aa 1
bb 1
)
(command "layer" "set" "文本" "")
(while (/= px nil)
(setq temp1 (nth (1- bb) ltemp)
temp2 (nth bb ltemp)
px (nth (1+ bb) ltemp)
ptmp1 (list px (- (cadr ptemp1) 15.5))
ptmp2 (list px (- (cadr ptemp1) 14.0))
)
(if (/= px nil) (progn (command "text" "s" "txt" ptmp1 0.22 90 temp1)
(command "text" "s" "txt" ptmp2 0.22 90 temp2)
(setq bb (+ bb 3))
)
)
)
(setq bb 1
px 1
)
(while (/= px nil)
(setq px (nth bb lwstr))
(if (/= nil px) (progn (setq wstr (strcat "%%u" (nth (1- bb) lwstr) "%%u" )
py (nth (1+ bb) lwstr)
wgch (rtos py 2 3)
ptmp1 (list px (- (cadr ptemp2) 4.0))
ptmp2 (list px (- (cadr ptemp1) 15.5))
ptmp3 (list px (- (cadr ptemp1) 14.0))
)
(if (= (fix px) px) (setq wzhh nil wgch nil)
(progn (while (> px 0) (setq px (- px 10)))
(setq zhh (rtos (* (+ px 10) 10) 2 2)
wzhh (strcat "+" zhh)
)
)
)
(command "text" "s" "st" ptmp1 0.3 90 wstr )
(command "text" "s" "txt" ptmp2 0.22 90 wzhh )
(command "text" "s" "txt" ptmp3 0.22 90 wgch )
(setq bb (+ bb 3))
)
)
)
(print " ")
)
(defun hdmht(p1 ldd wstr)
(setq nn 0
slen (length ldd)
lddn nil
)
(while (< nn slen)
(setq xmin 1000.0
bb 0
)
(while (< bb slen) (setq temp1 (- (car (nth bb ldd)) xmin))
(if (and (< temp1 0) (numberp (cdr (nth bb ldd))))
(setq xmin (car (nth bb ldd)))
)
(setq bb (1+ bb))
)
(if (numberp (cdr (assoc xmin ldd)))
(setq lddn (append lddn (list (assoc xmin ldd)))
oldd (assoc xmin ldd)
newd (list xmin "yes")
ldd (subst newd oldd ldd)
)
)
(setq nn (1+ nn))
)
(setq temp3 (cdr (assoc 0.000 lddn))
nn 0
p2 (list (car p1) (- (cadr p1) 0.5))
p3 (list (- (car p1) 1.0) (- (cadr p1) 1.8))
p4 (list (- (car p1) 0.05) (+ (cadr p1) 0.3))
)
(command "layer" "set" "地面线" "")
(repeat slen (setq ptemp (list (+ (car p1) (car (nth nn lddn)))
(+ (cadr p1) (- (cdr (nth nn lddn)) temp3))
)
nn (1+ nn)
)
(if(= nn 1)(command "line" ptemp)(command ptemp))
)
(command "")
(command "layer" "set" "文本" "")
(command "line" p2 "@0,1" "")
(command "line" p1 "@0.25,0.25" "@-0.5,0" "c")
(command "text" "s" "txt" p3 0.3 0 wstr)
(command "text" "s" "txt" p4 0.3 0 (rtos (cdr (assoc 0.00 lddn)) 2 2))
(gc)
)
(defun hdmshuru()
(setq rf (open f_name "r")
aa 1
bb 1
lzhh nil
lgch nil
)
(command "style" "txt" "romand" 0 1.0 0 "" "" "")
(command "style" "st" "c:\\windows\\fonts\\simsun.ttf" 0 1.0 0 "" "")
(setq pt (getpoint "\n please pick a base point to draw:"))
(while (boundp 'aa)
(setq aa (read-line rf)
nn 1
tst nil
stemp1 nil
)
(if (boundp 'aa)
(progn (setq slen (strlen aa) zhz1 nil zhz2 nil zhz3 nil zhz4 nil tst "no")
(if (> bb 5)
(progn (while (<= nn slen)
(setq stemp2 (substr aa nn 1))
(if (equal stemp2 "+")
(setq tst "yes")
)
(if (and (or (equal stemp1 " ") (equal stemp1 nil))
(not (equal stemp2 " "))
)
(if (= zhz1 nil) (setq zhz1 nn)
(if (= zhz3 nil) (setq zhz3 nn))
)
)
(if (and (equal stemp2 " ")
(not (equal stemp1 " "))
(not (equal stemp1 nil))
)
(if (= zhz2 nil) (setq zhz2 (1- nn))
(if (= zhz4 nil) (setq zhz4 (1- nn)))
)
)
(setq stemp1 stemp2
nn (1+ nn)
)
)
(if (= zhz4 nil) (setq zhz4 slen))
(if (equal tst "yes")
(setq lzhh (append lzhh (list (substr aa zhz1 (1+ (- zhz2 zhz1)))))
lgch (append lgch (list (cons 0.000
(atof (substr aa zhz3 (1+ (- zhz4 zhz3))))
)
)
)
)
(setq lgch (append lgch (list (cons (atof (substr aa zhz1 (1+ (- zhz2 zhz1))))
(atof (substr aa zhz3 (1+ (- zhz4 zhz3))))
)
)
)
)
)
)
)
)
)
(setq bb (1+ bb))
)
(close rf)
(gc)
(setq bbc 0
aac 0
nnc 0
temp1 1
pt1 pt
ltemp nil
slen1 (length lgch)
no_1 0
)
(repeat slen1 (setq temp (car (nth nnc lgch))
nnc (1+ nnc)
)
(if (= 0.00 temp) (setq no_1 (1+ no_1)))
)
(while (<= bbc slen1)
(setq temp1 (car (nth bbc lgch))
temp2 (cdr (nth bbc lgch))
)
(if (boundp 'temp1)
(if (and (equal temp1 0.00) (/= bbc 0))
(progn (setq stemp1 (nth aac lzhh)
pt1 (list (car pt1) (+ (cadr pt1) 9.0))
pst (strcat " " stemp1 " " (rtos (1+ aac)) "of" (rtos no_1))
)
(print pst)
(gc)
(hdmht pt1 ltemp stemp1)
(setq ltemp (list (cons 0.00 temp2))
aac (1+ aac)
)
)
(setq ltemp (append ltemp (list (nth bbc lgch))))
)
(progn (setq stemp1 (nth aac lzhh)
pt1 (list (car pt1) (+ (cadr pt1) 9.0))
pst (strcat " " stemp1 " " (rtos (1+ aac)) "of" (rtos no_1))
)
(print pst)
(hdmht pt1 ltemp stemp1)
)
)
(setq bbc (1+ bbc))
)
(print " ")
)
(prompt "\n ")
(prompt "\n ")
(prompt "\n ")
(defun bzht()
(command "style" "txt" "romand" 0 1.0 0 "" "" "")
(command "style" "st" "c:\\windows\\fonts\\simsun.ttf" 0 1.0 0 "" "")
(command "linetype" "load" "dot" "acad" "")
(command)
(command "layer" "new" "虚线" "C" "9" "虚线" "L" "dot" "虚线"
"new" "地面线" "C" "red" "地面线" "L" "continuous" "地面线"
"new" "文本" "C" "green" "文本" "L" "continuous" "文本"
"new" "表格" "C" "cyan" "表格" "L" "continuous" "表格" "")
)

;;;   ****************************************程序说明************************************************* 
;;;   *                                                                                               * 
;;;   *         * 
;;;   *                                           * 
;;;   *                              * 
;;;   *                                   * 
;;;   *                                                                                               * 
;;;   ************************************************************************************************* 
      (defun on_dlg1 () 
           (setq biaohang (atoi (get_tile "cl_bl2")) 
                    gjzhj (get_tile "cl_gch1") 
                    dgchd (get_tile "cl_gch2") 
                    gjgsh (get_tile "cl_gch3") 
                  stscale (atoi (get_tile "cl_bl1")) 
                   b_biao (get_tile "cl_file") 
                   f_name (get_tile "cl_fname") 
                     hzdm (get_tile "cl_hzdm") 
                   gjzhj1 gjzhj 
                   gjgsh1 gjgsh 
                   dgchd1 dgchd 
           ) 
           (if (equal b_biao "1") 
               (progn (setq fil (findfile f_name)) 
                      (if fil (setq f_name fil) 
                              (progn (princ (strcat "\n 找不到数据文件" f_name "。请用对话框寻找！")) 
                                     (setq f_name (getfiled "目录表" "" "" 2)) 
                              ) 
                      ) 
               ) 
           ) 
           (gc) 
    ) 
    (defun huitu(p1 p2) 
           (setq topleft (list (- (car p1) 4.5) (- (cadr p1) 6.0)) 
                 topright (list (+ (car p2) 1.0) (- (cadr p1) 6.0)) 
                 pt1 topleft 
                 pt2 topright 
                 nn 0 
           ) 
           (command "layer" "set" "表格" "") 
           (command "rectang" "w" 0.05 (list (car topleft) (- (cadr topleft) 11.0)) topright) 
           (repeat 7 (setq dts (nth nn '(1.5 1.0 1.0 1.5 1.5 1.5 1.5))) 
                     (setq pt1 (list (car pt1) (- (cadr pt1) dts)) 
                           pt2 (list (car pt2) (- (cadr pt2) dts)) 
                           nn (+ nn 1) 
                     ) 
                     (command "line" pt1 pt2 "") 
           ) 
           (command "line" (list (car p1) (- (cadr p1) 6.0)) (list (car p1) (- (cadr p1) 17.0)) "") 
           (command "line" topleft (list (car p1) (- (cadr topleft) 1.5)) "") 
           (setq wth '("坡度(%)" "坡长(M)" "填    土" "挖    土" 
                       "路面设计高程" "路基设计高程" "地面高程" "桩     号" "平 曲 线") 
                 nn 0 
                 pt1 (list (- (car p1) 1.0) (- (cadr p1) 6.5)) 
                 dth '(1.0 1.25 1.5 1.5 1.5 1.5 0) 
           ) 
           (repeat 9 (setq wtt (nth nn wth)) 
                     (if (< nn 2) (xiezhi pt1 "st" 0.4 0 (nth nn wth)) 
                                  (xiezhi pt1 "st" 0.5 0 (nth nn wth)) 
                     ) 
                     (if (< nn 2) (if (= nn 0) (setq pt1 (list (- (car p1) 3.5) (- (cadr p1) 7.0))) 
                                               (setq pt1 (list (- (car p1) 2.25) (- (cadr p1) 8.0))) 
                                  ) 
                                  (setq pt1 (list (car pt1) (- (cadr pt1) (nth (- nn 2) dth)))) 
                     ) 
                     (setq nn (+ nn 1)) 
           ) 
           (setq bchmax (+ (fix (cadr p2)) 3) 
                 bchmin (- (fix (cadr p1)) 3) 
                 anv  (+ (- bchmax bchmin) 1) 
                 anh  (- (fix (car p2)) (fix (car p1))) 
           ) 
           (command "line" (list (car p1) bchmax) 
                           (list (car p1) bchmin) 
                           "@-0.2,0" 
                           (list (- (car p1) 0.2) bchmax) "c" 
           ) 
           (command "layer" "set" "虚线" "") 
           (command "line" (list (+ (fix (car p1)) 1) bchmin) 
                           (list (+ (fix (car p1)) 1) bchmax) "" 
           ) 
           (setq temp1 (cdar (entget (entlast)))) 
           (command "array" temp1 "" "r" 1 anh 1) 
           (command "line" (list (+ (fix (car p1)) 1) bchmax) 
                           (list (fix (car p2)) bchmax) "" 
           ) 
           (setq temp1 (cdar (entget (entlast)))) 
           (command "array" temp1 "" "r" anv 1 -1) 
           (command "layer" "set" "表格" "") 
           (setq ptem1 (list (- (car p1) 0.1) bchmax) 
                 ptem2 (list (car p1) bchmax) 
                 ptem3 (list (- (car p1) 0.1) (- bchmax 1)) 
                 ptem4 (list (car p1) (- bchmax 1)) 
                  lo 1 
           ) 
           (while (<= bchmin (cadr ptem4)) 
                  (command "solid" ptem1 ptem2 ptem3 ptem4 "") 
                  (setq ptem5 (list (- (car p1) 1.3) (cadr ptem1)) 
                          wth (rtos (cadr ptem1) 2 0) 
                  ) 
                  (command "text" "s" "txt" ptem5 0.3 0 wth) 
                  (if (= bchmin (cadr ptem4)) 
                      (progn (setq ptem5 (list (- (car p1) 1.3) (cadr ptem4)) 
                                     wth (rtos (cadr ptem4) 2 0) 
                             ) 
                             (command "text" "s" "txt" ptem5 0.3 0 wth) 
                      ) 
                  ) 
                  (if (= lo 1) (setq ptem1 (list (- (car ptem1) 0.1) (- (cadr ptem1) 1.0)) 
                                     ptem2 (list (- (car ptem2) 0.1) (- (cadr ptem2) 1.0)) 
                                     ptem3 (list (- (car ptem3) 0.1) (- (cadr ptem3) 1.0)) 
                                     ptem4 (list (- (car ptem4) 0.1) (- (cadr ptem4) 1.0)) 
                                        lo 0 
                               ) 
                               (setq ptem1 (list (+ (car ptem1) 0.1) (- (cadr ptem1) 1.0)) 
                                     ptem2 (list (+ (car ptem2) 0.1) (- (cadr ptem2) 1.0)) 
                                     ptem3 (list (+ (car ptem3) 0.1) (- (cadr ptem3) 1.0)) 
                                     ptem4 (list (+ (car ptem4) 0.1) (- (cadr ptem4) 1.0)) 
                                        lo 1 
                               ) 
                  ) 
           ) 
           (gc)                                           
    ) 
    (defun c:dhk() 
           (setvar "cmdecho" 0) 
           (setq dcl_id (load_dialog "duan.dcl")) 
           (if (not (new_dialog "cl_box1" dcl_id)) (exit)) 
           (set_tile "cl_bl2" "100") 
           (set_tile "cl_bl1" "1000") 
           (set_tile "cl_file" "1") 
           (if (/= nil gjzhj1) (progn (set_tile "cl_gch1" gjzhj1) 
                                      (set_tile "cl_gch2" dgchd1) 
                                      (set_tile "cl_gch3" gjgsh1) 
                               ) 
           ) 
           (mode_tile "cl_gch1" 1) 
           (mode_tile "cl_gch2" 1) 
           (mode_tile "cl_gch3" 1) 
           (action_tile "cl_file" "(mode_tile \"cl_gch1\" 1) 
                                       (mode_tile \"cl_fname\" 0) 
                                       (mode_tile \"cl_gch2\" 1) 
                                       (mode_tile \"cl_gch3\" 1)") 
           (action_tile "cl_screen" "(mode_tile \"cl_gch1\" 0) 
                                      (mode_tile \"cl_gch2\" 0) 
                                       (mode_tile \"cl_fname\" 1) 
                                      (mode_tile \"cl_gch3\" 0)") 
           (action_tile "cancel" "(done_dialog 0)") 
           (action_tile "accept" "(on_dlg1)(done_dialog 1)") 
           (setq w_1 (start_dialog)) 
           (bzht) 
           (if (= w_1 1) (if (equal b_biao "1") (if (equal hzdm "1") (zdmshuru) 
                                                                     (hdmshuru) 
                                                ) 
                                                (prompt " ") 
                         ) 
                         (print " ") 
           ) 
           (unload_dialog dcl_id) 
           (setvar "cmdecho" 1) 
    ) 
    (defun xiezhi (wp ss h r wtxt) 
           (command "text" "s" ss "m" wp h r wtxt) 
    ) 
    (defun zdmshuru() 
           (setq rf (open f_name "r") 
                 aa 1 
                 bb 1 
                 xmax -100.00 
                 xmin 10000.00 
                 ymax -100.00 
                 ymin 10000.00 
                 temp1 0.0 
                 ltemp nil 
                 lwstr nil 
           ) 
           (command "layer" "set" "地面线" "") 
           (while (boundp 'aa) 
                  (setq aa (read-line rf) 
                        nn 1 
                       tst "no" 
                    stemp1 nil 
                  ) 
                  (if (boundp 'aa) 
                      (progn (setq slen (strlen aa) zhz1 nil zhz2 nil zhz3 nil zhz4 nil str1 nil) 
                             (if (> bb 5) 
                                 (progn (while (<= nn slen) 
                                               (setq stemp2 (substr aa nn 1)) 
                                               (if (and (not (equal stemp2 " ")) 
                                                        (or (equal stemp1 " ") (equal stemp1 nil)) 
                                                   ) 
                                                   (if (= zhz1 nil) (setq zhz1 nn) 
                                                                    (if (= zhz3 nil) (setq zhz3 nn)) 
                                                   ) 
                                               ) 
                                               (if (and (equal stemp2 " ") 
                                                        (not (equal stemp1 " ")) 
                                                        (not (equal stemp1 nil)) 
                                                   ) 
                                                   (if (= zhz2 nil) (setq zhz2 (1- nn)) 
                                                                    (if (= zhz4 nil) (setq zhz4 (1- nn))) 
                                                   ) 
                                               ) 
                                               (if (equal stemp2 "%") 
                                                   (setq tst "yes" 
                                                         nn1 nn 
                                                   ) 
                                               ) 
                                               (setq     nn (1+ nn) 
                                                     stemp1 stemp2 
                                               ) 
                                        ) 
                                        (if (= zhz4 nil) (setq zhz4 slen)) 
                                        (setq py    (atof (substr aa zhz3 (1+ (- zhz4 zhz3)))) 
                                              str1  (substr aa zhz1 (1+ (- zhz2 zhz1))) 
                                              slen1 (strlen str1) 
                                              qq    1 
                                        ) 
                                        (while (< qq slen1) 
                                               (setq tem1 (substr str1 qq 1)) 
                                               (if (equal tem1 "+") 
                                                   (progn (if (> qq 3) 
                                                              (setq temp1 (atof (substr str1 (- qq 3) 3))) 
                                                              (if (> qq 2) 
                                                                  (setq temp1 (atof (substr str1 (- qq 2) 2))) 
                                                                  (if (> qq 1) 
                                                                      (setq temp1 (atof (substr str1 (- qq 1) 1))) 
                                                                  ) 
                                                              ) 
                                                          ) 
                                                          (setq temp2 (atof (substr str1 (1+ qq) (- slen1 qq)))) 
                                                   ) 
                                               ) 
                                               (setq qq (1+ qq)) 
                                        ) 
                                        (setq px (/ (+ (* temp1 100) temp2) 10)) 
                                        (if (equal tst "yes") 
                                            (setq wstr (substr aa (1+ nn1) (- slen nn1)) 
                                                  lwstr (append lwstr (list wstr px py)) 
                                            ) 
                                        ) 
                                 ) 
                             ) 
                      ) 
                  ) 
                  (setq ptemp (list px py)) 
                  (if (and (boundp 'px) (boundp 'py)) 
                      (progn (if (< px xmin) (setq xmin px)) 
                             (if (> px xmax) (setq xmax px)) 
                             (if (< py ymin) (setq ymin py)) 
                             (if (> py ymax) (setq ymax py)) 
                             (if (or (= temp2 00.0000) (= temp2 20.0000) (= temp2 40.0000) 
                                     (= temp2 60.0000) (= temp2 80.0000)) 
                                 (setq str2 (rtos py 2 2) 
                                       ltemp (append ltemp (list str1 str2 px)) 
                                 ) 
                             ) 
                      ) 
                  ) 
                  (if (> bb 5) (if(= bb 6)(command "line" ptemp)(command ptemp))) 
                  (setq bb (1+ bb)) 
           ) 
           (command "") 
           (setq ptemp1 (list (- xmin 1) ymin) 
                 ptemp2 (list (+ xmax 1) ymax) 
           ) 
           (gc) 
           (huitu ptemp1 ptemp2) 
           (close rf) 
           (setq aa 1 
                 bb 1 
           ) 
           (command "layer" "set" "文本" "") 
           (while (/= px nil) 
                  (setq temp1 (nth (1- bb) ltemp) 
                        temp2 (nth bb ltemp) 
                        px (nth (1+ bb) ltemp) 
                        ptmp1 (list px (- (cadr ptemp1) 15.5)) 
                        ptmp2 (list px (- (cadr ptemp1) 14.0)) 
                  ) 
                  (if (/= px nil) (progn (command "text" "s" "txt" ptmp1 0.22 90 temp1) 
                                         (command "text" "s" "txt" ptmp2 0.22 90 temp2) 
                                         (setq bb (+ bb 3)) 
                                  ) 
                  ) 
           ) 
           (setq bb 1 
                 px 1 
           ) 
           (while (/= px nil) 
                  (setq px (nth bb lwstr)) 
                  (if (/= nil px) (progn (setq wstr (strcat "%%u" (nth (1- bb) lwstr) "%%u" ) 
                                                 py (nth (1+ bb) lwstr) 
                                               wgch (rtos py 2 3) 
                                              ptmp1 (list px (- (cadr ptemp2) 4.0)) 
                                              ptmp2 (list px (- (cadr ptemp1) 15.5)) 
                                              ptmp3 (list px (- (cadr ptemp1) 14.0)) 
                                         ) 
                                         (if (= (fix px) px) (setq wzhh nil wgch nil) 
                                                             (progn (while (> px 0) (setq px (- px 10))) 
                                                                    (setq zhh (rtos (* (+ px 10) 10) 2 2) 
                                                                         wzhh (strcat "+" zhh) 
                                                                    ) 
                                                             ) 
                                         ) 
                                         (command "text" "s" "st" ptmp1 0.3 90 wstr ) 
                                         (command "text" "s" "txt" ptmp2 0.22 90 wzhh ) 
                                         (command "text" "s" "txt" ptmp3 0.22 90 wgch ) 
                                         (setq bb (+ bb 3)) 
                                  ) 
                  ) 
           ) 
           (print " ")         
    ) 
    (defun hdmht(p1 ldd wstr) 
           (setq nn 0 
               slen (length ldd) 
               lddn nil 
           ) 
           (while (< nn slen) 
                  (setq xmin 1000.0 
                        bb 0 
                  ) 
                  (while (< bb  slen) (setq temp1 (- (car (nth bb ldd)) xmin)) 
                                      (if (and (< temp1 0) (numberp (cdr (nth bb ldd)))) 
                                          (setq xmin (car (nth bb ldd))) 
                                      ) 
                                      (setq bb (1+ bb)) 
                  ) 
                  (if (numberp (cdr (assoc xmin ldd))) 
                      (setq  lddn (append lddn (list (assoc xmin ldd))) 
                             oldd (assoc xmin ldd) 
                             newd (list xmin "yes") 
                              ldd (subst newd oldd ldd) 
                      ) 
                  ) 
                  (setq nn (1+ nn)) 
           ) 
           (setq temp3 (cdr (assoc 0.000 lddn)) 
                    nn 0 
                    p2 (list (car p1) (- (cadr p1) 0.5)) 
                    p3 (list (- (car p1) 1.0) (- (cadr p1) 1.8)) 
                    p4 (list (- (car p1) 0.05) (+ (cadr p1) 0.3)) 
           ) 
           (command "layer" "set" "地面线" "") 
           (repeat slen (setq ptemp (list (+ (car p1) (car (nth nn lddn))) 
                                          (+ (cadr p1) (- (cdr (nth nn lddn)) temp3)) 
                                    ) 
                                 nn (1+ nn) 
                        ) 
                        (if(= nn 1)(command "line" ptemp)(command ptemp)) 
           ) 
           (command "") 
           (command "layer" "set" "文本" "") 
           (command "line" p2 "@0,1" "") 
           (command "line" p1 "@0.25,0.25" "@-0.5,0" "c") 
           (command "text" "s" "txt" p3 0.3 0 wstr) 
           (command "text" "s" "txt" p4 0.3 0 (rtos (cdr (assoc 0.00 lddn)) 2 2)) 
           (gc)            
     )   
    (defun hdmshuru() 
            (setq rf (open f_name "r") 
                 aa 1 
                 bb 1 
               lzhh nil 
               lgch nil 
           ) 
           (command "style" "txt" "romand" 0 1.0 0 "" "" "") 
           (command "style" "st" "c:\\windows\\fonts\\simsun.ttf" 0 1.0 0 "" "") 
           (setq pt (getpoint "\n please pick a base point to draw:")) 
           (while (boundp 'aa) 
                  (setq aa (read-line rf) 
                        nn 1 
                        tst nil 
                     stemp1 nil 
                  ) 
                  (if (boundp 'aa) 
                      (progn (setq slen (strlen aa) zhz1 nil zhz2 nil zhz3 nil zhz4 nil tst "no") 
                             (if (> bb 5) 
                                 (progn (while (<= nn slen) 
                                               (setq stemp2 (substr aa nn 1)) 
                                               (if (equal stemp2 "+") 
                                                   (setq tst "yes") 
                                               ) 
                                               (if (and (or (equal stemp1 " ") (equal stemp1 nil)) 
                                                        (not (equal stemp2 " ")) 
                                                   ) 
                                                   (if (= zhz1 nil) (setq zhz1 nn) 
                                                                    (if (= zhz3 nil) (setq zhz3 nn)) 
                                                   ) 
                                               ) 
                                               (if (and (equal stemp2 " ") 
                                                        (not (equal stemp1 " ")) 
                                                        (not (equal stemp1 nil)) 
                                                   ) 
                                                   (if (= zhz2 nil) (setq zhz2 (1- nn)) 
                                                                    (if (= zhz4 nil) (setq zhz4 (1- nn))) 
                                                   ) 
                                               ) 
                                               (setq stemp1 stemp2 
                                                     nn (1+ nn) 
                                               ) 
                                        ) 
                                        (if (= zhz4 nil) (setq zhz4 slen)) 
                                        (if (equal tst "yes") 
                                            (setq lzhh (append lzhh (list (substr aa zhz1 (1+ (- zhz2 zhz1))))) 
                                                  lgch (append lgch (list (cons 0.000 
                                                                                (atof (substr aa zhz3 (1+ (- zhz4 zhz3)))) 
                                                                           ) 
                                                                    ) 
                                                       ) 
                                            ) 
                                            (setq lgch (append lgch (list (cons (atof (substr aa zhz1 (1+ (- zhz2 zhz1)))) 
                                                                                (atof (substr aa zhz3 (1+ (- zhz4 zhz3)))) 
                                                                          ) 
                                                                    ) 
                                                       ) 
                                            ) 
                                        ) 
                                 ) 
                             ) 
                      ) 
                  ) 
                  (setq bb (1+ bb)) 
           ) 
           (close rf) 
           (gc) 
           (setq    bbc 0 
                    aac 0 
                    nnc 0 
                 temp1 1 
                   pt1 pt 
                ltemp nil 
                slen1 (length lgch) 
                no_1 0 
           ) 
           (repeat slen1 (setq temp (car (nth nnc lgch)) 
                                nnc (1+ nnc) 
                        ) 
                        (if (= 0.00 temp) (setq no_1 (1+ no_1))) 
           ) 
           (while (<= bbc slen1)                      
                  (setq temp1 (car (nth bbc lgch)) 
                        temp2 (cdr (nth bbc lgch)) 
                  ) 
                  (if (boundp 'temp1) 
                      (if (and (equal temp1 0.00) (/= bbc 0)) 
                          (progn (setq stemp1 (nth aac lzhh) 
                                      pt1 (list (car pt1) (+ (cadr pt1) 9.0)) 
                                      pst (strcat "   " stemp1 "   " (rtos (1+ aac)) "of" (rtos no_1)) 
                                 ) 
                                 (print pst) 
                                 (gc) 
                                 (hdmht pt1 ltemp stemp1) 
                                 (setq  ltemp (list (cons 0.00 temp2)) 
                                             aac (1+ aac) 
                                 ) 
                          ) 
                          (setq ltemp (append ltemp (list (nth bbc lgch)))) 
                      ) 
                      (progn (setq stemp1 (nth aac lzhh) 
                                      pt1 (list (car pt1) (+ (cadr pt1) 9.0)) 
                                      pst (strcat "   " stemp1 "   " (rtos (1+ aac)) "of" (rtos no_1)) 
                             ) 
                             (print pst) 
                             (hdmht pt1 ltemp stemp1) 
                      ) 
                  ) 
                  (setq bbc (1+ bbc)) 
           ) 
           (print " ") 
    ) 
(prompt "\n   ") 
(prompt "\n   ") 
(prompt "\n   ") 
    (defun bzht() 
           (command "style" "txt" "romand" 0 1.0 0 "" "" "") 
           (command "style" "st" "c:\\windows\\fonts\\simsun.ttf" 0 1.0 0 "" "") 
           (command "linetype" "load" "dot" "acad" "") 
           (command) 
           (command "layer" "new" "虚线" "C" "9" "虚线" "L" "dot" "虚线" 
                            "new" "地面线" "C" "red" "地面线" "L" "continuous" "地面线" 
                            "new" "文本" "C" "green" "文本" "L" "continuous" "文本" 
                            "new" "表格" "C" "cyan" "表格" "L" "continuous" "表格" "") 
    )

gzxl · 发表于 2013-5-14 12:02:34

这么长的代码看的好晕，没数据格式文件和duan.dcl文件........

quanguang · 发表于 2013-5-14 13:26:40

是楼主自己写的吗？
建议吧相关的文件附上，然后写个程序说明，至少让别人知道你这个程序是做什么用的，别人也好调试

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

[提问] 求LISP高手看看下面程序为何运行错误，帮忙改正下，谢谢！！！

本帖子中包含更多资源