错误：错误的参数类型：stri
我在网上找到的Lisp程序。。。当我运行它时，会弹出这个错误有什么帮助吗？
; Legend - EMT Software Inc., by Scott Hull 04/18/01
;
(defun C:LEGEND (/ #ALERT #DCL-FILE #DCL-ID #DCL-LIST #GO #HELP #LEGEND-BLOCK
#LEGEND-LAYER #LINENO @ALERT @DWGLYRS @LAYER @LIST @LEGEND-DRAW
@LEGEND-READ @LEGEND-WRITE *error*)
(setq #DCL-LIST (list
"legend : dialog {"
" key = \"title\";"
" label = \"Legend Generator\";"
" : boxed_column {"
" label = \"&Layers\";"
" : concatenation {"
" : text_part {"
" label = \"Name\";"
" width = 19;"
" }"
" : text_part {"
" label = \"Legend\";"
" width = 9;"
" }"
" : text_part {"
" label = \"Description\";"
" }"
" }"
" : list_box {"
" height = 8;"
" key = \"layer\";"
" tabs = \"19 28\";"
" width = 70;"
" }"
" : row {"
" : edit_box {"
" edit_width = 60;"
" fixed_width = true;"
" key = \"descp-layer\";"
" label = \"&Description:\";"
" }"
" }"
" }"
" : boxed_column {"
" label = \"&Blocks\";"
" : concatenation {"
" : text_part {"
" label = \"Name\";"
" width = 19;"
" }"
" : text_part {"
" label = \"Legend\";"
" width = 9;"
" }"
" : text_part {"
" label = \"Description\";"
" }"
" }"
" : list_box {"
" height = 8;"
" key = \"block\";"
" tabs = \"19 28\";"
" width = 70;"
" }"
" : row {"
" : edit_box {"
" edit_width = 60;"
" fixed_width = true;"
" key = \"descp-block\";"
" label = \"&Description:\";"
" }"
" }"
" }"
" ok_cancel_help_cadalog_errtile;"
"}"
""
"cadalog_button : retirement_button {"
" key = \"cadalog\";"
" label = \"&CADalog.com...\";"
"}"
""
"ok_cancel_help_cadalog : column {"
" : row {"
" fixed_width = true;"
" alignment = centered;"
" ok_button;"
" : spacer {"
" width = 2;"
" }"
" cancel_button;"
" : spacer {"
" width = 2;"
" }"
" help_button;"
" : spacer {"
" width = 2;"
" }"
" cadalog_button;"
" }"
"}"
""
"ok_cancel_help_cadalog_errtile : column {"
" ok_cancel_help_cadalog;"
" errtile;"
"}"))
(setq #HELP (strcat
"Legend Generator\n\n"
"Allows you to add text descriptions to create a legend for blocks and \n"
"layers. The programs stores descriptions in two files, legend-block.tbl \n"
"and legend-layer.tbl so they can be reused later.\n\n"
"Blocks and layers that are present in the current drawing or in an XREF \n"
"can be used but XREF blocks and linetypes that cannot be found in the \n"
"current drawing table will not display in the legend. Instead, any blocks \n"
"that are not found will have a text marker placed in the legend, and any \n"
"linetypes that are not found will use the CONTINUOUS linetype.\n\n"
"The text for the legend is based on the current setting of the AutoCAD \n"
"TEXTSIZE system variable. Block scales are derived from existing blocks \n"
"used in the drawing.\n\n"
"You can enter different descriptions for blocks and layers in XREFs that \n"
"use the same name as the base drawing but the descriptions from the base \n"
"drawing will take precedence when the legend program writes the two tbl \n"
"files for later use."))
(if (not V:LEGEND_DIR)
(setq V:LEGEND_DIR
(strcat (vl-filename-directory (findfile "legend.lsp")) "\\")))
(defun *error* (%A)
(if (= (type V:FILE) 'FILE) (close V:FILE))
(cond
((= %A "Function cancelled") nil)
((and V:FILENAME (= %A "malformed string"))
(princ (strcat "\nerror: check file - " V:FILENAME)))
(t (princ (strcat "\nerror: " %A "\007\n"))))
(princ))
(defun @ALERT0 (%STR)
(if (not #ALERT) (setq #ALERT ""))
(setq #ALERT
(strcat #ALERT "Linetype " %STR " is not loaded - used CONTINUOUS\n")))
(defun @ALERT1 (%STR)
(if (not #ALERT) (setq #ALERT ""))
(setq #ALERT
(strcat #ALERT "Block " %STR " is not loaded - used text w/block name\n")))
(defun @BASE (%A / #POS)
(setq #POS (vl-string-position 124 %A))
(if #POS (substr %A (+ #POS 2)) %A))
(defun @FORMAT (%A / #CHR #COUNT #LEN #STR)
(setq #COUNT 0 #LEN (strlen %A) #STR "")
(repeat #LEN
(setq #COUNT (1+ #COUNT) #CHR (substr %A #COUNT 1))
(if (= #CHR "\"") (setq #CHR "\\\""))
(setq #STR (strcat #STR #CHR)))
(eval #STR))
(defun @DWGLYRS (/ #LINE #LYR #LYRNAME #X1 #X2)
(setq #LYR (tblnext "layer" 1))
(while #LYR
(setq #LYRNAME (strcase (cdr (assoc 2 #LYR))))
(if (setq #LINE (assoc (@BASE #LYRNAME) (cdr TBL:LEGEND-LAYER)))
(setq #LEGEND-LAYER (cons (list #LYRNAME (cadr #LINE) (caddr #LINE)) #LEGEND-LAYER))
(setq #LEGEND-LAYER (cons (list #LYRNAME 0 "") #LEGEND-LAYER)))
(setq #LYR (tblnext "layer")))
(setq #LEGEND-LAYER
(vl-sort #LEGEND-LAYER (function (lambda (#X1 #X2) (< (car #X1) (car #X2)))))))
(defun @DWGBLKS (/ #LINE #BLK #BLKNAME #X1 #X2)
(setq #BLK (tblnext "block" 1))
(while #BLK
(setq #BLKNAME (strcase (cdr (assoc 2 #BLK))))
(cond
((assoc 1 #BLK) nil)
((= (substr (@BASE #BLKNAME) 1 2) "*U") nil)
((setq #LINE (assoc (@BASE #BLKNAME) (cdr TBL:LEGEND-BLOCK)))
(setq #LEGEND-BLOCK (cons (list #BLKNAME (cadr #LINE) (caddr #LINE)) #LEGEND-BLOCK)))
(T (setq #LEGEND-BLOCK (cons (list #BLKNAME 0 "") #LEGEND-BLOCK))))
(setq #BLK (tblnext "block")))
(if #LEGEND-BLOCK (setq #LEGEND-BLOCK
(vl-sort #LEGEND-BLOCK (function (lambda (#X1 #X2) (< (car #X1) (car #X2))))))))
;draw legend
(defun @LEGEND-DRAW (/ #CLAYER #PT0 #PT1 #SCALE #TEXTSIZE #X
@DRAWBLK @DRAWLINE @DRAWTXT @INSERT)
(setvar "cmdecho" 0)
(setq #CLAYER (getvar "clayer")
#TEXTSIZE (getvar "textsize"))
;%A - block name
(defun @DRAWBLK (%BLKNAME / #0 #BLK #DATA #EXIST #LYR #SCALE #SIZE #SS #TMP @SIZE)
(defun @SIZE (%ENT / #MAXP #MINP)
(vla-getboundingbox (vlax-ename->vla-object %ENT) '#MINP '#MAXP)
(setq #MINP (vlax-safearray->list #MINP)
#MAXP (vlax-safearray->list #MAXP))
(- (cadr #MAXP) (cadr #MINP)))
(setq #BLK (@BASE %BLKNAME)
#EXIST (tblsearch "block" #BLK)
#SS (ssget "_X" (list (cons 2 #BLK))))
(if #SS
(setq #0 (ssname #SS 0)
#DATA (entget #0)
#LYR (cdr (assoc 8 #DATA))
#SCALE (cdr (assoc 41 #DATA))))
(cond
((not #EXIST)
(@ALERT1 #BLK)
(@DRAWTXT "m" (polar #PT1 0 (* #TEXTSIZE 6.5)) #BLK)
(@DRAWTXT "ml" (polar #PT1 0 (* #TEXTSIZE 15)) #TEXT)
(setq #PT1 (polar #PT1 (* 1.5 pi) (* #TEXTSIZE 4))))
((and #EXIST (not #0))
(setq #SCALE 1.0 #SIZE #TEXTSIZE #LYR (getvar "celayer"))
(@INSERT #BLK #PT1 #LYR #SCALE))
(#0
(if (not vla-getboundingbox) (vl-load-com))
(setq #SIZE (@SIZE #0))
(if (> #SIZE (setq #TMP (* 3 #TEXTSIZE)))
(setq #PT1 (polar #PT1 (* 1.5 pi) (setq #TMP (* 0.5 (- #SIZE #TMP)))))
(setq #TMP nil))
(@INSERT #BLK #PT1 #LYR #SCALE)
(@DRAWTXT "ml" (polar #PT1 0 (* #TEXTSIZE 15)) #TEXT)
(if #TMP
(setq #PT1 (polar #PT1 (* 1.5 pi) (+ (* #TEXTSIZE 4) #TMP)))
(setq #PT1 (polar #PT1 (* 1.5 pi) (* #TEXTSIZE 4)))))))
(defun @INSERT (%BLK %PT %LYR %SCALE / #CECOLOR #CELTYPE #COLOR #DATA
#LTYPE)
(setq #CECOLOR (getvar "cecolor")
#CELTYPE (getvar "celtype")
#DATA (tblsearch "layer" %LYR)
#COLOR (cdr (assoc 62 #DATA))
#LTYPE (@BASE (cdr (assoc 6 #DATA))))
(if (not (tblsearch "ltype" #LTYPE))
(progn
(@ALERT0 #LTYPE)
(setq #LTYPE "CONTINUOUS")))
(if (= (type #COLOR) 'INT) (setq #COLOR (itoa #COLOR)))
(setvar "cecolor" #COLOR)
(setvar "celtype" #LTYPE)
(command "_.insert" %BLK "_none" (polar %PT 0 (* #TEXTSIZE 6.5)) %SCALE %SCALE 0)
(setvar "cecolor" #CECOLOR)
(setvar "celtype" #CELTYPE))
;draw line
(defun @DRAWLINE (%LYR %PT / #CECOLOR #CELTYPE #COLOR #DATA #LTYPE)
(setq #CECOLOR (getvar "cecolor")
#CELTYPE (getvar "celtype")
#DATA (tblsearch "layer" %LYR)
#COLOR (cdr (assoc 62 #DATA))
#LTYPE (@BASE (cdr (assoc 6 #DATA))))
(if (not (tblsearch "ltype" #LTYPE))
(progn
(@ALERT0 #LTYPE)
(setq #LTYPE "CONTINUOUS")))
(if (= (type #COLOR) 'INT) (setq #COLOR (itoa #COLOR)))
(setvar "cecolor" #COLOR)
(setvar "celtype" #LTYPE)
(command "_.line" "_none" %PT "_none" (polar %PT 0 (* #TEXTSIZE 13)) "")
(setvar "cecolor" #CECOLOR)
(setvar "celtype" #CELTYPE))
;draw text
(defun @DRAWTXT (%JUST %PT %TXT)
(if (= (cdr (assoc 40 (tblsearch "style" (getvar "textstyle")))) 0.0)
(command "_.text" (strcat "_" %JUST) "_none" %PT "" 0 %TXT)
(command "_.text" (strcat "_" %JUST) "_none" %PT 0 %TXT)))
(initget 1)
(setq #PT0 (getpoint "\nLegend insert point: ")
#PT1 (polar #PT0 (* 1.5 pi) (* #TEXTSIZE 4)))
(@DRAWTXT "m" (polar #PT0 0 (* #TEXTSIZE 14)) "LEGEND")
(foreach #X #LEGEND-LAYER
(if (= (cadr #X) 1)
(progn
(if (= (setq #TEXT (caddr #X)) "") (setq #TEXT "???"))
(@DRAWLINE (car #X) #PT1)
(@DRAWTXT "ml" (polar #PT1 0 (* #TEXTSIZE 15)) #TEXT)
(setq #PT1 (polar #PT1 (* 1.5 pi) (* #TEXTSIZE 4))))))
(foreach #X #LEGEND-BLOCK
(if (= (cadr #X) 1)
(progn
(if (= (setq #TEXT (caddr #X)) "") (setq #TEXT "???"))
(@DRAWBLK (car #X))))))
;write legend table
(defun @LEGEND-WRITE-LAYER (%LGND / #BASE #LEGEND2 #X)
(setq #LEGEND2 %LGND
V:FILENAME (strcat V:LEGEND_DIR "legend-layer.tbl")
V:FILE (open V:FILENAME "w"))
(foreach #X (cdr TBL:LEGEND-LAYER)
(if (not (assoc (car #X) #LEGEND2))
(setq #LEGEND2 (append #LEGEND2 (list #X)))))
(write-line "\"LAYER\" \"LEGEND\" \"DESCP\"" V:FILE)
(foreach #X #LEGEND2
(setq #BASE (@BASE (car #X)))
(if (and
(/= (caddr #X) "")
(or (= #BASE (car #X)) (not (assoc #BASE #LEGEND2))))
(write-line
(strcat "\"" (@BASE (car #X)) "\" "
(itoa (cadr #X)) " \"" (@FORMAT (caddr #X)) "\"")
V:FILE)))
(close V:FILE))
(defun @LEGEND-WRITE-BLOCK (%LGND / #BASE #LEGEND2 #X)
(setq #LEGEND2 %LGND
V:FILENAME (strcat V:LEGEND_DIR "legend-block.tbl")
V:FILE (open V:FILENAME "w"))
(foreach #X (cdr TBL:LEGEND-BLOCK)
(if (not (assoc (car #X) #LEGEND2))
(setq #LEGEND2 (append #LEGEND2 (list #X)))))
(write-line "\"BLOCK\" \"LEGEND\" \"DESCP\"" V:FILE)
(foreach #X #LEGEND2
(setq #BASE (@BASE (car #X)))
(if (and
(/= (caddr #X) "")
(or (= #BASE (car #X)) (not (assoc #BASE #LEGEND2))))
(write-line
(strcat "\"" #BASE "\" "
(itoa (cadr #X)) " \"" (@FORMAT (caddr #X)) "\"")
V:FILE)))
(close V:FILE))
;sets table and returns current legend table as a list
(defun @LEGEND-GET-LAYER (/ @TABLE V:FILE V:FILENAME)
(defun @TABLE (/ #A #B #C #FILE)
(setq #A T
#FILE "legend-layer.tbl"
V:FILENAME (findfile #FILE)
V:FILE (open V:FILENAME "r"))
(while #A
(setq #A (read-line V:FILE))
(cond
((and #A (/= (substr #A 1 1) ";")
(setq #C (read (strcat "(" #A ")"))))
(setq #B (cons #C #B)))))
(close V:FILE)
(reverse #B))
(if (findfile "legend-layer.tbl")
(setq TBL:LEGEND-LAYER (@TABLE))
(setq TBL:LEGEND-LAYER (list (list "LAYER" "LEGEND" "DESCP")))))
;sets table and returns current legend table as a list
(defun @LEGEND-GET-BLOCK (/ @TABLE V:FILE V:FILENAME)
(defun @TABLE (/ #A #B #C #FILE)
(setq #A T
#FILE "legend-block.tbl"
V:FILENAME (findfile #FILE)
V:FILE (open V:FILENAME "r"))
(while #A
(setq #A (read-line V:FILE))
(cond
((and #A (/= (substr #A 1 1) ";")
(setq #C (read (strcat "(" #A ")"))))
(setq #B (cons #C #B)))))
(close V:FILE)
(reverse #B))
(if (findfile "legend-block.tbl")
(setq TBL:LEGEND-BLOCK (@TABLE))
(setq TBL:LEGEND-BLOCK (list (list "BLOCK" "LEGEND" "DESCP")))))
(defun @LIST-LAYER (/ #X)
(start_list "layer")
(foreach #X #LEGEND-LAYER
(add_list (strcat (car #X) "\t" (if (= (cadr #X) 1) "X" "")
"\t" (caddr #X))))
(end_list))
(defun @LIST-BLOCK (/ #X)
(start_list "block")
(foreach #X #LEGEND-BLOCK
(add_list (strcat (car #X) "\t" (if (= (cadr #X) 1) "X" "")
"\t" (caddr #X))))
(end_list))
(defun @LAYER (%A %B %C / #CASR #CADDR #CHECK #LINE0 #LINE1)
(setq #LINENO (atoi %A)
#LINE0 (nth #LINENO #LEGEND-LAYER)
#CHECK (cadr #LINE0))
(cond
(%B
(mode_tile "descp-layer" #CHECK)
(setq #CADR (abs (1- #CHECK)) #CADDR (caddr #LINE0)))
(%C
(setq #CADR (cadr #LINE0) #CADDR %C))
(T
(mode_tile "descp-layer" (abs (1- #CHECK)))
(setq #CADR (cadr #LINE0) #CADDR (caddr #LINE0))))
(setq #LINE1
(list (car #LINE0) #CADR #CADDR)
#LEGEND-LAYER (subst #LINE1 #LINE0 #LEGEND-LAYER))
(@LIST-LAYER)
(set_tile "layer" %A)
(set_tile "descp-layer" (caddr (nth #LINENO #LEGEND-LAYER)))
(if (and %A (= #CHECK 0)) (mode_tile "descp-layer" 2)))
(defun @BLOCK (%A %B %C / #CHECK #LINE0 #LINE1)
(setq #LINENO (atoi %A)
#LINE0 (nth #LINENO #LEGEND-BLOCK)
#CHECK (cadr #LINE0))
(cond
(%B
(mode_tile "descp-block" #CHECK)
(setq #CADR (abs (1- #CHECK)) #CADDR (caddr #LINE0)))
(%C
(setq #CADR (cadr #LINE0) #CADDR %C))
(T
(mode_tile "descp-block" (abs (1- #CHECK)))
(setq #CADR (cadr #LINE0) #CADDR (caddr #LINE0))))
(setq #LINE1
(list (car #LINE0) #CADR #CADDR)
#LEGEND-BLOCK (subst #LINE1 #LINE0 #LEGEND-BLOCK))
(@LIST-BLOCK)
(set_tile "block" %A)
(set_tile "descp-block" (caddr (nth #LINENO #LEGEND-BLOCK)))
(if (and %A (= #CHECK 0)) (mode_tile "descp-block" 2)))
(if (not (findfile (setq #DCL-FILE (strcat V:LEGEND_DIR "legend.dcl"))))
(progn
(setq #FILE (open #DCL-FILE "w"))
(foreach #X #DCL-LIST (write-line #X #FILE))
(close #FILE)
(alert #HELP)))
(if (< (setq #DCL-ID (load_dialog "legend")) 0) (quit))
(if (not (new_dialog "legend" #DCL-ID)) (quit))
(@LEGEND-GET-LAYER)
(@LEGEND-GET-BLOCK)
(@DWGLYRS)
(@DWGBLKS)
(@LIST-LAYER)
(@LIST-BLOCK)
(@LAYER "0" nil nil)
(if #LEGEND-BLOCK
(@BLOCK "0" nil nil)
(progn (mode_tile "block" 1) (mode_tile "descp-block" 1)))
(set_tile "layer" "0")
(action_tile "accept" (strcat
"(@LEGEND-WRITE-LAYER #LEGEND-LAYER)"
"(@LEGEND-WRITE-BLOCK #LEGEND-BLOCK)"
"(done_dialog 1)"))
(action_tile "cadalog" "(done_dialog 2)")
(action_tile "descp-layer" "(@LAYER (itoa #LINENO) nil $value)")
(action_tile "descp-block" "(@BLOCK (itoa #LINENO) nil $value)")
(action_tile "help" "(alert #HELP)")
(action_tile "layer" "(@LAYER $value T nil)")
(action_tile "block" "(@BLOCK $value T nil)")
(setq #GO (start_dialog))
(cond
((= #GO 1)
(@LEGEND-DRAW)
(if #ALERT (alert #ALERT)))
((= #GO 2) (command "_.browser" "www.cadalog.com")))
(princ))
**************************************************************************
Legend.dcl
legend : dialog {
key = "title";
label = "Legend Generator";
: boxed_column {
label = "&Layers";
: concatenation {
: text_part {
label = "Name";
width = 19;
}
: text_part {
label = "Legend";
width = 9;
}
: text_part {
label = "Description";
}
}
: list_box {
height = 8;
key = "layer";
tabs = "19 28";
width = 70;
}
: row {
: edit_box {
edit_width = 60;
fixed_width = true;
key = "descp-layer";
label = "&Description:";
}
}
}
: boxed_column {
label = "&Blocks";
: concatenation {
: text_part {
label = "Name";
width = 19;
}
: text_part {
label = "Legend";
width = 9;
}
: text_part {
label = "Description";
}
}
: list_box {
height = 8;
key = "block";
tabs = "19 28";
width = 70;
}
: row {
: edit_box {
edit_width = 60;
fixed_width = true;
key = "descp-block";
label = "&Description:";
}
}
}
ok_cancel_help_cadalog_errtile;
}
cadalog_button : retirement_button {
key = "cadalog";
label = "&CADalog.com...";
}
ok_cancel_help_cadalog : column {
: row {
fixed_width = true;
alignment = centered;
ok_button;
: spacer {
width = 2;
}
cancel_button;
: spacer {
width = 2;
}
help_button;
: spacer {
width = 2;
}
cadalog_button;
}
}
ok_cancel_help_cadalog_errtile : column {
ok_cancel_help_cadalog;
errtile;
} 从这一点开始，dcl代码不是lisp代码，请删除并重试，这是上面代码的副本
**************************************************************************
传奇dcl 删除dcl代码后仍然存在错误。。。有什么建议吗？
将代码加载到VLIDE中。
从AutoCAD运行。
得到错误“error:bad参数类型：stringp nil”
现在回到VLIDE
选择查看>错误跟踪。
这将打开错误跟踪窗口。
在该窗口的第2行，您可以看到错误在这一行：
如果您右键单击那里，并选择Call Point Source，它会将您带到发生错误的代码行。
因此，该文件似乎必须另存为“Legend.lsp”，并位于支持文件搜索路径中。我这样做了，现在运行正常。
现在效果很好。。
谢谢rkmcswain，BIGAL
非常感谢
页:
[1]