批量写块，求助。。。

malianxnkj

  

 

如上图：

   有一排这样的块（几千个），需要批量把他们分割成一个一个的文件

   文件名以图中的宗地编号命名，附件有样本图式

   各位高手指点下，谢谢。

gufeng

2. (defun c:test (/    BLOCK_NAME  FILED    FILE_PATH
3.         MAXPOINT    MINPOINT    OBJ    OBJ_10
4.         OBJ_DATA    OBJ_I       OBJ_NAME    OBJ_WBLOCK
5.         OLDMCDECHO  SEAR_ZDH_PT SEAR_ZDH_PT1
6.         ZDH    ZDH_T
7.        )
8. ;;;调用系统选择文件夹对话框  来源于明经通道
9.   (defun qf_getFolder (msg / WinShell shFolder path catchit)
10.     (vl-load-com)
11.     (setq winshell (vlax-create-object "Shell.Application"))
12.     (setq
13.       shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1)
14.     )
15.     (setq
16.       catchit (vl-catch-all-apply
17.   '(lambda ()
18.      (setq shFolder (vlax-get-property shFolder 'self))
19.      (setq path (vlax-get-property shFolder 'path))
20.    )
21.        )
22.     )
23.     (if (vl-catch-all-error-p catchit)
24.       nil
25.       path
26.     )
27.   )
28.   (setq block_name "gddjtk4")
29.   (setq obj (ssget (list (cons 0 "insert") (cons 2 block_name))))
30.   (if obj
31.     (progn
32.       (setq filed (qf_getFolder "选择保存的路径:"))
33.       (if filed
34. (progn
35.    (setq oldmcdecho (getvar "cmdecho"))
36.    (setvar "cmdecho" 0)
37.    (setq obj_i -1)
38.    (repeat (sslength obj)
39.      (setq obj_name (ssname obj (setq obj_i (1+ obj_i))))
40.      (vla-GetBoundingBox
41.        (vlax-ename->vla-object obj_name)
42.        'minpoint
43.        'maxpoint
44.      ) ;_取得包容图元的最大点和最小点
45.      (setq minpoint (vlax-safearray->list minpoint)) ;_左下角
46.      (setq maxpoint (vlax-safearray->list maxpoint)) ;_右上角
47.      (command "..zoom" minpoint maxpoint)
48.      (setq obj_data (entget obj_name))
49.      (setq obj_10 (cdr (assoc 10 obj_data))) ;_块的插入点，用于找到宗地编号
50.      (setq sear_zdh_pt1 (polar obj_10 (/ pi 2) 76))
51.      (setq sear_zdh_pt (polar sear_zdh_pt1 0 15))
52.      (setq zdh_t (ssname (ssget "f"
53.            (list sear_zdh_pt sear_zdh_pt1)
54.            '((0 . "text"))
55.     )
56.     0
57.    )
58.      )
59.      (setq zdh (cdr (assoc 1 (entget zdh_t))))
60.      (setq file_path (strcat filed "\" zdh ".dwg"))
61.      (setq obj_wblock (ssget "c" minpoint maxpoint))
62.      (command "-wblock" file_path "" obj_10 obj_wblock "" "oops")
63.    )
64.    (setvar "cmdecho" oldmcdecho)
65.    (princ "\n完成")
66. )
67.       )
68.     )
69.   )
70.   (princ)
71. )

(defun c:test (/    BLOCK_NAME  FILED    FILE_PATH         MAXPOINT    MINPOINT    OBJ    OBJ_10         OBJ_DATA    OBJ_I       OBJ_NAME    OBJ_WBLOCK         OLDMCDECHO  SEAR_ZDH_PT SEAR_ZDH_PT1         ZDH    ZDH_T        ) ;;;调用系统选择文件夹对话框  来源于明经通道   (defun qf_getFolder (msg / WinShell shFolder path catchit)     (vl-load-com)     (setq winshell (vlax-create-object "Shell.Application"))     (setq       shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1)     )     (setq       catchit (vl-catch-all-apply   '(lambda ()      (setq shFolder (vlax-get-property shFolder 'self))      (setq path (vlax-get-property shFolder 'path))    )        )     )     (if (vl-catch-all-error-p catchit)       nil       path     )   )   (setq block_name "gddjtk4")   (setq obj (ssget (list (cons 0 "insert") (cons 2 block_name))))   (if obj     (progn       (setq filed (qf_getFolder "选择保存的路径:"))       (if filed (progn    (setq oldmcdecho (getvar "cmdecho"))    (setvar "cmdecho" 0)    (setq obj_i -1)    (repeat (sslength obj)      (setq obj_name (ssname obj (setq obj_i (1+ obj_i))))      (vla-GetBoundingBox        (vlax-ename->vla-object obj_name)        'minpoint        'maxpoint      ) ;_取得包容图元的最大点和最小点      (setq minpoint (vlax-safearray->list minpoint)) ;_左下角      (setq maxpoint (vlax-safearray->list maxpoint)) ;_右上角      (command "..zoom" minpoint maxpoint)      (setq obj_data (entget obj_name))      (setq obj_10 (cdr (assoc 10 obj_data))) ;_块的插入点，用于找到宗地编号      (setq sear_zdh_pt1 (polar obj_10 (/ pi 2) 76))      (setq sear_zdh_pt (polar sear_zdh_pt1 0 15))      (setq zdh_t (ssname (ssget "f"            (list sear_zdh_pt sear_zdh_pt1)            '((0 . "text"))     )     0    )      )      (setq zdh (cdr (assoc 1 (entget zdh_t))))      (setq file_path (strcat filed "\" zdh ".dwg"))      (setq obj_wblock (ssget "c" minpoint maxpoint))      (command "-wblock" file_path "" obj_10 obj_wblock "" "oops")    )    (setvar "cmdecho" oldmcdecho)    (princ "\n完成") )       )     )   )   (princ) )

malianxnkj

 谢谢，很好用

lik132

跟我遇到问题类似，借用一下，谢谢高手

malianxnkj

     上面的程序很好用，但后面的图框和样式有些改变，程序就不能使用了
   请帮忙修改下好不，
   修改后图和坐标表单独保存为一个文件。
   应该是要修改下选择的范围，可我不会，
   那位大侠帮帮忙吧
   这是样本

hh0066

强大，要好好学一下liap

Andyhon

回复 malianxnkj 的帖子

yygusong

太强了，牛人

czb203

什么东西这么牛逼啊