求助：如何通过VBA代码访问DWG文件的图形属性

amen10

mccad

如果你是使用2004版，可以利用Thisdrawing.SummaryInfo来控制
如果你是使用以前版本，只能使用XRecord来控制了，麻烦一些

mccad

给你一个参考程序，自己慢慢研究吧

2. Sub CreateDWGPROPSXrecord()
   
3.    
   
4.    ' ************* DISLAIMER *************
   
5.    ' This SAMPLE routine was written by
   
6.    ' Autodesk Product Support
   
7.    ' Use it "AT YOUR OWN RISK"
   
8.    ' *************************************
   
9.    
   
10.    ' Define variables
    
11.    Dim XRecordDataType As Variant
    
12.    Dim XRecordData As Variant
    
13.    Dim objDWGPROPS As AcadObject
    
14.    
    
15.    ' Setup error handling
    
16.    On Error GoTo CreateDWGPROPSXrecord_Error
    
17.    
    
18.    ' Set the constant for the DWGPRPOPS XRecordData
    
19.    Const XRECORD_NAME = "DWGPROPS"
    
20. 
    
21.    ' Use AutoLISP to create the XRecord object
    
22.    ThisDrawing.SendCommand ("(/ Xrec Xname) (setq Xrec '((0 . ""XRECORD"") (100 . ""AcDbXrecord"") (1 . ""DWGPROPS COOKIE"") (9 . """"))) (setq Xname (entmakex Xrec)) (dictadd (namedobjdict) ""DWGPROPS"" Xname)" & vbCr)
    
23.    
    
24.    ' Set the types for the DWGPROPS
    
25.    ReDim XRecordDataType(0 To 22) As Integer
    
26.    XRecordDataType(0) = CInt(1)
    
27.    XRecordDataType(1) = CInt(2)
    
28.    XRecordDataType(2) = CInt(3)
    
29.    XRecordDataType(3) = CInt(4)
    
30.    XRecordDataType(4) = CInt(6)
    
31.    XRecordDataType(5) = CInt(7)
    
32.    XRecordDataType(6) = CInt(8)
    
33.    XRecordDataType(7) = CInt(9)
    
34.    XRecordDataType(8) = CInt(300)
    
35.    XRecordDataType(9) = CInt(301)
    
36.    XRecordDataType(10) = CInt(302)
    
37.    XRecordDataType(11) = CInt(303)
    
38.    XRecordDataType(12) = CInt(304)
    
39.    XRecordDataType(13) = CInt(305)
    
40.    XRecordDataType(14) = CInt(306)
    
41.    XRecordDataType(15) = CInt(307)
    
42.    XRecordDataType(16) = CInt(308)
    
43.    XRecordDataType(17) = CInt(309)
    
44.    XRecordDataType(18) = CInt(40)
    
45.    XRecordDataType(19) = CInt(41)
    
46.    XRecordDataType(20) = CInt(42)
    
47.    XRecordDataType(21) = CInt(1)
    
48.    XRecordDataType(22) = CInt(90)
    
49.    
    
50.    ' Set the defaults for the DWGPROPS values
    
51.    ReDim XRecordData(0 To 22)
    
52.    XRecordData(0) = CStr("DWGPROPS COOKIE")
    
53.    XRecordData(1) = CStr("")
    
54.    XRecordData(2) = CStr("")
    
55.    XRecordData(3) = CStr("")
    
56.    XRecordData(4) = CStr("")
    
57.    XRecordData(5) = CStr("")
    
58.    XRecordData(6) = CStr("")
    
59.    XRecordData(7) = CStr("")
    
60.    XRecordData(8) = CStr("=")
    
61.    XRecordData(9) = CStr("=")
    
62.    XRecordData(10) = CStr("=")
    
63.    XRecordData(11) = CStr("=")
    
64.    XRecordData(12) = CStr("=")
    
65.    XRecordData(13) = CStr("=")
    
66.    XRecordData(14) = CStr("=")
    
67.    XRecordData(15) = CStr("=")
    
68.    XRecordData(16) = CStr("=")
    
69.    XRecordData(17) = CStr("=")
    
70.    XRecordData(18) = CDbl("0")
    
71.    XRecordData(19) = CDbl(Now)
    
72.    XRecordData(20) = CDbl(Now)
    
73.    XRecordData(21) = CStr("")
    
74.    XRecordData(22) = CLng("7")
    
75.    
    
76.    ' Get the DWGPROPS object
    
77.    Set objDWGPROPS = ThisDrawing.Dictionaries(XRECORD_NAME)
    
78.    
    
79.    ' Put the data into the XRecord
    
80.    objDWGPROPS.SetXRecordData XRecordDataType, XRecordData
    
81.    
    
82.    ' Exit if there have been no errors
    
83.    Exit Sub
    
84.    
    
85. CreateDWGPROPSXrecord_Error:
    
86. 
    
87.    ' If there was an error, display the error
    
88.    MsgBox Err.Description, vbCritical, "There was an error"
    
89.    
    
90. End Sub

Sub CreateDWGPROPSXrecord()<br />    <br />    ' ************* DISLAIMER *************<br />    ' This SAMPLE routine was written by<br />    ' Autodesk Product Support<br />    ' Use it "AT YOUR OWN RISK"<br />    ' *************************************<br />    <br />    ' Define variables<br />    Dim XRecordDataType As Variant<br />    Dim XRecordData As Variant<br />    Dim objDWGPROPS As AcadObject<br />    <br />    ' Setup error handling<br />    On Error GoTo CreateDWGPROPSXrecord_Error<br />    <br />    ' Set the constant for the DWGPRPOPS XRecordData<br />    Const XRECORD_NAME = "DWGPROPS"<br /> <br />    ' Use AutoLISP to create the XRecord object<br />    ThisDrawing.SendCommand ("(/ Xrec Xname) (setq Xrec '((0 . ""XRECORD"") (100 . ""AcDbXrecord"") (1 . ""DWGPROPS COOKIE"") (9 . """"))) (setq Xname (entmakex Xrec)) (dictadd (namedobjdict) ""DWGPROPS"" Xname)" & vbCr)<br />    <br />    ' Set the types for the DWGPROPS<br />    ReDim XRecordDataType(0 To 22) As Integer<br />    XRecordDataType(0) = CInt(1)<br />    XRecordDataType(1) = CInt(2)<br />    XRecordDataType(2) = CInt(3)<br />    XRecordDataType(3) = CInt(4)<br />    XRecordDataType(4) = CInt(6)<br />    XRecordDataType(5) = CInt(7)<br />    XRecordDataType(6) = CInt(8)<br />    XRecordDataType(7) = CInt(9)<br />    XRecordDataType(8) = CInt(300)<br />    XRecordDataType(9) = CInt(301)<br />    XRecordDataType(10) = CInt(302)<br />    XRecordDataType(11) = CInt(303)<br />    XRecordDataType(12) = CInt(304)<br />    XRecordDataType(13) = CInt(305)<br />    XRecordDataType(14) = CInt(306)<br />    XRecordDataType(15) = CInt(307)<br />    XRecordDataType(16) = CInt(308)<br />    XRecordDataType(17) = CInt(309)<br />    XRecordDataType(18) = CInt(40)<br />    XRecordDataType(19) = CInt(41)<br />    XRecordDataType(20) = CInt(42)<br />    XRecordDataType(21) = CInt(1)<br />    XRecordDataType(22) = CInt(90)<br />    <br />    ' Set the defaults for the DWGPROPS values<br />    ReDim XRecordData(0 To 22)<br />    XRecordData(0) = CStr("DWGPROPS COOKIE")<br />    XRecordData(1) = CStr("")<br />    XRecordData(2) = CStr("")<br />    XRecordData(3) = CStr("")<br />    XRecordData(4) = CStr("")<br />    XRecordData(5) = CStr("")<br />    XRecordData(6) = CStr("")<br />    XRecordData(7) = CStr("")<br />    XRecordData(8) = CStr("=")<br />    XRecordData(9) = CStr("=")<br />    XRecordData(10) = CStr("=")<br />    XRecordData(11) = CStr("=")<br />    XRecordData(12) = CStr("=")<br />    XRecordData(13) = CStr("=")<br />    XRecordData(14) = CStr("=")<br />    XRecordData(15) = CStr("=")<br />    XRecordData(16) = CStr("=")<br />    XRecordData(17) = CStr("=")<br />    XRecordData(18) = CDbl("0")<br />    XRecordData(19) = CDbl(Now)<br />    XRecordData(20) = CDbl(Now)<br />    XRecordData(21) = CStr("")<br />    XRecordData(22) = CLng("7")<br />    <br />    ' Get the DWGPROPS object<br />    Set objDWGPROPS = ThisDrawing.Dictionaries(XRECORD_NAME)<br />    <br />    ' Put the data into the XRecord<br />    objDWGPROPS.SetXRecordData XRecordDataType, XRecordData<br />    <br />    ' Exit if there have been no errors<br />    Exit Sub<br />    <br /> CreateDWGPROPSXrecord_Error:<br /> <br />    ' If there was an error, display the error<br />    MsgBox Err.Description, vbCritical, "There was an error"<br />    <br /> End Sub