幻灯片做成幻灯片库
图一（幻灯片）
图二（幻灯片库）
(defun c:tk (/)
(setvar "cmdecho" 0)
(command "undo" "be")
(setq num 0 curpage 0)
(if(< (setq id1 (load_dialog "xzh.dcl")) 0)(exit))
(setq gggg 4)
(while (> gggg 1)
(if(new_dialog "tk" id1)
(progn
(tkreaddata)
(tkinitdata)
(action_tile "b_up""(tkup)")
(action_tile "b_down" "(tkdown)")
(action_tile "a1" "(setq num 1)")
(action_tile "a2" "(setq num 2)")
(action_tile "a3" "(setq num 3)")
(action_tile "a4" "(setq num 4)")
(action_tile "a5" "(setq num 5)")
(action_tile "a6" "(setq num 6)")
(action_tile "a7" "(setq num 7)")
(action_tile "a8" "(setq num 8)")
(action_tile "a9" "(setq num 9)")
(action_tile "accept" "(tkok)")
(action_tile "b_del" "(tkdel)")
(action_tile "b_add" "(done_dialog 3)")
(setq gggg (start_dialog))
(if(= gggg 3)
(progn
(setq p1 (getpoint "\n-->请选左下角点:"))
(setq p2 (getcorner p1 "\n-->请选右上角点:"))
(setq ss1 (ssget "w" p1 p2))
(command "zoom" p1 p2)
(command "ucs" "d" "uc")
(command "ucs" "s" "uc" "ucs" "")
(command "ucs" "o" (polar p1 (angle p1 p2) (* 0.5 (distance p1 p2))))
(tkBH)
(setq sld (strcat name ".sld"))
(command "wblock" name "y" "" '(0 0 0) ss1 "" "u")
(command "mslide" sld)
(command "zoom" "p")
(command "ucs" "r" "uc")
(if(findfile "c:\\xzh\\tk.txt")
(progn
(setq f1 (open "c:\\xzh\\tk.txt" "a"))
(write-line (strcat name ".dwg " sld) f1)
(close f1)
)
(progn
(setq f1 (open "c:\\xzh\\tk.txt" "w"))
(setq i (length dwgsld_list))
(setq j 0)
(repeat i
(write-line (nth j dwgsld_list) f1)
(setq j (+ j 1))
)
(write-line (strcat name ".dwg " sld) f1)
(close f1)
)
)
)
)
)
(setq gggg 0)
)
)
(if(= gggg 1)
(progn
(setq en2 (entlast))
(setq dwg_name (nth (- (+ num (* curpage 9)) 1) dwgname_list))
(command "insert" dwg_name pause 1 1 0)
(setq en1 (entlast))
(if(= kk "1")(command "explode" en1))
)
)
(command "undo" "e")
(princ)
)
(defun tkBH(/ ff1 fr grlst str grname)
(setq ff1 "c:\\xzh\\tkBH.grp" grlst '())
(if(findfile ff1)
(progn
(setq fr (open (findfile ff1) "r"))
(while(/= (setq str (read-line fr)) nil)(setq grlst (cons str grlst)))
(close fr)
)
)
(setq xx 1 grname (strcat "tk" (itoa xx)))
(while (member grname grlst)
(setq xx (1+ xx))
(setq grname (strcat "tk" (itoa xx)))
)
(if(findfile ff1)(setq fr (open (findfile ff1) "a"))(setq fr (open ff1 "w")))
(princ (strcat grname "\n") fr)
(close fr)
(setq name grname)
)
(defun tkok()
(setq kk (get_tile "bom"))
(if(or (< num 1)(> (+ (* curpage 9) num) allnum))
(alert "-->请先选择欲插入的图块.")
(done_dialog 1)
)
)
(defun tkreaddata( / f1 str1 str2 str3 str4 str5 i j k)
(setq allnum 0)
(setq dwgname_list '() sldname_list '() dwgsld_list '())
(if(findfile "c:\\xzh\\tk.txt")
(progn
(setq f1 (open "c:\\xzh\\tk.txt" "r"))
(setq str1 (read-line f1))
(while (/= str1 nil)
(if(> (strlen str1) 0)
(progn
(setq dwgsld_list (cons str1 dwgsld_list))
(setq i (strlen str1) j 1 k 1)
(setq str2 (substr str1 j 1))
(while(and (= k 1) (> i j))
(setq j (+ j 1))
(setq str3 (substr str1 j 1))
(if(= str3 " ")(setq k 0)(setq str2 (strcat str2 str3)))
)
(setq str3 (substr str1 (+ j 1) (- i j)))
(if(not (wcmatch str3 "*.*"))(setq str3 (strcat str3 ".sld")))
(setq i (strlen str2))
(setq j 1)
(setq str4 (substr str2 j 1));;dwg文件名去掉扩展名
(setq k 1)
(while(and (= k 1) (> i j))
(setq j (+ j 1))
(setq str5 (substr str2 j 1))
(if(and (/= str5 ".") (/= str5 nil))(setq str4 (strcat str4 str5))(setq k 0))
)
(setq dwgname_list (cons str4 dwgname_list) ;;dwg名表
sldname_list (cons str3 sldname_list));;sld名表
(setq allnum (+ allnum 1))
) ;progn
) ;if
(setq str1 (read-line f1))
) ;while
(close f1)
(setq dwgname_list (reverse dwgname_list)
sldname_list (reverse sldname_list)
dwgsld_list(reverse dwgsld_list))
)
)
)
(defun tkinitdata(/ i j k dwgstr sldstr)
(setq i (* curpage 9) j 1)
(if(>= (+ (* curpage 9) 9) allnum)(mode_tile "b_down" 1)(mode_tile "b_down" 0))
(if(= curpage 0) (mode_tile "b_up" 1)(mode_tile "b_up" 0))
(setq x (dimx_tile "a1") y (dimy_tile "a1"))
(start_image "a1") (fill_image 0 0 x y -2) (end_image)
(start_image "a2") (fill_image 0 0 x y -2) (end_image)
(start_image "a3") (fill_image 0 0 x y -2) (end_image)
(start_image "a4") (fill_image 0 0 x y -2) (end_image)
(start_image "a5") (fill_image 0 0 x y -2) (end_image)
(start_image "a6") (fill_image 0 0 x y -2) (end_image)
(start_image "a7") (fill_image 0 0 x y -2) (end_image)
(start_image "a8") (fill_image 0 0 x y -2) (end_image)
(start_image "a9") (fill_image 0 0 x y -2) (end_image)
(while(and (<= j 9) (< i allnum))
(setq sldstr (nth i sldname_list))
(cond ((= j 1)(progn(start_image "a1")(slide_image 0 0 x y sldstr)(end_image)))
((= j 2)(progn(start_image "a2")(slide_image 0 0 x y sldstr)(end_image)))
((= j 3)(progn(start_image "a3")(slide_image 0 0 x y sldstr)(end_image)))
((= j 4)(progn(start_image "a4")(slide_image 0 0 x y sldstr)(end_image)))
((= j 5)(progn(start_image "a5")(slide_image 0 0 x y sldstr)(end_image)))
((= j 6)(progn(start_image "a6")(slide_image 0 0 x y sldstr)(end_image)))
((= j 7)(progn(start_image "a7")(slide_image 0 0 x y sldstr)(end_image)))
((= j 8)(progn(start_image "a8")(slide_image 0 0 x y sldstr)(end_image)))
((= j 9)(progn(start_image "a9")(slide_image 0 0 x y sldstr)(end_image))))
(setq i (+ i 1) j (+ j 1))
)
)
(defun tkup()
(setq num 0)
(setq curpage (- curpage 1))
(tkinitdata)
)
(defun tkdown()
(setq num 0)
(setq curpage (+ curpage 1))
(tkinitdata)
)
(defun tkdel(/ f1 i j indi indf )
(if(or(< num 1)(> (+ (* curpage 9) num) allnum))(alert"-->请先选择欲删除的图块.")
(progn
(setq dwg_name (nth (- (+ num (* curpage 9)) 1) dwgname_list))
(setq sld_name (nth (- (+ num (* curpage 9)) 1) sldname_list))
(setq i 0 j (length dwgname_list) chart '() charf '())
(setq f1 (open "c:\\xzh\\tk.txt" "w"))
(while (< i j)
(setq indi (nth i dwgname_list))
(setq indf (nth i sldname_list))
(if(= i (- (+ num (* curpage 9)) 1))(setq indi ""))
(if(= i (- (+ num (* curpage 9)) 1))(setq indf ""))
(if(/= indi "")(write-line (strcat indi " " indf) f1))
(setq i (1+ i))
)
(close f1)
(tkreaddata)
(tkinitdata)
(setq num 0)
)
)
)
tk.txt
SMZSMZ.sld
SDBSDB.SLD
GDBGDB.SLD
ZGBZGB.SLD
TLBTLB.SLD
CT CT.SLD
AMBAMB.SLD
XDBXDB.SLD
XMZXMZ.SLD
LK LK.sld
ZKBzkb.sld
ltb ltb.sld
XTBXTB.SLD
XJB XJB.SLD
幻灯片库名：xzh
请问高手要在哪里修改，才能实现图一，谢谢。
本帖最后由 qianyi0710 于 2020-1-4 20:58 编辑
qianyi0710 发表于 2020-1-3 22:15
同样问题，不显示。求解决
求解决，及修正，谢谢！ 以上源码那里是改幻灯片路径？ ZZXXQQ 发表于 2013-5-24 08:16
同样问题，不显示。求解决 我还以为是做成 slb 幻灯片的库文件呢 本帖最后由 ZZXXQQ 于 2013-5-24 23:15 编辑
(defun tkinitdata(/ i j k dwgstr sldstr)
(setq i (* curpage 9) j 1)
(mode_tile "b_down" (if(>= (+ (* curpage 9) 9) allnum) 1 0))
(mode_tile "b_up" (if(= curpage 0) 1 0))
(setq x (dimx_tile "a1") y (dimy_tile "a1"))
(foreach a '("a1" "a2" "a3" "a4" "a5" "a6" "a7" "a8" "a9")
(start_image a) (fill_image 0 0 x y -2) (end_image)
)
(while (and (<= j 9) (< i allnum))
(setq sldstr (strcat "xzk(" (nth i sldname_list) ")"))
(start_image (strcat "a" (itoa j)))
(slide_image 0 0 x y sldstr)
(end_image)
(setq i (1+ i) j (1+ j))
)
)
ZZXXQQ 发表于 2013-5-24 08:16 static/image/common/back.gif
对话框出不来，且提示“tk ; 错误: 参数类型错误: fixnump: "a1" ”，这是什么原因 726613 发表于 2013-5-24 08:49 static/image/common/back.gif
对话框出不来，且提示“tk ; 错误: 参数类型错误: fixnump: "a1" ”，这是什么原因
tk:dialog{
label="模 板 属 性 库 管 理";
spacer;
:row{
:column{
:image_button{key="a1";allow_accept=true;height=6;width=15;color=-2;}
:image_button{key="a2";allow_accept=true;height=6;width=15;color=-2;}
:image_button{key="a3";allow_accept=true;height=6;width=15;color=-2;}
}//结束column,
:column{
:image_button{key="a4";allow_accept=true;height=6;width=15;color=-2;}
:image_button{key="a5";allow_accept=true;height=6;width=15;color=-2;}
:image_button{key="a6";allow_accept=true;height=6;width=15;color=-2;}
}//结束column,
:column{
:image_button{key="a7";allow_accept=true;height=6;width=15;color=-2;}
:image_button{key="a8";allow_accept=true;height=6;width=15;color=-2;}
:image_button{key="a9";allow_accept=true;height=6;width=15;color=-2;}
}//结束column,
}//结束row,
spacer;
:row{fixed_width=true;alignment=centered;
:spacer{width=1;}
:button{key="b_add";label="增加";}
:spacer{width=1;}
:button{key="b_del";label="删除";}
:spacer{width=1;}
:button{key="b_up";label="上一页";}
:spacer{width=1;}
:button{key="b_down";label="下一页";}
:spacer{width=1;}
}//结束row,
spacer;
:row{
:spacer{width=1;}
:toggle{label="炸开";key="bom";value="1";}
:spacer{width=1;}
:button{label="确认";key="accept";is_default=true;}
:spacer{width=1;}
:button{label="取消";key="cancel";is_cancel=true;}
:spacer{width=1;}
}//结束row,
}//结束dcl,
tka:dialog{
label="增删图库";
:row{
:column{fixed_height=true;alignment=toped;spacer_1;
:edit_box{label="幻灯片名:";key="e1";edit_width=16;}
:button{label="选择幻灯片文件";key="b_sld";fixed_width=true;}
spacer_1;
:edit_box{label="图块名:";key="e2";edit_width=16;}
:button{label="选择欲插入的图块文件";key="b_dwg";fixed_width=true;}}
:list_box{label="请选欲删除的图块";key="e3";height=12;width=30;}}
spacer_1;
:row{fixed_width=true;alignment=centered;
:button{key="a_add";label="增加";}
:spacer{width=2;}
:button{key="a_del";label="删除";}
:spacer{width=2;}
:button{label="确认";key="accept1";is_default= true;}
:spacer{width=2;}
:button{label="取消";key="cancel1";is_cancel=true;}
}
:text{label=" ";}
}
沙发改了。再试试。 好像可以了运行了！ 请高手指点一二，谢谢 留着备用！ 图库，观住，以后备用 以后备用，顶下！！
页:
[1]
2