CAD software discussion forum > CAD > Use VBA program to get xref path

Use VBA program to get xref path

Rank: 1

Lars

Newbie

posts: 0

Registered: 2010-12-14

Message 1 of 4

 Use VBA program to get xref path
08-05-2010 05:34 . am | View his/her posts only
Hi,

i'm trying via the VBA api to get xref path, a XRef from an opened drawing. But i don't get it managed - does anybody know a solution ? Confused

Sub ListAllXrefPaths()
Dim bdef As ZwcadBlock
Dim bref As ZwcadBlockReference
Dim xref As ZwcadExternalReference
Dim blk As ZwcadBlock
Dim ent As ZwcadEntity
Dim list As New Collection
Dim item As Variant
Dim msg As String

'' handle errors inline
On Error Resume Next

'' iterate block collection
For Each blk In ThisDocument.Blocks

'' iterate entities in block
For Each ent In blk

'' if entity is a blockref
If TypeOf ent Is ZwcadBlockReference Then

'' cast to a blockref interface
Set bref = ent

'' get the related definition
Set bdef = ThisDocument.Blocks(bref.Name)

'' if its an xref
If bdef.IsXRef Then

'' append to collection (duplicates will be skipped)
list.Add bref, bref.Name
End If
End If
Next
Next

'' iterate the collection
For Each item In list

'' cast to an xref
Set xref = item

'' append string
msg = msg & xref.Name & " = " & xref.Path & vbCr
Next

'' show it
MsgBox msg, , "ListAllXrefPaths"
End Sub


holfort2010-05-08 06:31:08

Rank: 5Rank: 5

Eric_ZWSOFT

posts: 13

Registered: 2011-7-18

Message 2 of 4

10-05-2010 10:22 . am | View his/her posts only


hi,holfort,


i will feel happy to talk about VBA with you ~~ ,but in fact, i know nothing about VBAEmbarrassed now ,hope there are someone can share with you about VBA here .

good mood~~
Eric

Rank: 1

Lars

Newbie

posts: 0

Registered: 2010-12-14

Message 3 of 4

11-05-2010 06:24 . pm | View his/her posts only
Here's the solution:

Sub ListAllXrefPaths()
Dim bdef As ZwcadBlock
Dim bref As ZwcadBlockReference
Dim xref As ZwcadExternalReference
Dim blk As ZwcadBlock
Dim ent As ZwcadEntity
Dim list As New Collection
Dim item As Variant
Dim msg As String

'' handle errors inline
On Error Resume Next

'' iterate block collection
For Each blk In ThisDocument.Blocks

'' iterate entities in block
For Each ent In blk

'' if entity is a blockref
'If TypeOf ent Is ZwcadBlockReference Then
If TypeOf ent Is ZwcadExternalReference Then

'' cast to a blockref interface
Set xref = ent

'' get the related definition
Set bdef = ThisDocument.Blocks(xref.Name)

'' if its an xref
If bdef.IsXRef Then

'' append to collection (duplicates will be skipped)
list.Add xref, xref.Name
End If
End If
Next
Next

'' iterate the collection
For Each item In list

'' cast to an xref
Set xref = item

'' append string
msg = msg & xref.Name & " = " & xref.Path & vbCr
Next

'' show it
MsgBox msg, , "ListAllXrefPaths"
End Sub


Rank: 5Rank: 5

Eric_ZWSOFT

posts: 13

Registered: 2011-7-18

Message 4 of 4

12-05-2010 08:45 . am | View his/her posts only


good work,holfort


the code seems have attracted me ,i want to learn VBA and hope i can discuss about VBAwith you then~
See also