明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 9249|回复: 35

[机械] 图库

    [复制链接]
发表于 2015-2-10 20:26 | 显示全部楼层 |阅读模式
本帖最后由 pannelchen 于 2015-4-5 18:53 编辑

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



  1. ;20150401 增加删除确认.

  2. (defun c:tk ()
  3.           ;(setvar "cmdecho" 0)
  4.   (vl-load-com)
  5.   (setq path "D:\\百度云同步盘\\CAD\\程序\\研究衍伸\\自制幻灯片\\")
  6.           ;可不用设置搜索目录
  7.   (setq keylst '("a1" "a2" "a3" "a4" "a5" "a6" "a7" "a8" "a9"))
  8.           ;将image key 设置成表
  9.   (if nn
  10.     (setq nn nn)
  11.     (setq nn "0")
  12.   )
  13.   (if mm
  14.     (setq mm mm)
  15.     (setq mm "0")
  16.   )
  17.   (if curpage
  18.     (setq curpage curpage)
  19.     (setq curpage 0)
  20.   )
  21.   (if xsc
  22.     (setq xsc xsc)
  23.     (setq xsc "1")
  24.     )
  25.    
  26.   (if sc_uniform
  27.     (setq sc_uniform sc_uniform)
  28.     (setq sc_uniform "0")
  29.   )
  30.   (setq poplst (get_poplst "tk.ini"))
  31.   (setq boxlst (get_boxlst "tk.ini"))
  32.   (dcl_tk)
  33. )

  34. (defun dcl_tk ()
  35.   (setq dcl_id (load_dialog (strcat path "tk.dcl")))
  36.   (new_dialog "tk" dcl_id)
  37.   (show_list "poptk" poplst)
  38.   (set_tile "poptk" nn)      ;设定初始值
  39.   (setq subitem (nth (atoi nn) boxlst))
  40.   (setq sub_boxlst (sub_readfile subitem)) ;取得分列表
  41.   (setq sub_showboxlst (get_del_address_newlist sub_boxlst))
  42.           ;删除地址的新字符串
  43.   (setq len (length sub_showboxlst))
  44.   (show_listnum len)
  45.   (show_list "tk_list" sub_showboxlst)
  46.   (set_tile "tk_list" "0")
  47.   (show_tk_sld keylst sub_boxlst)
  48.   (setq laylst (layer_get_all))    ;得到所有图层
  49.   (show_list "poplay" laylst)    ;laylst
  50.   (set_tile "poplay" mm)    ;设定lay初始值
  51.   (set_tile "xsc" xsc)
  52.    (set_tile "sc_uniform" sc_uniform)
  53.   (if (= sc_uniform "1")
  54.     (progn
  55.       (setq sc (get_tile "xsc"))
  56.       (set_tile "ysc" sc)
  57.       (set_tile "zsc" sc)
  58.       (mode_tile "ysc" 1)
  59.       (mode_tile "zsc" 1)
  60.     )
  61.     (progn
  62.       (mode_tile "ysc" 0)
  63.       (mode_tile "zsc" 0)
  64.       (set_tile "ysc" "1")  ;可修改为统一之前的值,像cad那样
  65.       (set_tile "zsc" "1")
  66.     )
  67.     )

  68.   (set_tile "tkang" "0")
  69.   (set_tile "extra" "pannel\n修改显示顺序在ini文中修改\n插入的图块不对中")
  70.   (action_tile "item" "(sub_openfile \"tk.ini\")")
  71.   (action_tile "sub_item" "(sub_openfile subitem)")
  72.   (action_tile "sub_dir" "(open_sub_dir subitem )")
  73.   (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)"
  74.   )
  75.   (action_tile "tk_up" "(tkup keylst sub_boxlst)")
  76.   (action_tile "tk_down" "(tkdown keylst sub_boxlst)")
  77.   (action_tile "tk_list" "(get_tk $value keylst sub_boxlst)")
  78.           ;显示图像
  79.   (action_tile "xsc" "(setq xsc $value)(y_z_sc)")
  80.   (action_tile "sc_uniform" "(setq sc_uniform $value)(set_tksc)")
  81.   (action_tile "a1" "(setq aa 1)(get_tk_filename aa  sub_boxlst)")          ;图像指定lst
  82.   (action_tile "a2" "(setq aa 2)(get_tk_filename aa  sub_boxlst)")
  83.   (action_tile "a3" "(setq aa 3)(get_tk_filename aa  sub_boxlst)")
  84.   (action_tile "a4" "(setq aa 4)(get_tk_filename aa  sub_boxlst)")
  85.   (action_tile "a5" "(setq aa 5)(get_tk_filename aa  sub_boxlst)")
  86.   (action_tile "a6" "(setq aa 6)(get_tk_filename aa  sub_boxlst)")
  87.   (action_tile "a7" "(setq aa 7)(get_tk_filename aa  sub_boxlst)")
  88.   (action_tile "a8" "(setq aa 8)(get_tk_filename aa  sub_boxlst )")
  89.   (action_tile "a9" "(setq aa 9)(get_tk_filename aa  sub_boxlst)")
  90.   (mode_tile "a1" 4)
  91.   (action_tile "tk_add" "(done_dialog 1)")
  92.   (action_tile "tk_del" "(del_tk)")
  93.   (action_tile "poplay" "(setq mm $value)")
  94.   (action_tile "tk_insert" "(ok_diatk) (done_dialog 2)")
  95.   (setq dd (start_dialog))
  96.   (cond
  97.     ((= dd 1) (add_tk) (dcl_tk))
  98.     ((= dd 2) (insert_tk))
  99.   )
  100. )

  101. (defun ok_diatk  ()
  102.   (setq  inserttk (strcat path   (nth (atoi (get_tile "tk_list")) sub_boxlst)  ".dwg"   ))
  103.   (setq lay (nth (atoi mm) laylst))
  104.   (setq ang (get_tile "tkang"))
  105.   (setq xsc (get_tile "xsc"))
  106.   (setq ysc (get_tile "ysc"))
  107.   (setq bom (get_tile "bom"))
  108. )

  109. (defun insert_tk ()
  110.           ;(setvar "clayer" lay)
  111.   (command "insert" inserttk "x" (atof xsc) "y" (atof ysc) "r" ang pause)
  112. ;;;;拖拽插入 ,x,y ,r分别代表x比例,y比例,循环角度. 0代表
  113.   (setq en1 (entlast))
  114.   (if (= bom "1")
  115.     (command "explode" en1 "")
  116.   )
  117. )


  118.           ;删除 c:\ 目录中的文件 newauto.bat:
  119. ;_$ (vl-file-delete "c:/newauto.bat")
  120. (defun del_tk ()
  121.   (if (/= sub_boxlst nil)
  122.     (progn
  123.       (setq del_n (atoi (get_tile "tk_list")))
  124.       (setq deldata    (nth del_n sub_boxlst))
  125.       (setq filedir (vl-filename-directory subitem))
  126.       (setq deldatadwg (strcat path deldata ".dwg"))
  127.       (setq deldatasld (strcat path deldata ".sld"))
  128.       ;确认是否删除,并标出文件名,
  129.       (del_tk_ifnot)
  130.        (if (= dd1 3)      
  131.           (progn  (vl-file-delete deldatadwg)  ;删除文件
  132.                   (vl-file-delete deldatasld)
  133.                   (setq sub_boxlst (vl-remove deldata sub_boxlst))         
  134.                   (sub_writedata subitem sub_boxlst)
  135.           )
  136.         )
  137.       (setq sub_boxlst (sub_readfile subitem)) ;取得分列表
  138.       (setq sub_showboxlst     (get_del_address_newlist sub_boxlst))
  139.           ;删除地址的新字符串
  140.       (show_list "tk_list" sub_showboxlst)
  141.       (show_tk_sld keylst sub_boxlst)
  142.       ;更新页码;
  143.       ;程序代码
  144.       (setq len (length sub_showboxlst))
  145.       (show_listnum len)
  146.       )
  147.     (progn
  148.       (alert "list无")
  149.     )
  150.   )
  151. )
  152. ;删除图块确认
  153. (defun del_tk_ifnot()
  154.   (setq dcl_id (load_dialog (strcat path "tk.dcl")))
  155.   (new_dialog "del_con" dcl_id)
  156.   (set_tile "del_tk_name"   (vl-filename-base  deldatadwg) )
  157.   (action_tile "accept" "(done_dialog 3)")
  158.   (action_tile "cancel" "(done_dialog 4)")
  159.   (setq dd1 (start_dialog))
  160. )

  161.           ;增加图块
  162. (defun add_tk ()
  163.   (setq filedir (vl-filename-directory subitem))
  164.           ;返回文件名前面的路径
  165.   (setq p1 (getpoint "\n-->请选左下角点:"))
  166.   (setq p2 (getcorner p1 "\n-->请选右上角点:"))
  167.   
  168.   ;亮显选择实体
  169.   ;*************代码**********
  170.   ;
  171.   ;
  172.   ;
  173.   ;
  174.   ;  
  175.   ;*****************
  176.   (while (member (setq name (getstring "请输入图块名"))     sub_showboxlst   )
  177.     (alert "重名")      ;重名重输
  178.     (dcl_tk)
  179.   )
  180.   (setq dwgname (strcat path filedir "\\" name)) ;包含地址.
  181.   (setq name_subitem (strcat filedir "\\" name))
  182.   (setq ss1 (ssget "w" p1 p2))
  183.   (command "zoom"  p1 p2)
  184.   (command "ucs" "d" "uc")    ;删除名为uc的ucs
  185.   (command "ucs" "s" "uc" "ucs" "")  ; save名为uc的 ucs
  186. ;(command "ucs"   "o"   (polar p1 (angle p1 p2) (* 0.5 (distance p1 p2))))          ;重新定义原点中心

  187.   (setq sld (strcat dwgname ".sld"))
  188.   ;(setq pt (getpoint "\n选择插入点坐标:"))
  189. ; (command "-WBLOCK"  dwgname "" pt ss "" "oops")
  190.   (command "wblock" dwgname "" '(0 0 ) ss1  "" "oops")
  191.           ;name中含地址.oops用途:恢复删除的对象?
  192.   ;(command "u")
  193.   (command "mslide" sld)    ;创建幻灯文件
  194.   (command "zoom" "p")      ;放大上一个文件
  195.   (command "ucs" "r" "uc")    ;恢复名为uc的ucs   
  196.           ;加入name到list中
  197.   (setq sub_boxlst (append sub_boxlst (list name_subitem)))
  198.           ;写入文件
  199.   (sub_writedata subitem sub_boxlst)
  200. )



  201. (defun set_tile_tk_list  ()
  202.   (set_tile "tk_list" "0")
  203. )

  204. (defun mod_tile_sld ()
  205.   (mode_tile "a1" 4)
  206. )

  207.           ;比例设置
  208. (defun set_tksc  ()
  209.   (if (= sc_uniform "1")
  210.     (progn
  211.       (setq sc (get_tile "xsc"))
  212.       (set_tile "ysc" sc)
  213.       (set_tile "zsc" sc)
  214.       (mode_tile "ysc" 1)
  215.       (mode_tile "zsc" 1)
  216.     )
  217.     (progn
  218.       (mode_tile "ysc" 0)
  219.       (mode_tile "zsc" 0)
  220.     )
  221.   )
  222. )
  223. ;当统一比例时,实时变化
  224. ;实际上没达到cad那样的功能
  225. (defun y_z_sc ()
  226.   (if (= (get_tile "sc_all") "1")
  227.     (progn
  228.       (set_tile "ysc" xsc)
  229.       (set_tile "zsc" xsc)
  230.       (mode_tile "ysc" 1)
  231.       (mode_tile "zsc" 1)
  232.     )
  233.   )
  234. )

  235.           ;表显示
  236. (defun show_list (key newlist)
  237.   (start_list key)      ;
  238.   (mapcar 'add_list newlist)
  239.   (end_list)
  240. )

  241.           ;显示单个image
  242. (defun show_sld  (key sld)
  243.   (setq x (dimx_tile key))    ;取得图像的右下角x坐标
  244.   (setq y (dimy_tile key))    ;取得图像的右下角y坐标
  245.   (start_image key)      ;开始处理图像对象
  246.   (fill_image 0 0 x y 254)    ;先以背景颜色填满图像x1,y1,width,height,color
  247.   (slide_image 0 0 x y sld)    ;展示幻灯片 x1,y1,width,height,sldname
  248.   (end_image)
  249. )

  250.           ;初始化页码
  251. (defun setcurpage ()
  252.   (setq curpage 0)
  253. )

  254. ;;设置目录并打开目录文件
  255. ;;;可用(vl-filename-directory "c:\\acadwin\\acad.exe"),返回"c:\\acadwin"
  256. (defun open_sub_dir (subitem)
  257.   (setq filedir (vl-filename-directory subitem))
  258.   (setq filedir (strcat path filedir))
  259.   (startapp "EXPLORER.EXE" filedir)                                                                                                                                                                                                                                                                           
  260. )

  261.           ;显示子项目长度
  262. (defun show_listnum (length)
  263.   (set_tile "list_num" (itoa length))
  264. )
  265.           ;把列表中的内容定向image key
  266. (defun show_tk_sld (keylst lst)
  267.   (setq sldlst (mapcar '(lambda (x) (strcat path x)) lst))
  268.           ; list所有字符串加前缀,sld未在搜索路径下必须加上地址,不必加后缀
  269.   (setq  i (* curpage 9)  j 0)
  270.   (setq num (* curpage 9))
  271.   (setq allnum (length sldlst))    ;所有图像sld长度
  272.   (mode_tile "tk_down"     (if (>= (+ (* curpage 9) 9) allnum)   1   0   ))
  273.   (mode_tile "tk_up"       (if (= curpage 0) 1   0   ))
  274.   (while (< j 9)
  275.     (setq key (nth j keylst))
  276.     (setq x (dimx_tile key))    ;取得图像的右下角x坐标
  277.     (setq y (dimy_tile key))    ;取得图像的右下角y坐标
  278.     (start_image key)
  279.     (fill_image 0 0 x y -16)    ;-16:当前对话框的前景色
  280.     (if  (< i allnum)      ;如果无值,不显示
  281.       (progn
  282.   (setq sld (nth i sldlst))
  283.   (slide_image 0 0 x y sld)  ;显示图像  
  284.       )
  285.     )
  286.     (end_image)
  287.     (setq i (1+ i)
  288.     j (1+ j)
  289.     )
  290.   )
  291. )

  292. ;;上一页
  293. (defun tkup (keylst sldlst)
  294.   (setq curpage (- curpage 1))
  295.   (show_tk_sld keylst sldlst)
  296. )

  297. ;下一页
  298. (defun tkdown (keylst sldlst)
  299.   (setq curpage (+ curpage 1))    ;取得页码
  300.   (show_tk_sld keylst sldlst)
  301. )

  302.           ;显示指定sld并指向list   
  303. (defun get_tk (vvs keylst lst)
  304.   (setq n (atoi vvs))
  305.   (setq curpage (fix (/ n 9)))    ;截去实数小数部分,求得页码.
  306.   (show_tk_sld keylst lst)
  307.   (setq num (rem n 9))      ;求余数
  308.   (setq key (nth num keylst))
  309.           ;(setq sldlst (mapcar '(lambda (x) (strcat path x  ))  lst) )
  310.           ;(setq sld (nth  n  sldlst))
  311.           ;(show_sld key sld)
  312.   (mode_tile key 4)
  313. )

  314. ;取得文件名
  315. (defun get_tk_filename (aa lst)
  316.   (setq bb (+ (* curpage 9) (- aa 1)))  ;list位置
  317.   (show_tk_sld keylst lst)
  318.   (set_tile "tk_list" (itoa bb))
  319.   (setq key (strcat "a" (itoa aa)))  ;,由于show_tk_sld中有key值为a9,需重新计算key
  320.           ;(setq sldlst (mapcar '(lambda (x) (strcat path x  ))  lst) )
  321.           ;(if (setq sld (nth  bb sldlst))
  322.           ;(show_sld key sld)
  323.   (mode_tile key 4)
  324.          
  325. )

  326. ;将表指定给tk_list并显示
  327. (defun show_sub_box_lst  (lst)
  328.   (setq key "tk_list")
  329.   (show_list key lst)
  330. )

  331. ;;;[功能]字符串取得特定字符"\\"之后的字符串  ,去除空字符串  ,允许lst为空值
  332. ;;;可用(vl-filename-base "c:\\acadwin\\acad.exe"),返回"acad"
  333. (defun get_del_address_newlist (lst)
  334.   (setq lst (vl-remove "" lst))    ;这里重要,,去除空值
  335.   (setq lst (mapcar '(lambda (x) (vl-filename-base x)) lst))
  336. )


  337.          
  338. (defun sub_readfile (file)    ;TEMP词库
  339.   (setq pathfile (strcat path file))
  340.   (setq file (findfile pathfile))
  341.   (if file
  342.     (progn
  343.       (setq fn (open file "r"))
  344.       (setq tmplst nil)
  345.       (while (setq x (read-line fn))
  346.            (if (/= (substr x 1 1) ";")
  347.             (setq tmplst (append tmplst (list x)))
  348.           )
  349.       )          ;while
  350.     )
  351.     nil
  352.   )          ;progn
  353.   (close fn)
  354.   tmplst
  355.   (setq tempst (vl-remove "" tmplst))
  356. )

  357. ;取得第一行信息
  358. (defun get_poplst (file)
  359.   (setq alllst (sub_readfile file))
  360.   (setq len (length alllst))
  361.   (setq  i 0
  362.   poplst nil
  363.   )
  364.   (setq str (nth i alllst))
  365.   (while (and str (< i len))
  366.     (setq poplst (cons str poplst))
  367.     (setq i (+ i 2))
  368.     (setq str (nth i alllst))
  369.   )
  370.   (setq poplst (reverse poplst))
  371.   (setq poplst (vl-remove "" poplst));删除空白元素
  372.   poplst
  373. )

  374. ;取得第二行信息
  375. (defun get_boxlst (file)
  376.   (setq alllst (sub_readfile file))
  377.   (setq len (length alllst))
  378.   (setq  i 1
  379.   boxlst nil
  380.   )
  381.   (setq str (nth i alllst))
  382.   (while (and str (< i len))
  383.     (setq boxlst (cons str boxlst))
  384.     (setq i (+ i 2))
  385.     (setq str (nth i alllst))
  386.   )
  387.   (setq boxlst (reverse boxlst))
  388.   (setq boxlst (vl-remove "" boxlst))
  389.   boxlst
  390. )

  391. ;;;打开文件
  392. (defun sub_openfile (files)
  393.   (setq path_txt (strcat path files))
  394.   (if (findfile path_txt)
  395.     (startapp "notepad.exe" path_txt)
  396.     (alert (strcat "无" files "文件"))
  397.   )
  398. )

  399. ;将字符串写入文本文件
  400. (defun sub_writedata (pathfile lst)
  401.   (setq ffn (open (strcat path pathfile) "w"))
  402.   ;;写模式.
  403.   (foreach x lst (write-line x ffn))
  404.   (close ffn)
  405.   ;;关闭文件
  406. )

  407. ;返回所有图层
  408. (defun layer_get_all ()
  409.   (setq layer nil)
  410.   (setq lay (tblnext "LAYER" T))  ;重头开始找
  411.   (while (/= lay nil)
  412.     ;(setq layer (append layer (list (cdr (assoc 2 lay)))))
  413.     (setq layer (cons (cdr (assoc 2 lay)) layer))
  414.     (setq lay (tblnext "LAYER"))
  415.   )
  416.   (setq layer (acad_strlsort layer))
  417.   layer          ;返回值
  418. )


本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

评分

参与人数 5明经币 +7 收起 理由
lee50310 + 1 赞一个!
xyp1964 + 3 赞一个!
lucas_3333 + 1 神马都是浮云
Kye + 1 赞一个!
USER2128 + 1 赞一个!

查看全部评分

本帖被以下淘专辑推荐:

发表于 2022-4-12 14:54 | 显示全部楼层
磐舍 发表于 2022-4-7 11:00
这个图库能分享一下么

直接用楼主的代码就可以了,当时是在学习对话框,就拿楼主的代码改了个
发表于 2022-4-12 23:03 | 显示全部楼层
zkq1212 发表于 2022-4-12 14:54
直接用楼主的代码就可以了,当时是在学习对话框,就拿楼主的代码改了个

他这个杂用呀
发表于 2020-12-3 10:03 | 显示全部楼层
lajjs 发表于 2020-8-10 21:32
楼主,我在07版本上用不了,是什么原因啊???

解决了,把加载目录跟前面的调整一致。
 楼主| 发表于 2015-2-10 21:51 | 显示全部楼层
本帖最后由 pannelchen 于 2015-2-10 23:49 编辑

传文件我都搞了半天.,干脆把演示搞到youku上去了
演示地址
发表于 2015-2-10 22:34 | 显示全部楼层
不错,家里的网络有问题,总评不了分
发表于 2015-2-11 10:48 | 显示全部楼层
不错,支持一下
发表于 2015-2-11 11:12 | 显示全部楼层
看得我有了学做图库的冲动了,请教下,幻灯片是怎么制作的啊?
 楼主| 发表于 2015-2-11 11:25 | 显示全部楼层
伪书虫86 发表于 2015-2-11 11:12
看得我有了学做图库的冲动了,请教下,幻灯片是怎么制作的啊?

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

点评

谢谢额  发表于 2015-2-11 14:10
发表于 2015-2-12 10:18 | 显示全部楼层
赞,收藏了。
发表于 2015-2-12 14:47 | 显示全部楼层
简约而不简单,超级实用
发表于 2015-3-19 12:18 | 显示全部楼层
支持           
发表于 2015-3-21 11:04 | 显示全部楼层
非常好用,DCL我改了一下

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

评分

参与人数 1明经币 +1 收起 理由
lee50310 + 1 赞一个!

查看全部评分

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 04:14 , Processed in 0.221961 second(s), 31 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表