分图

/db_自贡黄明儒_

;;---------------------------------------------------------------下面是经使用略为改进一下的

游客，如果您要查看本帖隐藏内容请回复

;;;;----------------------------------------------------------------------------------------old
;;假如一个文件内画许多图，用电脑的搜索功能可能找不到，需拆分，以文件名保存，但于后来找查

1. ;;分图
   
2. ;;假如一个文件内画许多图，用电脑的搜索功能可能找不到，需拆分，以文件名保存，但于后来找查
   
3. (defun C:ft (/ ANSWER EN FLAG FLAG1 INITDIR NEWDNAME SS)
   
4.   (if (setq Initdir (getvar "dwgprefix"))
   
5.     nil
   
6.     (progn (princ "\n 文件未保存,不能分图") (exit))
   
7.   )
   
8.   (setq flag1 T)
   
9.   (while (and flag1
   
10.               (setq en (entsel "\n >拾取文件名 "))
    
11.               (setq en (nentselp (cadr en)))
    
12.               (setq NewDName (cdr (assoc 1 (entget (car en)))))
    
13.               (equal (type NewDName) 'STR)
    
14.          )
    
15.     (if        (findfile (strcat Initdir NewDName ".DWG"))
    
16.       (setq flag T)
    
17.     )
    
18.     (while flag
    
19.       (princ
    
20.         (strcat "\n 文件名" NewDName "已经存在，请重输入文件名")
    
21.       )
    
22.       (setq NewDName (getstring "\n???输入文件名: "))
    
23.       (if (findfile (strcat Initdir NewDName ".DWG"))
    
24.         nil
    
25.         (setq flag nil)
    
26.       )
    
27.     )
    
28.     (princ "\n >>此图范围")
    
29.     (setvar "NOMUTT" 1)
    
30.     (setq ss (ssget))
    
31.     (setvar "NOMUTT" 0)
    
32. 
    
33.     (command "_.WBLOCK"
    
34.              (strcat Initdir NewDName)
    
35.              ""
    
36.              "0,0"
    
37.              ss
    
38.              ""
    
39.     )
    
40.     (princ (strcat "\n >>>文件" NewDName "成功保存!!!\n"))
    
41.     (if        (ssget "X")
    
42.       (progn
    
43.         (initget "Yes No")
    
44.         (setq answer (GETKWORD "[停止(N)/断续(Y)]<断续Y>"))
    
45.         (if (equal answer "No")
    
46.           (setq flag1 nil)
    
47.         )
    
48.       )
    
49.       (setq flag1 nil)
    
50.     )
    
51.   )
    
52.   (princ)
    
53. )

;;分图<br /> ;;假如一个文件内画许多图，用电脑的搜索功能可能找不到，需拆分，以文件名保存，但于后来找查<br /> (defun C:ft (/ ANSWER EN FLAG FLAG1 INITDIR NEWDNAME SS)<br />   (if (setq Initdir (getvar "dwgprefix"))<br />     nil<br />     (progn (princ "\n 文件未保存,不能分图") (exit))<br />   )<br />   (setq flag1 T)<br />   (while (and flag1<br />               (setq en (entsel "\n >拾取文件名 "))<br />               (setq en (nentselp (cadr en)))<br />               (setq NewDName (cdr (assoc 1 (entget (car en)))))<br />               (equal (type NewDName) 'STR)<br />          )<br />     (if        (findfile (strcat Initdir NewDName ".DWG"))<br />       (setq flag T)<br />     )<br />     (while flag<br />       (princ<br />         (strcat "\n 文件名" NewDName "已经存在，请重输入文件名")<br />       )<br />       (setq NewDName (getstring "\n???输入文件名: "))<br />       (if (findfile (strcat Initdir NewDName ".DWG"))<br />         nil<br />         (setq flag nil)<br />       )<br />     )<br />     (princ "\n >>此图范围")<br />     (setvar "NOMUTT" 1)<br />     (setq ss (ssget))<br />     (setvar "NOMUTT" 0)<br /> <br />     (command "_.WBLOCK"<br />              (strcat Initdir NewDName)<br />              ""<br />              "0,0"<br />              ss<br />              ""<br />     )<br />     (princ (strcat "\n >>>文件" NewDName "成功保存!!!\n"))<br />     (if        (ssget "X")<br />       (progn<br />         (initget "Yes No")<br />         (setq answer (GETKWORD "[停止(N)/断续(Y)]<断续Y>"))<br />         (if (equal answer "No")<br />           (setq flag1 nil)<br />         )<br />       )<br />       (setq flag1 nil)<br />     )<br />   )<br />   (princ)<br /> )

ynhh

黄工太爱研究了啊
找查方面有专门的软件感觉很好用的

ysq101

支持黄工。。。。。高手就是高手

ysq101

论坛活跃高手啊~！~~~说得不对吗？？？

HLCAD

黄大侠的这个功能实用，我一般采用：“图号_名称.dwg”格式，对黄大侠的程序稍稍修改就可以应用了，谢谢黄大侠！

hungten@163.com

这个太高级

sicky111

楼主是高手。

yjsai666

厉害！确实是高手

lw5297590

谢谢黄大侠！

宏光

谢谢共享，正在研究分图

微龙

下载研究一下分图，能用的着。

lj524917100

看看，学习一下这功能

lj524917100

学习一下大神的作品

xdj86

看看大师作品

sachindkini

support ....