幻灯片做成幻灯片库

726613

               图一（幻灯片）



        图二（幻灯片库）


(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

SMZ  SMZ.sld
SDB  SDB.SLD
GDB  GDB.SLD
ZGB  ZGB.SLD
TLB  TLB.SLD
CT   CT.SLD
AMB  AMB.SLD
XDB  XDB.SLD
XMZ  XMZ.SLD
LK    LK.sld
ZKB  zkb.sld
ltb    ltb.sld
XTB  XTB.SLD
XJB   XJB.SLD

幻灯片库名：xzh

        请问高手要在哪里修改，才能实现图一，谢谢。

qianyi0710

qianyi0710 发表于 2020-1-3 22:15
同样问题，不显示。求解决

求解决，及修正，谢谢！ 以上源码那里是改幻灯片路径？

qianyi0710

ZZXXQQ 发表于 2013-5-24 08:16

同样问题，不显示。求解决

pengfei2010

我还以为是做成 slb 幻灯片的库文件呢

ZZXXQQ

2. (defun tkinitdata(/ i j k dwgstr sldstr)
   
3. (setq i (* curpage 9) j 1)
   
4. (mode_tile "b_down" (if(>= (+ (* curpage 9) 9) allnum) 1 0))
   
5. (mode_tile "b_up" (if(= curpage 0) 1 0))
   
6. (setq x (dimx_tile "a1") y (dimy_tile "a1"))
   
7. (foreach a '("a1" "a2" "a3" "a4" "a5" "a6" "a7" "a8" "a9")
   
8.   (start_image a) (fill_image 0 0 x y -2) (end_image)
   
9. )
   
10. (while (and (<= j 9) (< i allnum))
    
11.   (setq sldstr (strcat "xzk(" (nth i sldname_list) ")"))
    
12.   (start_image (strcat "a" (itoa j)))
    
13.   (slide_image 0 0 x y sldstr)
    
14.   (end_image)
    
15.   (setq i (1+ i) j (1+ j))
    
16. )
    
17. )
    

(defun tkinitdata(/ i j k dwgstr sldstr)<br /> (setq i (* curpage 9) j 1)<br /> (mode_tile "b_down" (if(>= (+ (* curpage 9) 9) allnum) 1 0))<br /> (mode_tile "b_up" (if(= curpage 0) 1 0))<br /> (setq x (dimx_tile "a1") y (dimy_tile "a1"))<br /> (foreach a '("a1" "a2" "a3" "a4" "a5" "a6" "a7" "a8" "a9")<br />   (start_image a) (fill_image 0 0 x y -2) (end_image)<br /> )<br /> (while (and (<= j 9) (< i allnum))<br />   (setq sldstr (strcat "xzk(" (nth i sldname_list) ")"))<br />   (start_image (strcat "a" (itoa j)))<br />   (slide_image 0 0 x y sldstr)<br />   (end_image)<br />   (setq i (1+ i) j (1+ j))<br /> )<br /> )<br />

726613

ZZXXQQ 发表于 2013-5-24 08:16

对话框出不来，且提示“tk ; 错误: 参数类型错误: fixnump: "a1" ”，这是什么原因

726613

726613 发表于 2013-5-24 08:49
对话框出不来，且提示“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=" ";}
}

ZZXXQQ

沙发改了。再试试。

wangdaobin

好像可以了运行了！

726613

请高手指点一二，谢谢

smartstar

留着备用！

qyming

图库，观住，以后备用

lxy_2080

以后备用，顶下！！