malianxnkj 发表于 2010-6-23 16:26:00

批量写块，求助。。。

  
<div><img src="file:///C:/DOCUME~1/ADMINI~1/LOCALS~1/Temp/MAC41`YMA31Z$W4QHLG25EB.jpg"/> </div>
<p>&nbsp;</p>
<p>如上图：</p>
<p>&nbsp;&nbsp; 有一排这样的块（几千个），需要批量把他们分割成一个一个的文件</p>
<p>&nbsp;&nbsp; 文件名以图中的宗地编号命名，附件有样本图式</p>
<p>&nbsp;&nbsp; 各位高手指点下，谢谢。</p>

gufeng 发表于 2010-6-24 12:25:00

(defun c:test (/    BLOCK_NAMEFILED    FILE_PATH
      MAXPOINT    MINPOINT    OBJ    OBJ_10
      OBJ_DATA    OBJ_I       OBJ_NAME    OBJ_WBLOCK
      OLDMCDECHOSEAR_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 发表于 2010-6-25 17:53:00

<p>&nbsp;谢谢，很好用</p>

zhixin365 发表于 2010-6-27 13:36:00

lik132 发表于 2010-12-17 11:27:04

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

malianxnkj 发表于 2011-6-5 22:09:29

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

hh0066 发表于 2011-8-3 18:18:02

强大，要好好学一下liap

Andyhon 发表于 2011-8-3 20:25:22

回复 malianxnkj 的帖子

yygusong 发表于 2011-8-9 17:56:00

太强了，牛人

czb203 发表于 2011-8-15 20:47:30

什么东西这么牛逼啊
页: [1]
查看完整版本: 批量写块，求助。。。