Uggggh我觉得自己很迟钝。我有一个名为updateattribute的文件。参考commondialogue的dvb。dvb文件。我已经把你们的共同点,并把他们在更新文件的末尾。我仍然不确定在哪里放置init。直达线?我只是不知道你说的开始是什么意思,因为我记得vba没有#039;不要像lisp一样自上而下地阅读。本人';我会把所有的代码都贴出来,这样你就可以看到我看到了什么
- Option Explicit
- 'Stores block names & attributes for 1st inserted block of each
- Public AllBlocks As Scripting.Dictionary
- 'Stores attributes for selected block
- Public AllAttribs As Variant
- 'Macro for user interface
- Public Sub Ua()
- Dim myFiles As Variant 'Stores filenames selected in array
- myFiles = GetFiles 'Store filenames selected by user in array
-
- 'AllBlocks is a public variable
- Set AllBlocks = New Scripting.Dictionary 'Initialize storage
- BlockDialog.BlockPicked = "" 'Initialize check variable
- Set AttribDialog.AttribPicked = Nothing 'Initialize check variable
- TextDialog.DoUpdate = False 'Initialize check variable
-
- 'If files are selected
- If IsArray(myFiles) Then
- Dim myDoc As AcadDocument 'Need a variable for a drawing
- 'Get the first drawing selected by user
- Set myDoc = AcadApplication.Documents.Open(myFiles(0))
- GetBlocks myDoc, AllBlocks 'Get all attributed blocks in dwg
- End If
-
- 'There may be no attributed blocks, so need to test
- If AllBlocks.Count > 0 Then BlockDialog.Show 'Show list of blocks
-
- 'If a block was selected
- If BlockDialog.BlockPicked "" Then
- 'Store attributes from selected block in public variable
- AllAttribs = AllBlocks.Item(BlockDialog.BlockPicked)
- AttribDialog.Show 'Show list of attributes
- End If
-
- 'If an attribute was selected
- If Not (AttribDialog.AttribPicked Is Nothing) Then
- TextDialog.Show 'Display dialog to get new string
- End If
-
- 'If OK was hit in the TextDialog
- If TextDialog.DoUpdate Then
- 'Change all the drawings the user selected
- ProcessDrawings myFiles, _
- BlockDialog.BlockPicked, _
- AttribDialog.AttribPicked.TagString, _
- TextDialog.NewText
-
- 'Inform the user things are done
- MsgBox "Process is complete.", vbOKOnly, "ABC's of VBA"
- Else
- myDoc.Close False 'Close drawing left open during cancel
- End If
- End Sub
- 'Open all given drawings and change selected attribute
- Private Sub ProcessDrawings(ByVal Dwgs As Variant, _
- ByVal BlockName As String, _
- ByVal TagName As String, _
- ByVal NewText As String)
- 'The following creates a selection set filter
- Dim fType(0 To 1) As Integer 'Stores DXF-style codes
- Dim fData(0 To 1) As Variant 'Stores filters
- fType(0) = 0: fData(0) = "INSERT" 'Filter for block insertions
- fType(1) = 2: fData(1) = BlockName 'Filter for specific block
-
- Dim openFilename As String 'Stores name of open drawing
- Dim myDwg As AcadDocument 'Stores each drawing in turn
- Dim mySS As AcadSelectionSet 'Stores selection set
- Dim myAtts As Variant 'Stores attributes for each insertion
- Dim i As Long, j As Long 'Declare two counters
-
- For i = 0 To UBound(Dwgs) 'Loop thru all drawings
- openFilename = GetOpenFilename(Dwgs(i)) 'Checks if file is open
- 'If the drawing is open, just refer to open drawing
- If openFilename "" Then
- Set myDwg = AcadApplication.Documents.Item(openFilename)
- Else 'Open the drawing
- Set myDwg = AcadApplication.Documents.Open(Dwgs(i))
- End If
-
- Set mySS = GetSS(myDwg) 'Get a selection set
-
- 'Populate the selection set with specified block insertions
- mySS.Select Mode:=acSelectionSetAll, _
- FilterType:=fType, _
- FilterData:=fData
-
- For j = 0 To mySS.Count - 1 'Loop thru all selected blocks
- ChangeAttrib mySS.Item(j), TagName, NewText 'Change attribute
- Next j
-
- mySS.Delete 'Always delete a selection set when done with it
- myDwg.Close Not myDwg.ReadOnly 'Close drawing, saving changes
- Next i
- End Sub
- 'Checks to see if the given fully-qualified filename is open
- 'Returns the filename without path if it is open
- Private Function GetOpenFilename(fqnName As Variant) As String
- Dim i As Long 'Declare a counter
- 'Loop thru all open drawings
- For i = 0 To AcadApplication.Documents.Count - 1
- 'Use the document given below for its properties
- With AcadApplication.Documents.Item(i)
- 'Compare two strings, if they match (equal 0) then return Name
- If StrComp(.FullName, fqnName, vbTextCompare) = 0 Then
- GetOpenFilename = .Name
- Exit For 'Since a match was found, exit the loop
- End If
- End With
- Next i
- End Function
- 'Returns a named selection set
- Private Function GetSS(ByRef theDoc As AcadDocument, _
- Optional ByVal Name As String = "mySS") _
- As AcadSelectionSet
- 'Enable error handling, but just skip the error
- On Error Resume Next
- 'Attempt to get the named selection set
|