本帖最后由 kwok 于 2014-7-29 14:47 编辑
看看这个:
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=99675
也可以看看这个也是G版的- ;;一键所有填充对象置后显示,CAD2005以上版本适用 By Gu_xl 2014.07.17
- (defun c:tt1 (/ sortents dict lst Doc)
- (setq doc
- (vla-get-ActiveDocument
- (vlax-get-acad-object)
- )
- )
- (vlax-for blockdef (vla-get-blocks doc)
- (cond
- (
- (not
- (VL-CATCH-ALL-ERROR-P
- (setq sortents
- (VL-CATCH-ALL-APPLY
- 'vla-item
- (list
- (setq dict
- (vla-GetExtensionDictionary
- blockdef
- )
- )
- "ACAD_SORTENTS"
- )
- )
- )
- )
- )
- )
- ((setq sortents
- (VL-CATCH-ALL-APPLY
- 'vla-AddObject
- (list dict "ACAD_SORTENTS" "AcDbSortentsTable")
- )
- )
- )
- )
- (setq lst nil)
- (vlax-for obj blockdef
- (if (= "AcDbHatch" (vla-get-objectname obj))
- (setq lst (cons obj lst))
- )
- )
- (if lst
- (progn
- (vla-MoveToBottom
- sortents
- (vlax-make-variant
- (vlax-safearray-fill
- (vlax-make-safearray
- vlax-vbobject
- (cons 0 (1- (length lst)))
- )
- lst
- )
- )
- )
- )
- )
- )
- (vla-regen doc :vlax-true)
- (princ)
- )
G版的 |