（原创）通用函数若干

caoyin

;4 vla方法构造的选择集
删除VLA选择集只要一行代码
(vlax-map-collection SS 'vla-delete)
----------------------------------------------------
原位置复制一个ename
(entmake (entget ename))
原位置复制一个VLA对象
(vla-copy OBJ)
原位置复制VLA选集
(vlax-map-collection SS 'vla-copy)
----------------------------------------------------
vla-Explode方法不能分解的东西太多了,例如MTEXT\MLINE，无法替代(command "Explode"...)

cheng5276

多谢曹版的指点，哈哈不甚感激

hhh454

代码很多，有的学了，谢谢楼主分享

skynoon

很不错，学习啦

zbwei120

真是厉害，先收下慢慢学。

cheng5276

七 DBX 系列
   1、DBX创建
;file-文件的地址
;返回值：DBX对象
   (defun cheng5276-dbx (file / dbxstr dbx)
(setq DbxStr (if (< (atof (getvar "ACADVER")) 16.0)　
"ObjectDBX.AxDbDocument"　
(strcat "ObjectDBX.AxDbDocument." (substr (getvar "acadver") 1 2))
)　
)　
(setq dbx (Vlax-Get-Or-Create-Object DbxStr))
(if file (vla-open dbx file))
dbx
)

2、DBX复制特定文件的块名列表至本图
；file-文件名 namelst-块名列表
(defun cheng5276-dbx-copyblocks (file namelst / blk dbx dbxblocks name num)
(setq dbx (cheng5276-dbx file))
(setq DBXBLOCKS (vla-get-blocks DBX))
(if (not namelst)
(vlax-for BLK DBXBLOCKS
(if  (and (not (wcmatch (substr (vla-get-name BLK) 1 1) "`*")) (= (vla-get-isxref BLK) :vlax-false)) ;去除系统块、匿名块和参照类对象
                              (setq namelst (append namelst (list (vla-get-name BLK)) ))
                            );结束IF
)
)

(foreach name namelst
(setq num (vla-item DBXBLOCKS name))
(vla-copyobjects DBX (vlax-safearray-fill (vlax-make-safearray vlax-vbobject '(0 . 0)) (list num)) (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
)
(vlax-release-object dbx)
)


3 、取得特定布局vla对象列表
;+++++++参数说明
;+++++++dbx——被打开DBX对象      ;+++++++space——模型或图纸空间对象，当为NIL时，则取模型空间
;++++++图太大时，获取可能会比较慢，所以加入了进度条显示（需DOSLIB支持），若无需可注释掉

(defun cheng5276-dbx-objlst (dbx space / blocks dwg_path erro nam obj objlst pspace)
（if （not space) (setq space  (Vlax-Get dbx 'ModelSpace)))
(dos_getprogress "正在提取图元" "请耐心等待" (Vlax-Get space  'Count ) t);显示进度条
(setq i 0)
(vlax-for obj space
  (setq objlst (append objlst (list obj)))
(setq i (1+ i))
(dos_getprogress i);前进进度条
  )
  (dos_getprogress T) ;关闭进度条
objlst
)


4、超强大的 任意图元选择集转为块
;支持天正等任意自定义对象
;DOC ——nil则对当前图操作； 为DBX时，则可实现不开图处理(今天试了下，好像有点问题）
;PT ——nil直接取原点，；blockname——nil则生成匿名块
；layout ——nil 则为当前激活的布局中
；函数中均采用VLISP方法，不可用ENTMAKE，否则当有自定义对象时会处理不了
;(cheng5276-make-block (getpoint) nil (ssget) doc layout)

(defun cheng5276-make-block (pt blockname ss doc layout / blkobj name objlst sarray)
(setq objlst (A->objlst ss))
(if (not pt) (setq pt '(0 0 0)))
(if (not blockname) (setq blockname "*U"))
(if (not doc) (setq doc (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument)))
(if (not layout) (setq layout (Vlax-Get (Vlax-Get doc 'ActiveLayout) 'Block)))
(setq blkobj (vla-add (Vlax-Get doc 'Blocks) (vlax-3d-point pt) blockname))
(setq sArray
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbObject
(cons 0 (1- (length objlst)))
)
objlst
)
)
(vla-copyobjects doc sArray blkobj)
(mapcar 'Vla-Delete objlst)
(setq name (vla-get-name blkobj))
(Vla-InsertBlock layout (vlax-3d-point pt) name 1 1 1 0)  ;返回VLA对象,（ DBX模式好像有问题，没能插入成功，请高手指正）
)


;5、任意对象转obj 选择集（上个函数中调用）
(DEFUN A->OBJLST (A / count enm i len obj objlst ss style x)
(if A
(PROGN
(setq STYLE (type A) SS (SSADD))
;以下根据A的类型分类
(cond
;1 单个图元名对象
((= style 'ENAME)
(SetQ OBJLST (LIST (vlax-ename->vla-object A)))
)
;2、SSGET选择集
((= STYLE 'PICKSET)
(setq len (sslength A) i 0)
(repeat len
(setq obj (vlax-ename->vla-object (ssname A i)))
(setq OBJLST (append OBJLST (list obj)))
(setq i (1+ i))
)
)

;3 图元名表，还可增加OBJ表类
((= STYLE 'LIST)
(if (= (TYPE (car A)) 'VLA-OBJECT)
(setq OBJLST A)
(SETQ OBJLST (mapcar 'vlax-ename->vla-object A))
)
)

;4 VLA选择集
((and (= STYLE 'VLA-OBJECT) (not (vl-catch-all-error-p (vl-catch-all-apply '(lambda () (SETQ COUNT (Vlax-Get A 'Count)))))))
(vlax-map-collection A '(lambda (x) (setq OBJLST (append OBJLST X))))
)
;5 单个OBJ对象
((= style 'VLA-OBJECT)
(setq OBJLST (list A))
)
)
OBJLST
)
nil
)
)
；新手们(其实我自己也是）把以上函数弄懂了，DBX也就不难了。

革天明

楼主很强悍

vlisp2012

多谢分享，学习了！！！！

syqtm

，准备学习中，收藏，研究下

江湖远人

多谢楼主分享，收藏了