分图

自贡黄明儒

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

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 /> )

应该实用吧

wgij007

自贡黄明儒 发表于 2013-10-29 14:57
图框上应该有文件名吧？拾取应该更合理些，我认为

老大，这个如何能设置保存路径呀

kwok

文件名也能直接输入更好些吧

自贡黄明儒

kwok 发表于 2013-10-29 14:53
文件名也能直接输入更好些吧

图框上应该有文件名吧？拾取应该更合理些，我认为

llsheng_73

可以综合起来考虑，不想拾取的可以自己给它取个名字

gdslqs

应该加个自己设定保存位置

自贡黄明儒

llsheng_73 发表于 2013-10-29 15:55
可以综合起来考虑，不想拾取的可以自己给它取个名字

自己给它取名字，岂不是很麻烦?

llsheng_73

自贡黄明儒 发表于 2013-11-11 14:32
自己给它取名字，岂不是很麻烦?

也不会麻烦啊，可能你对地形图涉及得少一些，地形图分幅一般按西南角坐标来命名的，所以取名就有了命名规则,所以它很简单
黄老你所谓的麻烦不过是没找到合适的命名规则吧?

llsheng_73

其实是要输入图名还是点取文字或者自动命名或者保存位置都是小问题，老黄这东东它能分幅才是最关键的核心。
其它所有问题都可以根据自己需要或者喜好略加修改就成了，再次感谢老黄的奉献，虽然我没有下载它

诸葛四郎

太强大了！