从网上down了以下程序在ACAD2005中加载后,提示如下:
命令: APPLOAD 已成功加载 initest.lsp。
命令: ; 错误: 输入的列表有缺陷
LSP代码如下:
---------------------------------------------------------------------------------------
(defun c:initset ()
(setq flag 0)
(setq dcl-id (load-dialog "init.dcl"))
(if (not (new-dialog "init" dcl-id) (exit)) ;;begin if
(action-tile "list-size" "(list-size-cb $value)")
(action-tile "list-scale" "(scal-list-cb $value)")
(action-tile "accept" "(scal-accept-cb)")
(setq lisca' ("1:1" "1:1.5" "1:2" "1:2.5" "1:3" "1:4" "1:5" "2:1" "2.5:1" "3:1" "4:1" "5:1"))
(start-list "list-scale")
(mapcar' add-list lisca)
(end-list)
(set-tile "edit-scale" "1:1")
(setq lisize' ("A0 1189X841" "A1 841X594" "A2 594X420" "A3 420X297" "A4 210X297" "A5 210X148" "user用户自定义"))
(start-list "list-size")
(mapcar' add-list lisize)
(end-list)
(set-tile "edit-size" "A0")
(start-dialog)
(unload-dialog dcl-id)
(grclear)
(if (=flag 0)
(quit)
)
(sett x1 y1 a c name scale tfb)
) ;;end if
(defun scal-list-cb(scale-v) ; 比例对应回调函数
(set-tile "edit-scale" (setq tu (nth (atoi scale-v) lisca)))
)
(defun list-size-cb(tub1) ; 图幅对应回调函数
(if (=tub1 "0") (mapcar 'set' '(tu1 x1 y1 c) '("A0" 1189 841 10)))
(if (=tub1 "1") (mapcar 'set' '(tu1 x1 y1 c) '("A1" 841 594 10)))
(if (=tub1 "2") (mapcar 'set' '(tu1 x1 y1 c) '("A2" 594 420 10)))
(if (=tub1 "3") (mapcar 'set' '(tu1 x1 y1 c) '("A3" 420 297 10)))
(if (=tub1 "4") (mapcar 'set' '(tu1 x1 y1 c) '("A4" 210 297 5)))
(if (=tub1 "5") (mapcar 'set' '(tu1 x1 y1 c) '("A5" 210 148 5)))
(if (=tub1 "6") (progn (setq tu1 "user")
(define))) (set-tile "edit-size" tu1)
)
(defun scal-accept-cb(); OK对应回调函数
(setq scale (get-tile "edit-scale"))
(setq name (get-tile "st-0"))
(setq tufb (get-tile "edit-size"))
(setq tfb (get-tile "1-0"))
(setq ede (get-tile "e-0"))
(if (= ede "1") (setq a 25) (setq a 10))
(setq flag 1) (done-dialog 1)
)
(defun sett(x y a c name scale tfb1)
(setq 1 (strlen scale))
(setq n (substr scale 1 1))
(if (> n "1")
(progn
(setq 11 (-1 2))
(setq scale1 (/1.0 (atof (substr scale 1 11))))
)
(setq scale1 (atof (substr scale 3)))
)
(setq x (* x scale1)) ;图幅大小
(setq y (* y scale1))
(setq c (* scale1))
(setq a (* a scale1))
(if (/= tfb1 "1")
(progn ;设置图纸方式
(setq t x)
(setq x y)
(setq y t)
)
)
(setvar "cmdecho" 0) ;设置图层线型和颜色
(command "linetype" "1" "center" "acad"＼r "1" "hidden" "acad" ＼r "1" "phantom" ＼r ＼r)
(setq lay "dimension, linehidden, linephantom, line-center, linesection, line-thin, part")
(command "layer" "n" lay "c" "1" "linehidden" "c" "4" "dimension" "c" "5" "linephantom" "c" "5" "line-center" "c" "3" "linesection" "c" "2" "line-thin" "1" "center" "line-center" "1" "hidden" "linehidden" "1" "phantom" "linephantom" ＼r ＼r)
(setq 1t (* 8 scale1)) (command "ltscale" 1t)
(setq pt1 (list 0 0)); 绘制图框
(setq pt2 (list x y))
(setq pt3 (list x 0))
(setq pt4 (list 0 y))
(setq pt5 (list a c))
(setq pt6 (list (- x c) (- y c)))
(setq pt7 (list (- x c) c))
(setq pt8 (list a (-y c)))
(command "layer" "s" "line-thin" ＼r ＼r)
(command "line" pt1 pt3 pt2 pt4 "c")
(command "layer" "s" "part" ＼r ＼r)
(command "line" pt5 pt7 pt6 pt8 "c")
(command "zoom" "a")
;选择标题栏形式TAB1，TAB2是已定义好的标题栏块
(if (=name "1")
(setq name1 "tab1")
(setq name1 "tab2")
)
(setq r1 0)
(setq pt7 (list (- x c) c))
(command "insert" name1 pt7 scale1 scale1 r1)
(setq li (* scale1 7)) ;尺寸标注初始化
(setq se (* scale1 3.5))
(setq xe (* scale1 2))
(setq xt (* scale1 3.2))
(setvar "dimclrd" 4)
(setvar "dimclre" 4)
(setvar "dimclrt" 7)
(command "dim" "dimtof1" "1")
(command "dimdli" li)
(command "dimase" se)
(command "exit")
(setvar "dimexe" xe)
(setvar "dimse1" 0)
(setvar "dimse2" 0)
(setvar "dimtxt" xt)
(setvar "dimtfac" 0.5)
(setvar "dimtix" 1)
(setvar "dimsoxd" 0)
(setvar "dimtad" 1)
(setvar "dimtih" 0)
(setvar "dimtoh" 0)
(setvar "dimasz" xt)
(setvar "cmdecho" 1)
)
(defun define () ;自定义图幅函数
(setq dc1-id (load-dialog "init.dc1"))
(new-dialog "define" dcl-id)
(action-tile "accept" "(ok-cb)")
(setq x2 (dimx-tile "image"))
(setq y2 (dimy-tile "image"))
(start-image "image")
(fill-image 0 0 x2 y2-1)
(silde-image 0 0 x2 y2 "init.sld")
(end-image)
(start-dialog)
(unload-dialog dc1-id)
)
(defun ok-cb () ;自定义图幅OK回调函数
(setq y1 (atof (get-tile "b")))
(setq x1 (atof (get-tile "1")))
(setq a (atof (get-tile "a")))
(setq c (atof (get-tile "c")))
(setq flag 1)
(done-dialog 1)
)
(princ "initset loaded")
(princ)
);;;加上这个右括号提示语法错误,去掉则提示输入的列表有缺陷
DCL代码如下:
--------------------------------------------------------------------------------
dcl-settings: default-dcl-settings {audit-level=3;}
init: dialog {aspect-ratio=0;
labe1=/*MSG1*/ "初始化"；
:cluster {:cluster {layout=vertical;
:edit-box {key="edit-size";
allow-accept=true;
labe1="图幅"；edit-width=6;
fixed-width=true;}: list-box {
key="list-size"; width=16;
fixed-width=true; allow-accept=true;}}
:cluster {layout=vertical;
:edit-box {key="edit-scale";
labe1=/*MSG20*/ "比例"；
edit-width=6; fixed-width=true;}
: list-box {key="list-scale";
width=14; allow-accept=true;}}
:cluster {layout=vertical;
:boxed-radio-column {laybe1="装订线"；
key="edeg"; : radio-button {
labe1="有"； value="1"; key="e-0";}
: radio-button {labe1="无"； key="e-1";}}
: boxed-radio-column{
labe1="图纸布置"； key="layout";
: radio-button {labe1="横置"；
value="1"; key="1-0";} : radio-button {
labe1="纵置"; key="1-1";} }
: boxed-radio-column {
labe1="标题栏"； key="style";
: radio-button {labe1="格式 1"；
value="1"; key="st-0";}
: radio-button {labe1="格式2"；
key="st-1"; }}}}ok-cancel;}
define : dialog {
labe1="自定义"； initial-focus="b";
: cluster {: cluster {layout=vertical;
: edit-box {key="b"; labe1="B";
edit-width=10; fixed-width=true;}
: edit-box {key="1"; labe1="L";
edit-width=10; fixed-width=true;}
: edit-box {key="a"; labe1="a";
edit-width=10; fixed-width=true;}
: edit-box {key="c"; allow-accept=true;
labe1="c"; edit-width=10;
fixed-width=true;}}: image {key="image";
width=25; eight=10;}} ok-cancel;}
-----------------------------------------------------------------
| 
发表于 2008-2-20 14:30
置顶卡
变色卡
显身卡
发表于 2008-2-20 14:47
楼主
发表于 2008-2-20 16:11
