entget无法读取外部dwg的图元扩展数据的替代方法
本帖最后由 dcl1214 于 2024-7-10 10:18 编辑有时需要读取外部dwg图纸的扩展，entget无法读取，但是，vla方法是支持的（感谢高老师指点），代码如下：
(defun $kuo-zhan-du-qu-vla$ (object lst / a
app types v values
values-variant vs vss
xtype xvalue
)
;vla方法读取扩展数据【这个函数主要是用来解决dbx读取外部dwg的时候，entget无法读取扩展数据的问题】
(setq xtype nil
xvalue nil
vss nil
app nil
vs nil
)
(cond ((= (type object) 'vla-object) t)
((= (type object) 'ename)
(setq object (vlax-ename->vla-object object))
)
(t (setq object nil))
)
(and object
(progn
(vl-catch-all-apply
'vla-getxdata
(list object "" 'xtype 'xvalue)
)
(and xtype
xvalue
(progn
(setq types (vl-catch-all-apply
'vlax-safearray->list
(list xtype)
)
)
(setq object nil)
(setq values-variant
(vl-catch-all-apply
'vlax-safearray->list
(list xvalue)
)
)
)
)
(if (vl-catch-all-error-p values-variant)
(setq values-variant nil)
)
(setq values (mapcar 'vlax-variant-value values-variant))
(while (and (setq a (car types))
(setq v (car values))
)
(or app (setq app v))
(and (not (= a 1001))
(progn
(and (not (= a 1002))
(setq vs (cons (cons a v) vs))
)
)
)
(and (= (cadr types) 1001)
(progn
(setq vss (cons (cons app (reverse vs)) vss))
(setq vs nil)
(setq app nil)
)
)
(setq types (cdr types))
(setq values (cdr values))
)
(setq vss (cons (cons app (reverse vs)) vss))
(setq vss (reverse vss))
(setq vs nil)
)
)
vss
)
高老师肯定是桌子公司的卧底:lol
页:
[1]