图库

pannelchen · 发表于 2015-2-10 20:26:34

本帖最后由 pannelchen 于 2015-4-5 18:53 编辑

参照yanxiou插件上的词库自已做的一个图库管理的,同大家分享下,
有如下问题:
;不知是我surface 的问题还是程序的问题，增加的图块不在中间，偏下;
; 比例放大或缩小时，炸开会全部变成个体
;上述问题超出能力范围，不知咋修正.

;20150401 增加删除确认.
(defun c:tk ()
;(setvar "cmdecho" 0)
(vl-load-com)
(setq path "D:\\百度云同步盘\\CAD\\程序\\研究衍伸\\自制幻灯片\\")
;可不用设置搜索目录
(setq keylst '("a1" "a2" "a3" "a4" "a5" "a6" "a7" "a8" "a9"))
;将image key 设置成表
(if nn
(setq nn nn)
(setq nn "0")
)
(if mm
(setq mm mm)
(setq mm "0")
)
(if curpage
(setq curpage curpage)
(setq curpage 0)
)
(if xsc
(setq xsc xsc)
(setq xsc "1")
)
(if sc_uniform
(setq sc_uniform sc_uniform)
(setq sc_uniform "0")
)
(setq poplst (get_poplst "tk.ini"))
(setq boxlst (get_boxlst "tk.ini"))
(dcl_tk)
)
(defun dcl_tk ()
(setq dcl_id (load_dialog (strcat path "tk.dcl")))
(new_dialog "tk" dcl_id)
(show_list "poptk" poplst)
(set_tile "poptk" nn) ;设定初始值
(setq subitem (nth (atoi nn) boxlst))
(setq sub_boxlst (sub_readfile subitem)) ;取得分列表
(setq sub_showboxlst (get_del_address_newlist sub_boxlst))
;删除地址的新字符串
(setq len (length sub_showboxlst))
(show_listnum len)
(show_list "tk_list" sub_showboxlst)
(set_tile "tk_list" "0")
(show_tk_sld keylst sub_boxlst)
(setq laylst (layer_get_all)) ;得到所有图层
(show_list "poplay" laylst) ;laylst
(set_tile "poplay" mm) ;设定lay初始值
(set_tile "xsc" xsc)
(set_tile "sc_uniform" sc_uniform)
(if (= sc_uniform "1")
(progn
(setq sc (get_tile "xsc"))
(set_tile "ysc" sc)
(set_tile "zsc" sc)
(mode_tile "ysc" 1)
(mode_tile "zsc" 1)
)
(progn
(mode_tile "ysc" 0)
(mode_tile "zsc" 0)
(set_tile "ysc" "1") ;可修改为统一之前的值，像cad那样
(set_tile "zsc" "1")
)
)
(set_tile "tkang" "0")
(set_tile "extra" "pannel\n修改显示顺序在ini文中修改\n插入的图块不对中")
(action_tile "item" "(sub_openfile \"tk.ini\")")
(action_tile "sub_item" "(sub_openfile subitem)")
(action_tile "sub_dir" "(open_sub_dir subitem )")
(action_tile "poptk" "(setcurpage) (setq nn $value) (setq subitem (nth (atoi $value) boxlst))(setq sub_boxlst (sub_readfile subitem)) (setq sub_showboxlst (get_del_address_newlist sub_boxlst)) (show_list \"tk_list\" sub_showboxlst)(set_tile_tk_list)(show_tk_sld keylst sub_boxlst)(setq len (length sub_showboxlst)) (show_listnum len)(mod_tile_sld)"
)
(action_tile "tk_up" "(tkup keylst sub_boxlst)")
(action_tile "tk_down" "(tkdown keylst sub_boxlst)")
(action_tile "tk_list" "(get_tk $value keylst sub_boxlst)")
;显示图像
(action_tile "xsc" "(setq xsc $value)(y_z_sc)")
(action_tile "sc_uniform" "(setq sc_uniform $value)(set_tksc)")
(action_tile "a1" "(setq aa 1)(get_tk_filename aa sub_boxlst)") ;图像指定lst
(action_tile "a2" "(setq aa 2)(get_tk_filename aa sub_boxlst)")
(action_tile "a3" "(setq aa 3)(get_tk_filename aa sub_boxlst)")
(action_tile "a4" "(setq aa 4)(get_tk_filename aa sub_boxlst)")
(action_tile "a5" "(setq aa 5)(get_tk_filename aa sub_boxlst)")
(action_tile "a6" "(setq aa 6)(get_tk_filename aa sub_boxlst)")
(action_tile "a7" "(setq aa 7)(get_tk_filename aa sub_boxlst)")
(action_tile "a8" "(setq aa 8)(get_tk_filename aa sub_boxlst )")
(action_tile "a9" "(setq aa 9)(get_tk_filename aa sub_boxlst)")
(mode_tile "a1" 4)
(action_tile "tk_add" "(done_dialog 1)")
(action_tile "tk_del" "(del_tk)")
(action_tile "poplay" "(setq mm $value)")
(action_tile "tk_insert" "(ok_diatk) (done_dialog 2)")
(setq dd (start_dialog))
(cond
((= dd 1) (add_tk) (dcl_tk))
((= dd 2) (insert_tk))
)
)
(defun ok_diatk ()
(setq inserttk (strcat path (nth (atoi (get_tile "tk_list")) sub_boxlst) ".dwg" ))
(setq lay (nth (atoi mm) laylst))
(setq ang (get_tile "tkang"))
(setq xsc (get_tile "xsc"))
(setq ysc (get_tile "ysc"))
(setq bom (get_tile "bom"))
)
(defun insert_tk ()
;(setvar "clayer" lay)
(command "insert" inserttk "x" (atof xsc) "y" (atof ysc) "r" ang pause)
;;;;拖拽插入 ,x,y ,r分别代表x比例,y比例，循环角度. 0代表
(setq en1 (entlast))
(if (= bom "1")
(command "explode" en1 "")
)
)
;删除 c:\ 目录中的文件 newauto.bat：
;_$ (vl-file-delete "c:/newauto.bat")
(defun del_tk ()
(if (/= sub_boxlst nil)
(progn
(setq del_n (atoi (get_tile "tk_list")))
(setq deldata (nth del_n sub_boxlst))
(setq filedir (vl-filename-directory subitem))
(setq deldatadwg (strcat path deldata ".dwg"))
(setq deldatasld (strcat path deldata ".sld"))
;确认是否删除，并标出文件名，
(del_tk_ifnot)
(if (= dd1 3)
(progn (vl-file-delete deldatadwg) ;删除文件
(vl-file-delete deldatasld)
(setq sub_boxlst (vl-remove deldata sub_boxlst))
(sub_writedata subitem sub_boxlst)
)
)
(setq sub_boxlst (sub_readfile subitem)) ;取得分列表
(setq sub_showboxlst (get_del_address_newlist sub_boxlst))
;删除地址的新字符串
(show_list "tk_list" sub_showboxlst)
(show_tk_sld keylst sub_boxlst)
;更新页码;
;程序代码
(setq len (length sub_showboxlst))
(show_listnum len)
)
(progn
(alert "list无")
)
)
)
;删除图块确认
(defun del_tk_ifnot()
(setq dcl_id (load_dialog (strcat path "tk.dcl")))
(new_dialog "del_con" dcl_id)
(set_tile "del_tk_name" (vl-filename-base deldatadwg) )
(action_tile "accept" "(done_dialog 3)")
(action_tile "cancel" "(done_dialog 4)")
(setq dd1 (start_dialog))
)
;增加图块
(defun add_tk ()
(setq filedir (vl-filename-directory subitem))
;返回文件名前面的路径
(setq p1 (getpoint "\n-->请选左下角点:"))
(setq p2 (getcorner p1 "\n-->请选右上角点:"))
;亮显选择实体
;*************代码**********
;
;
;
;
;
;*****************
(while (member (setq name (getstring "请输入图块名")) sub_showboxlst )
(alert "重名") ;重名重输
(dcl_tk)
)
(setq dwgname (strcat path filedir "\\" name)) ;包含地址.
(setq name_subitem (strcat filedir "\\" name))
(setq ss1 (ssget "w" p1 p2))
(command "zoom" p1 p2)
(command "ucs" "d" "uc") ;删除名为uc的ucs
(command "ucs" "s" "uc" "ucs" "") ; save名为uc的 ucs
;(command "ucs" "o" (polar p1 (angle p1 p2) (* 0.5 (distance p1 p2)))) ;重新定义原点中心
(setq sld (strcat dwgname ".sld"))
;(setq pt (getpoint "\n选择插入点坐标:"))
; (command "-WBLOCK" dwgname "" pt ss "" "oops")
(command "wblock" dwgname "" '(0 0 ) ss1 "" "oops")
;name中含地址.oops用途:恢复删除的对象?
;(command "u")
(command "mslide" sld) ;创建幻灯文件
(command "zoom" "p") ;放大上一个文件
(command "ucs" "r" "uc") ;恢复名为uc的ucs
;加入name到list中
(setq sub_boxlst (append sub_boxlst (list name_subitem)))
;写入文件
(sub_writedata subitem sub_boxlst)
)
(defun set_tile_tk_list ()
(set_tile "tk_list" "0")
)
(defun mod_tile_sld ()
(mode_tile "a1" 4)
)
;比例设置
(defun set_tksc ()
(if (= sc_uniform "1")
(progn
(setq sc (get_tile "xsc"))
(set_tile "ysc" sc)
(set_tile "zsc" sc)
(mode_tile "ysc" 1)
(mode_tile "zsc" 1)
)
(progn
(mode_tile "ysc" 0)
(mode_tile "zsc" 0)
)
)
)
;当统一比例时，实时变化
;实际上没达到cad那样的功能
(defun y_z_sc ()
(if (= (get_tile "sc_all") "1")
(progn
(set_tile "ysc" xsc)
(set_tile "zsc" xsc)
(mode_tile "ysc" 1)
(mode_tile "zsc" 1)
)
)
)
;表显示
(defun show_list (key newlist)
(start_list key) ;
(mapcar 'add_list newlist)
(end_list)
)
;显示单个image
(defun show_sld (key sld)
(setq x (dimx_tile key)) ;取得图像的右下角x坐标
(setq y (dimy_tile key)) ;取得图像的右下角y坐标
(start_image key) ;开始处理图像对象
(fill_image 0 0 x y 254) ;先以背景颜色填满图像x1,y1,width,height,color
(slide_image 0 0 x y sld) ;展示幻灯片 x1,y1,width,height,sldname
(end_image)
)
;初始化页码
(defun setcurpage ()
(setq curpage 0)
)
;;设置目录并打开目录文件
;;;可用(vl-filename-directory "c:\\acadwin\\acad.exe"),返回"c:\\acadwin"
(defun open_sub_dir (subitem)
(setq filedir (vl-filename-directory subitem))
(setq filedir (strcat path filedir))
(startapp "EXPLORER.EXE" filedir)
)
;显示子项目长度
(defun show_listnum (length)
(set_tile "list_num" (itoa length))
)
;把列表中的内容定向image key
(defun show_tk_sld (keylst lst)
(setq sldlst (mapcar '(lambda (x) (strcat path x)) lst))
; list所有字符串加前缀,sld未在搜索路径下必须加上地址,不必加后缀
(setq i (* curpage 9) j 0)
(setq num (* curpage 9))
(setq allnum (length sldlst)) ;所有图像sld长度
(mode_tile "tk_down" (if (>= (+ (* curpage 9) 9) allnum) 1 0 ))
(mode_tile "tk_up" (if (= curpage 0) 1 0 ))
(while (< j 9)
(setq key (nth j keylst))
(setq x (dimx_tile key)) ;取得图像的右下角x坐标
(setq y (dimy_tile key)) ;取得图像的右下角y坐标
(start_image key)
(fill_image 0 0 x y -16) ;-16:当前对话框的前景色
(if (< i allnum) ;如果无值，不显示
(progn
(setq sld (nth i sldlst))
(slide_image 0 0 x y sld) ;显示图像
)
)
(end_image)
(setq i (1+ i)
j (1+ j)
)
)
)
;;上一页
(defun tkup (keylst sldlst)
(setq curpage (- curpage 1))
(show_tk_sld keylst sldlst)
)
;下一页
(defun tkdown (keylst sldlst)
(setq curpage (+ curpage 1)) ;取得页码
(show_tk_sld keylst sldlst)
)
;显示指定sld并指向list
(defun get_tk (vvs keylst lst)
(setq n (atoi vvs))
(setq curpage (fix (/ n 9))) ;截去实数小数部分,求得页码.
(show_tk_sld keylst lst)
(setq num (rem n 9)) ;求余数
(setq key (nth num keylst))
;(setq sldlst (mapcar '(lambda (x) (strcat path x )) lst) )
;(setq sld (nth n sldlst))
;(show_sld key sld)
(mode_tile key 4)
)
;取得文件名
(defun get_tk_filename (aa lst)
(setq bb (+ (* curpage 9) (- aa 1))) ;list位置
(show_tk_sld keylst lst)
(set_tile "tk_list" (itoa bb))
(setq key (strcat "a" (itoa aa))) ;，由于show_tk_sld中有key值为a9,需重新计算key
;(setq sldlst (mapcar '(lambda (x) (strcat path x )) lst) )
;(if (setq sld (nth bb sldlst))
;(show_sld key sld)
(mode_tile key 4)
)
;将表指定给tk_list并显示
(defun show_sub_box_lst (lst)
(setq key "tk_list")
(show_list key lst)
)
;;;[功能]字符串取得特定字符"\\"之后的字符串 ,去除空字符串 ,允许lst为空值
;;;可用(vl-filename-base "c:\\acadwin\\acad.exe"),返回"acad"
(defun get_del_address_newlist (lst)
(setq lst (vl-remove "" lst)) ;这里重要，,去除空值
(setq lst (mapcar '(lambda (x) (vl-filename-base x)) lst))
)
(defun sub_readfile (file) ;TEMP词库
(setq pathfile (strcat path file))
(setq file (findfile pathfile))
(if file
(progn
(setq fn (open file "r"))
(setq tmplst nil)
(while (setq x (read-line fn))
(if (/= (substr x 1 1) ";")
(setq tmplst (append tmplst (list x)))
)
) ;while
)
nil
) ;progn
(close fn)
tmplst
(setq tempst (vl-remove "" tmplst))
)
;取得第一行信息
(defun get_poplst (file)
(setq alllst (sub_readfile file))
(setq len (length alllst))
(setq i 0
poplst nil
)
(setq str (nth i alllst))
(while (and str (< i len))
(setq poplst (cons str poplst))
(setq i (+ i 2))
(setq str (nth i alllst))
)
(setq poplst (reverse poplst))
(setq poplst (vl-remove "" poplst));删除空白元素
poplst
)
;取得第二行信息
(defun get_boxlst (file)
(setq alllst (sub_readfile file))
(setq len (length alllst))
(setq i 1
boxlst nil
)
(setq str (nth i alllst))
(while (and str (< i len))
(setq boxlst (cons str boxlst))
(setq i (+ i 2))
(setq str (nth i alllst))
)
(setq boxlst (reverse boxlst))
(setq boxlst (vl-remove "" boxlst))
boxlst
)
;;;打开文件
(defun sub_openfile (files)
(setq path_txt (strcat path files))
(if (findfile path_txt)
(startapp "notepad.exe" path_txt)
(alert (strcat "无" files "文件"))
)
)
;将字符串写入文本文件
(defun sub_writedata (pathfile lst)
(setq ffn (open (strcat path pathfile) "w"))
;;写模式.
(foreach x lst (write-line x ffn))
(close ffn)
;;关闭文件
)
;返回所有图层
(defun layer_get_all ()
(setq layer nil)
(setq lay (tblnext "LAYER" T)) ;重头开始找
(while (/= lay nil)
;(setq layer (append layer (list (cdr (assoc 2 lay)))))
(setq layer (cons (cdr (assoc 2 lay)) layer))
(setq lay (tblnext "LAYER"))
)
(setq layer (acad_strlsort layer))
layer ;返回值
)

;20150401 增加删除确认. 
 
(defun c:tk () 
          ;(setvar "cmdecho" 0) 
  (vl-load-com) 
  (setq path "D:\\百度云同步盘\\CAD\\程序\\研究衍伸\\自制幻灯片\\") 
          ;可不用设置搜索目录 
  (setq keylst '("a1" "a2" "a3" "a4" "a5" "a6" "a7" "a8" "a9")) 
          ;将image key 设置成表 
  (if nn 
    (setq nn nn) 
    (setq nn "0") 
  ) 
  (if mm 
    (setq mm mm) 
    (setq mm "0") 
  ) 
  (if curpage 
    (setq curpage curpage) 
    (setq curpage 0) 
  ) 
  (if xsc 
    (setq xsc xsc) 
    (setq xsc "1") 
    ) 
    
  (if sc_uniform 
    (setq sc_uniform sc_uniform) 
    (setq sc_uniform "0") 
  ) 
  (setq poplst (get_poplst "tk.ini")) 
  (setq boxlst (get_boxlst "tk.ini")) 
  (dcl_tk) 
) 
 
(defun dcl_tk () 
  (setq dcl_id (load_dialog (strcat path "tk.dcl"))) 
  (new_dialog "tk" dcl_id) 
  (show_list "poptk" poplst) 
  (set_tile "poptk" nn)      ;设定初始值 
  (setq subitem (nth (atoi nn) boxlst)) 
  (setq sub_boxlst (sub_readfile subitem)) ;取得分列表 
  (setq sub_showboxlst (get_del_address_newlist sub_boxlst)) 
          ;删除地址的新字符串 
  (setq len (length sub_showboxlst)) 
  (show_listnum len) 
  (show_list "tk_list" sub_showboxlst) 
  (set_tile "tk_list" "0") 
  (show_tk_sld keylst sub_boxlst) 
  (setq laylst (layer_get_all))    ;得到所有图层 
  (show_list "poplay" laylst)    ;laylst 
  (set_tile "poplay" mm)    ;设定lay初始值 
  (set_tile "xsc" xsc) 
   (set_tile "sc_uniform" sc_uniform) 
  (if (= sc_uniform "1") 
    (progn 
      (setq sc (get_tile "xsc")) 
      (set_tile "ysc" sc) 
      (set_tile "zsc" sc) 
      (mode_tile "ysc" 1) 
      (mode_tile "zsc" 1) 
    ) 
    (progn 
      (mode_tile "ysc" 0) 
      (mode_tile "zsc" 0) 
      (set_tile "ysc" "1")  ;可修改为统一之前的值，像cad那样 
      (set_tile "zsc" "1") 
    ) 
    ) 
 
  (set_tile "tkang" "0") 
  (set_tile "extra" "pannel\n修改显示顺序在ini文中修改\n插入的图块不对中") 
  (action_tile "item" "(sub_openfile \"tk.ini\")") 
  (action_tile "sub_item" "(sub_openfile subitem)") 
  (action_tile "sub_dir" "(open_sub_dir subitem )") 
  (action_tile "poptk" "(setcurpage) (setq nn $value) (setq subitem (nth (atoi $value) boxlst))(setq sub_boxlst (sub_readfile subitem)) (setq sub_showboxlst (get_del_address_newlist sub_boxlst)) (show_list \"tk_list\" sub_showboxlst)(set_tile_tk_list)(show_tk_sld keylst sub_boxlst)(setq len (length sub_showboxlst)) (show_listnum len)(mod_tile_sld)" 
  ) 
  (action_tile "tk_up" "(tkup keylst sub_boxlst)") 
  (action_tile "tk_down" "(tkdown keylst sub_boxlst)") 
  (action_tile "tk_list" "(get_tk $value keylst sub_boxlst)") 
          ;显示图像 
  (action_tile "xsc" "(setq xsc $value)(y_z_sc)") 
  (action_tile "sc_uniform" "(setq sc_uniform $value)(set_tksc)") 
  (action_tile "a1" "(setq aa 1)(get_tk_filename aa  sub_boxlst)")          ;图像指定lst 
  (action_tile "a2" "(setq aa 2)(get_tk_filename aa  sub_boxlst)") 
  (action_tile "a3" "(setq aa 3)(get_tk_filename aa  sub_boxlst)") 
  (action_tile "a4" "(setq aa 4)(get_tk_filename aa  sub_boxlst)") 
  (action_tile "a5" "(setq aa 5)(get_tk_filename aa  sub_boxlst)") 
  (action_tile "a6" "(setq aa 6)(get_tk_filename aa  sub_boxlst)") 
  (action_tile "a7" "(setq aa 7)(get_tk_filename aa  sub_boxlst)") 
  (action_tile "a8" "(setq aa 8)(get_tk_filename aa  sub_boxlst )") 
  (action_tile "a9" "(setq aa 9)(get_tk_filename aa  sub_boxlst)") 
  (mode_tile "a1" 4) 
  (action_tile "tk_add" "(done_dialog 1)") 
  (action_tile "tk_del" "(del_tk)") 
  (action_tile "poplay" "(setq mm $value)") 
  (action_tile "tk_insert" "(ok_diatk) (done_dialog 2)") 
  (setq dd (start_dialog)) 
  (cond 
    ((= dd 1) (add_tk) (dcl_tk)) 
    ((= dd 2) (insert_tk)) 
  ) 
) 
 
(defun ok_diatk  () 
  (setq  inserttk (strcat path   (nth (atoi (get_tile "tk_list")) sub_boxlst)  ".dwg"   )) 
  (setq lay (nth (atoi mm) laylst)) 
  (setq ang (get_tile "tkang")) 
  (setq xsc (get_tile "xsc")) 
  (setq ysc (get_tile "ysc")) 
  (setq bom (get_tile "bom")) 
) 
 
(defun insert_tk () 
          ;(setvar "clayer" lay) 
  (command "insert" inserttk "x" (atof xsc) "y" (atof ysc) "r" ang pause) 
;;;;拖拽插入 ,x,y ,r分别代表x比例,y比例，循环角度. 0代表 
  (setq en1 (entlast)) 
  (if (= bom "1") 
    (command "explode" en1 "") 
  ) 
) 
 
 
          ;删除 c:\ 目录中的文件 newauto.bat： 
 ;_$ (vl-file-delete "c:/newauto.bat") 
(defun del_tk () 
  (if (/= sub_boxlst nil) 
    (progn 
      (setq del_n (atoi (get_tile "tk_list"))) 
      (setq deldata    (nth del_n sub_boxlst)) 
      (setq filedir (vl-filename-directory subitem)) 
      (setq deldatadwg (strcat path deldata ".dwg")) 
      (setq deldatasld (strcat path deldata ".sld")) 
      ;确认是否删除，并标出文件名， 
      (del_tk_ifnot) 
       (if (= dd1 3)       
          (progn  (vl-file-delete deldatadwg)  ;删除文件 
                  (vl-file-delete deldatasld) 
                  (setq sub_boxlst (vl-remove deldata sub_boxlst))          
                  (sub_writedata subitem sub_boxlst) 
          ) 
        ) 
      (setq sub_boxlst (sub_readfile subitem)) ;取得分列表 
      (setq sub_showboxlst     (get_del_address_newlist sub_boxlst)) 
          ;删除地址的新字符串 
      (show_list "tk_list" sub_showboxlst) 
      (show_tk_sld keylst sub_boxlst) 
      ;更新页码; 
      ;程序代码 
      (setq len (length sub_showboxlst)) 
      (show_listnum len) 
      ) 
    (progn 
      (alert "list无") 
    ) 
  ) 
) 
;删除图块确认 
(defun del_tk_ifnot() 
  (setq dcl_id (load_dialog (strcat path "tk.dcl"))) 
  (new_dialog "del_con" dcl_id) 
  (set_tile "del_tk_name"   (vl-filename-base  deldatadwg) ) 
  (action_tile "accept" "(done_dialog 3)") 
  (action_tile "cancel" "(done_dialog 4)") 
  (setq dd1 (start_dialog)) 
) 
 
          ;增加图块 
(defun add_tk () 
  (setq filedir (vl-filename-directory subitem)) 
          ;返回文件名前面的路径 
  (setq p1 (getpoint "\n-->请选左下角点:")) 
  (setq p2 (getcorner p1 "\n-->请选右上角点:")) 
   
  ;亮显选择实体 
  ;*************代码********** 
  ; 
  ; 
  ; 
  ; 
  ;   
  ;***************** 
  (while (member (setq name (getstring "请输入图块名"))     sub_showboxlst   ) 
    (alert "重名")      ;重名重输 
    (dcl_tk) 
  ) 
  (setq dwgname (strcat path filedir "\\" name)) ;包含地址. 
  (setq name_subitem (strcat filedir "\\" name)) 
  (setq ss1 (ssget "w" p1 p2)) 
  (command "zoom"  p1 p2) 
  (command "ucs" "d" "uc")    ;删除名为uc的ucs 
  (command "ucs" "s" "uc" "ucs" "")  ; save名为uc的 ucs 
 ;(command "ucs"   "o"   (polar p1 (angle p1 p2) (* 0.5 (distance p1 p2))))          ;重新定义原点中心 
 
  (setq sld (strcat dwgname ".sld")) 
  ;(setq pt (getpoint "\n选择插入点坐标:")) 
 ; (command "-WBLOCK"  dwgname "" pt ss "" "oops") 
  (command "wblock" dwgname "" '(0 0 ) ss1  "" "oops") 
          ;name中含地址.oops用途:恢复删除的对象? 
  ;(command "u") 
  (command "mslide" sld)    ;创建幻灯文件 
  (command "zoom" "p")      ;放大上一个文件 
  (command "ucs" "r" "uc")    ;恢复名为uc的ucs    
          ;加入name到list中 
  (setq sub_boxlst (append sub_boxlst (list name_subitem))) 
          ;写入文件 
  (sub_writedata subitem sub_boxlst) 
) 
 
 
 
(defun set_tile_tk_list  () 
  (set_tile "tk_list" "0") 
) 
 
(defun mod_tile_sld () 
  (mode_tile "a1" 4) 
) 
 
          ;比例设置 
(defun set_tksc  () 
  (if (= sc_uniform "1") 
    (progn 
      (setq sc (get_tile "xsc")) 
      (set_tile "ysc" sc) 
      (set_tile "zsc" sc) 
      (mode_tile "ysc" 1) 
      (mode_tile "zsc" 1) 
    ) 
    (progn 
      (mode_tile "ysc" 0) 
      (mode_tile "zsc" 0) 
    ) 
  ) 
) 
;当统一比例时，实时变化 
;实际上没达到cad那样的功能 
(defun y_z_sc () 
  (if (= (get_tile "sc_all") "1") 
    (progn 
      (set_tile "ysc" xsc) 
      (set_tile "zsc" xsc) 
      (mode_tile "ysc" 1) 
      (mode_tile "zsc" 1) 
    ) 
  ) 
) 
 
          ;表显示 
(defun show_list (key newlist) 
  (start_list key)      ; 
  (mapcar 'add_list newlist) 
  (end_list) 
) 
 
          ;显示单个image 
(defun show_sld  (key sld) 
  (setq x (dimx_tile key))    ;取得图像的右下角x坐标 
  (setq y (dimy_tile key))    ;取得图像的右下角y坐标 
  (start_image key)      ;开始处理图像对象 
  (fill_image 0 0 x y 254)    ;先以背景颜色填满图像x1,y1,width,height,color 
  (slide_image 0 0 x y sld)    ;展示幻灯片 x1,y1,width,height,sldname 
  (end_image) 
) 
 
          ;初始化页码 
(defun setcurpage () 
  (setq curpage 0) 
) 
 
;;设置目录并打开目录文件 
;;;可用(vl-filename-directory "c:\\acadwin\\acad.exe"),返回"c:\\acadwin" 
(defun open_sub_dir (subitem) 
  (setq filedir (vl-filename-directory subitem)) 
  (setq filedir (strcat path filedir)) 
  (startapp "EXPLORER.EXE" filedir)                                                                                                                                                                                                                                                                            
) 
 
          ;显示子项目长度 
(defun show_listnum (length) 
  (set_tile "list_num" (itoa length)) 
) 
          ;把列表中的内容定向image key 
(defun show_tk_sld (keylst lst) 
  (setq sldlst (mapcar '(lambda (x) (strcat path x)) lst)) 
          ; list所有字符串加前缀,sld未在搜索路径下必须加上地址,不必加后缀 
  (setq  i (* curpage 9)  j 0) 
  (setq num (* curpage 9)) 
  (setq allnum (length sldlst))    ;所有图像sld长度 
  (mode_tile "tk_down"     (if (>= (+ (* curpage 9) 9) allnum)   1   0   )) 
  (mode_tile "tk_up"       (if (= curpage 0) 1   0   )) 
  (while (< j 9) 
    (setq key (nth j keylst)) 
    (setq x (dimx_tile key))    ;取得图像的右下角x坐标 
    (setq y (dimy_tile key))    ;取得图像的右下角y坐标 
    (start_image key) 
    (fill_image 0 0 x y -16)    ;-16:当前对话框的前景色 
    (if  (
      (progn 
  (setq sld (nth i sldlst)) 
  (slide_image 0 0 x y sld)  ;显示图像   
      ) 
    ) 
    (end_image) 
    (setq i (1+ i) 
    j (1+ j) 
    ) 
  ) 
) 
 
;;上一页 
(defun tkup (keylst sldlst) 
  (setq curpage (- curpage 1)) 
  (show_tk_sld keylst sldlst) 
) 
 
;下一页 
(defun tkdown (keylst sldlst) 
  (setq curpage (+ curpage 1))    ;取得页码 
  (show_tk_sld keylst sldlst) 
) 
 
          ;显示指定sld并指向list    
(defun get_tk (vvs keylst lst) 
  (setq n (atoi vvs)) 
  (setq curpage (fix (/ n 9)))    ;截去实数小数部分,求得页码. 
  (show_tk_sld keylst lst) 
  (setq num (rem n 9))      ;求余数 
  (setq key (nth num keylst)) 
          ;(setq sldlst (mapcar '(lambda (x) (strcat path x  ))  lst) ) 
          ;(setq sld (nth  n  sldlst)) 
          ;(show_sld key sld) 
  (mode_tile key 4) 
) 
 
;取得文件名 
(defun get_tk_filename (aa lst) 
  (setq bb (+ (* curpage 9) (- aa 1)))  ;list位置 
  (show_tk_sld keylst lst) 
  (set_tile "tk_list" (itoa bb)) 
  (setq key (strcat "a" (itoa aa)))  ;，由于show_tk_sld中有key值为a9,需重新计算key 
          ;(setq sldlst (mapcar '(lambda (x) (strcat path x  ))  lst) ) 
          ;(if (setq sld (nth  bb sldlst)) 
          ;(show_sld key sld) 
  (mode_tile key 4) 
          
) 
 
;将表指定给tk_list并显示 
(defun show_sub_box_lst  (lst) 
  (setq key "tk_list") 
  (show_list key lst) 
) 
 
;;;[功能]字符串取得特定字符"\\"之后的字符串  ,去除空字符串  ,允许lst为空值 
;;;可用(vl-filename-base "c:\\acadwin\\acad.exe"),返回"acad" 
(defun get_del_address_newlist (lst) 
  (setq lst (vl-remove "" lst))    ;这里重要，,去除空值 
  (setq lst (mapcar '(lambda (x) (vl-filename-base x)) lst)) 
) 
 
 
          
(defun sub_readfile (file)    ;TEMP词库 
  (setq pathfile (strcat path file)) 
  (setq file (findfile pathfile)) 
  (if file 
    (progn 
      (setq fn (open file "r")) 
      (setq tmplst nil) 
      (while (setq x (read-line fn)) 
           (if (/= (substr x 1 1) ";") 
            (setq tmplst (append tmplst (list x))) 
          ) 
      )          ;while 
    ) 
    nil 
  )          ;progn 
  (close fn) 
  tmplst 
  (setq tempst (vl-remove "" tmplst)) 
) 
 
;取得第一行信息 
(defun get_poplst (file) 
  (setq alllst (sub_readfile file)) 
  (setq len (length alllst)) 
  (setq  i 0 
  poplst nil 
  ) 
  (setq str (nth i alllst)) 
  (while (and str (
    (setq poplst (cons str poplst)) 
    (setq i (+ i 2)) 
    (setq str (nth i alllst)) 
  ) 
  (setq poplst (reverse poplst)) 
  (setq poplst (vl-remove "" poplst));删除空白元素 
  poplst 
) 
 
;取得第二行信息 
(defun get_boxlst (file) 
  (setq alllst (sub_readfile file)) 
  (setq len (length alllst)) 
  (setq  i 1 
  boxlst nil 
  ) 
  (setq str (nth i alllst)) 
  (while (and str (
    (setq boxlst (cons str boxlst)) 
    (setq i (+ i 2)) 
    (setq str (nth i alllst)) 
  ) 
  (setq boxlst (reverse boxlst)) 
  (setq boxlst (vl-remove "" boxlst)) 
  boxlst 
) 
 
;;;打开文件 
(defun sub_openfile (files) 
  (setq path_txt (strcat path files)) 
  (if (findfile path_txt) 
    (startapp "notepad.exe" path_txt) 
    (alert (strcat "无" files "文件")) 
  ) 
) 
 
;将字符串写入文本文件 
(defun sub_writedata (pathfile lst) 
  (setq ffn (open (strcat path pathfile) "w")) 
  ;;写模式. 
  (foreach x lst (write-line x ffn)) 
  (close ffn) 
  ;;关闭文件 
) 
 
;返回所有图层 
(defun layer_get_all () 
  (setq layer nil) 
  (setq lay (tblnext "LAYER" T))  ;重头开始找 
  (while (/= lay nil) 
    ;(setq layer (append layer (list (cdr (assoc 2 lay))))) 
    (setq layer (cons (cdr (assoc 2 lay)) layer)) 
    (setq lay (tblnext "LAYER")) 
  ) 
  (setq layer (acad_strlsort layer)) 
  layer          ;返回值 
)

zkq1212 · 发表于 2022-4-12 14:54:06

磐舍发表于 2022-4-7 11:00
这个图库能分享一下么

直接用楼主的代码就可以了，当时是在学习对话框，就拿楼主的代码改了个

磐舍 · 发表于 2022-4-12 23:03:05

zkq1212 发表于 2022-4-12 14:54
直接用楼主的代码就可以了，当时是在学习对话框，就拿楼主的代码改了个

他这个杂用呀

MXS · 发表于 2024-4-19 17:06:48

wangweijg 发表于 2020-12-3 10:03
解决了，把加载目录跟前面的调整一致。

没理解是啥意思，可以详细讲一下吗

pannelchen · 发表于 2015-2-10 21:51:38

本帖最后由 pannelchen 于 2015-2-10 23:49 编辑

传文件我都搞了半天.

,干脆把演示搞到youku上去了
演示地址

lucas_3333 · 发表于 2015-2-10 22:34:03

不错，家里的网络有问题，总评不了分

♂此处空白♂ · 发表于 2015-2-11 10:48:29

不错，支持一下

伪书虫86 · 发表于 2015-2-11 11:12:44

看得我有了学做图库的冲动了，请教下，幻灯片是怎么制作的啊？

pannelchen · 发表于 2015-2-11 11:25:45

伪书虫86 发表于 2015-2-11 11:12
看得我有了学做图库的冲动了，请教下，幻灯片是怎么制作的啊？

上面代码上有，mslide
好像还有一个slidelib sld封装的

200853006 · 发表于 2015-2-12 10:18:13

赞，收藏了。

迹扬 · 发表于 2015-2-12 14:47:37

简约而不简单，超级实用

davide888 · 发表于 2015-3-19 12:18:14

支持

zkq1212 · 发表于 2015-3-21 11:04:48

非常好用，DCL我改了一下

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

[机械] 图库

本帖子中包含更多资源

评分

本帖被以下淘专辑推荐:

点评

点评

本帖子中包含更多资源

评分