求助---------宗地图批量另存(已解决)请看22楼
本帖最后由 dalin1985 于 2012-9-29 21:51 编辑要求：1.图名为宗地号
2.混合总宗为图名加权利人
http://bbs.mjtd.com/xwb/images/bgimg/icon_logo.png 该贴已经同步到 dalin1985的微博 本帖最后由 dalin1985 于 2020-8-7 08:51 编辑
461045462 发表于 2012-8-19 15:58 static/image/common/back.gif
dalin1985 您好:
轻轻地请问一句，您的成果能否分享
谢谢！
:victory::victory::victory::victory::victory::victory::victory::victory::victory::victory::victory::victory::victory::victory::victory::victory::victory: 谁知道在那里加悬赏？ 本帖最后由 Andyhon 于 2012-8-15 15:35 编辑
;;; http://www.afralisp.net/archive/lisp/dclatt2.htm
;;; (defun getatt (enam)
(defun getatt (enam / taglist txtlist)
;retrieve the attributes
(setq thelist (vlax-safearray->list
(variant-value
(vla-getattributes enam))))
;process each attribute
(foreach n thelist
;get the tag attribute data
(setq taglist (cons (vla-get-tagString n) taglist)
;get the text attribute data
txtlist (cons (vla-get-textString n) txtlist)
;how many attributes?
lg (length taglist)
);setq
);foreach
;reverse the lists
(setq taglist (reverse taglist)
txtlist (reverse txtlist))
)
;;; 图形必需可见
(defun W-dwg (blk / strs)
(setq pt (cdr (assoc 10 (entget blk)))
p1 (mapcar '- pt '(5 12))
p3 (mapcar '+ pt '(93 126))
ss (ssget "C" p1 p3)
txts (getAtt (vlax-ename->vla-object blk))
)
(foreach txt txts
(if (wcmatch txt "#########*")
(setq strs (cons txt strs))
)
)
(vl-cmdf "wblock" (car strs) "" pt ss "")
)
;;; for test only
(vl-load-com)
(defun c:test ()
(mapcar 'W-dwg (sslist (ssget '((2 . "tk_a4")))))
)
;;; sslist 函数 站内有
又一苦逼测量同行.顶 Andyhon 发表于 2012-8-15 13:55 static/image/common/back.gif
;;; sslist 函数 站内有
出错了
<选择集: 52> 本帖最后由 Andyhon 于 2012-8-15 16:47 编辑
另图吗?
原测试图 ===>
Command: test
Select objects: All 605 found
599 were filtered out.
Select objects:
wblock Enter name of output file: 5106030050060002006
Enter name of existing block or
[= (block=output file)/* (whole drawing)] <define new drawing>: Specify
insertion base point:
Select objects: 124 found
Select objects:
Command: wblock Enter name of output file: 5106030050060002006
Enter name of existing block or
[= (block=output file)/* (whole drawing)] <define new drawing>: Specify
insertion base point:
Select objects: 124 found
Select objects:
Command: wblock Enter name of output file: 5106030050060002005
Enter name of existing block or
[= (block=output file)/* (whole drawing)] <define new drawing>: Specify
insertion base point:
Select objects: 107 found
Select objects:
Command: wblock Enter name of output file: 5106030050060002004
Enter name of existing block or
[= (block=output file)/* (whole drawing)] <define new drawing>: Specify
insertion base point:
Select objects: 89 found
Select objects:
Command: wblock Enter name of output file: 5106030050060002003
Enter name of existing block or
[= (block=output file)/* (whole drawing)] <define new drawing>: Specify
insertion base point:
Select objects: 116 found
Select objects:
Command: wblock Enter name of output file: 5106030050060002002
Enter name of existing block or
[= (block=output file)/* (whole drawing)] <define new drawing>: Specify
insertion base point:
Select objects: 45 found
Select objects:
Command: (T T T T T T)
Andyhon 发表于 2012-8-15 16:45 static/image/common/back.gif
另图吗?
原测试图 ===>
是原图，错误好像是不能判断单宗和混宗。 重新调试 单宗和混宗 的情况
===========================
在我的机子上卡壳了
----------------------
混合总宗为图名加权利人
图名 ==> "5106030050060002006" ==> ok
权利人 ==>
系统的回应值 ==> "\\M+5CAE6\\M+5F6C7\\M+5CBC9"
在cad内写入为字串时 OK
作为文件名时则会被打回票而过不了关 ...
不知是否有插件可套用!?
所以转了个弯,采用过渡后缀方案,聊胜于无...
;;; http://www.afralisp.net/archive/lisp/dclatt2.htm
;;; (defun getatt (enam)
(defun getatt (enam / taglist txtlist)
;retrieve the attributes
(setq thelist (vlax-safearray->list
(variant-value
(vla-getattributes enam))))
;process each attribute
(foreach n thelist
;get the tag attribute data
(setq taglist (cons (vla-get-tagString n) taglist)
;get the text attribute data
txtlist (cons (vla-get-textString n) txtlist)
;how many attributes?
lg (length taglist)
);setq
);foreach
;reverse the lists
(setq taglist (reverse taglist)
txtlist (reverse txtlist))
)
;;; 宗地图批量另存
;;; 手动添加后缀
(defun W-dwg_Aux (DwgName)
(cond
((findfile (strcat DwgName ".Dwg"))
(prompt "\n已有同名文件 ==> ") (princ Dwgname)
(setq -str (getstring "\n添加临时后缀: "))
(W-dwg_Aux (strCat DwgName -str))
)
(T (vl-cmdf "wblock" DwgName "" pt ss ""))
)
)
;;; 自动添加 "A" 后缀
(defun W-dwg_Aux (DwgName)
(cond
((findfile (strcat DwgName ".Dwg"))
(W-dwg_Aux (strCat DwgName "A"))
)
(T (vl-cmdf "wblock" DwgName "" pt ss ""))
)
)
;;; 图形必需可见
(defun W-dwg (blk / strs)
(setq pt (cdr (assoc 10 (entget blk)))
p1 (mapcar '- pt '(5 12))
p3 (mapcar '+ pt '(93 126))
ss (ssget "C" p1 p3)
txts (getAtt (vlax-ename->vla-object blk))
)
(foreach txt txts
(if (wcmatch txt "#########*")
(setq strs (cons txt strs))
)
)
(W-dwg_Aux (car strs))
)
;;; for test only
(vl-load-com)
(defun c:test ()
(mapcar 'W-dwg (sslist (ssget '((2 . "tk_a4")))))
)
Andyhon 发表于 2012-8-16 09:07 static/image/common/back.gif
重新调试 单宗和混宗 的情况
===========================
程序完美运行了，就是不知道图存哪里了 本帖最后由 Andyhon 于 2012-8-16 22:05 编辑
;;; 自动添加 "A" 后缀
(defun W-dwg_Aux (DwgName)
(cond
((findfile (strcat Path DwgName ".Dwg"))
(W-dwg_Aux (strCat DwgName "A"))
)
(T (vl-cmdf "wblock" (strcat Path DwgName) "" pt ss ""))
)
)
...
(defun c:test ()
(setq Path (getVar "DwgPrefix"))
(mapcar 'W-dwg (sslist (ssget '((2 . "tk_a4")))))
)