分图

/db_自贡黄明儒_ · 发表于 2013-10-29 14:27:56

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 /db_自贡黄明儒_ 于 2017-5-13 23:57 编辑

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

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

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

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

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

ynhh · 发表于 2013-10-29 14:36:17

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

ysq101 · 发表于 2013-10-29 15:52:50

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

ysq101 · 发表于 2013-10-29 17:50:57

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

HLCAD · 发表于 2013-10-30 08:18:20

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

hungten@163.com · 发表于 2013-11-2 18:01:03

这个太高级

sicky111 · 发表于 2013-11-3 01:50:12

楼主是高手。

yjsai666 · 发表于 2017-3-5 14:44:17

厉害！确实是高手

lw5297590 · 发表于 2017-5-13 14:17:56

谢谢黄大侠！

宏光 · 发表于 2018-7-26 22:35:08

谢谢共享，正在研究分图

微龙 · 发表于 2018-7-27 10:06:03

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

lj524917100 · 发表于 2018-7-27 10:28:10

看看，学习一下这功能

lj524917100 · 发表于 2018-7-27 10:29:19

学习一下大神的作品

xdj86 · 发表于 2018-7-28 20:46:13

看看大师作品

sachindkini · 发表于 2018-7-29 03:50:06

support ....

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

[研讨] 分图

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分

点评

点评

点评