求助：如何通过VBA代码访问DWG文件的图形属性
如果你是使用2004版，可以利用Thisdrawing.SummaryInfo来控制如果你是使用以前版本，只能使用XRecord来控制了，麻烦一些 给你一个参考程序，自己慢慢研究吧Sub CreateDWGPROPSXrecord()
' ************* DISLAIMER *************
' This SAMPLE routine was written by
' Autodesk Product Support
' Use it "AT YOUR OWN RISK"
' *************************************
' Define variables
Dim XRecordDataType As Variant
Dim XRecordData As Variant
Dim objDWGPROPS As AcadObject
' Setup error handling
On Error GoTo CreateDWGPROPSXrecord_Error
' Set the constant for the DWGPRPOPS XRecordData
Const XRECORD_NAME = "DWGPROPS"
' Use AutoLISP to create the XRecord object
ThisDrawing.SendCommand ("(/ Xrec Xname) (setq Xrec '((0 . ""XRECORD"") (100 . ""AcDbXrecord"") (1 . ""DWGPROPS COOKIE"") (9 . """"))) (setq Xname (entmakex Xrec)) (dictadd (namedobjdict) ""DWGPROPS"" Xname)" & vbCr)
' Set the types for the DWGPROPS
ReDim XRecordDataType(0 To 22) As Integer
XRecordDataType(0) = CInt(1)
XRecordDataType(1) = CInt(2)
XRecordDataType(2) = CInt(3)
XRecordDataType(3) = CInt(4)
XRecordDataType(4) = CInt(6)
XRecordDataType(5) = CInt(7)
XRecordDataType(6) = CInt(8)
XRecordDataType(7) = CInt(9)
XRecordDataType(8) = CInt(300)
XRecordDataType(9) = CInt(301)
XRecordDataType(10) = CInt(302)
XRecordDataType(11) = CInt(303)
XRecordDataType(12) = CInt(304)
XRecordDataType(13) = CInt(305)
XRecordDataType(14) = CInt(306)
XRecordDataType(15) = CInt(307)
XRecordDataType(16) = CInt(308)
XRecordDataType(17) = CInt(309)
XRecordDataType(18) = CInt(40)
XRecordDataType(19) = CInt(41)
XRecordDataType(20) = CInt(42)
XRecordDataType(21) = CInt(1)
XRecordDataType(22) = CInt(90)
' Set the defaults for the DWGPROPS values
ReDim XRecordData(0 To 22)
XRecordData(0) = CStr("DWGPROPS COOKIE")
XRecordData(1) = CStr("")
XRecordData(2) = CStr("")
XRecordData(3) = CStr("")
XRecordData(4) = CStr("")
XRecordData(5) = CStr("")
XRecordData(6) = CStr("")
XRecordData(7) = CStr("")
XRecordData(8) = CStr("=")
XRecordData(9) = CStr("=")
XRecordData(10) = CStr("=")
XRecordData(11) = CStr("=")
XRecordData(12) = CStr("=")
XRecordData(13) = CStr("=")
XRecordData(14) = CStr("=")
XRecordData(15) = CStr("=")
XRecordData(16) = CStr("=")
XRecordData(17) = CStr("=")
XRecordData(18) = CDbl("0")
XRecordData(19) = CDbl(Now)
XRecordData(20) = CDbl(Now)
XRecordData(21) = CStr("")
XRecordData(22) = CLng("7")
' Get the DWGPROPS object
Set objDWGPROPS = ThisDrawing.Dictionaries(XRECORD_NAME)
' Put the data into the XRecord
objDWGPROPS.SetXRecordData XRecordDataType, XRecordData
' Exit if there have been no errors
Exit Sub
CreateDWGPROPSXrecord_Error:
' If there was an error, display the error
MsgBox Err.Description, vbCritical, "There was an error"
End Sub
页:
[1]