software discussion forum > CAD > Get Attributes
Get Attributes
06-04-2011 07:38 . am | View his/her posts only
Hi all.
I use this code for to extract attributes from blocks with ZW2010 but it doesn't work with 2011 , I get 426 error.
Please help me.
Thanks.
Best regards.
Sergio
//code
Public Sub NowGo()
Dim blockobj As ZwcadBlockReference
Dim ArrayAtribs As ZwcadAttributeReferences
Dim disegno As ZwcadDocument
nometemplate = "C:'Pubblica'Sergio'abc.dwt" 'TEMPLATE WITH ONE BLOCK WITH MANY ATTRIBUTES
Set disegno = ZwCAD.Documents.Add(nometemplate)
For Each blockobj In disegno.ModelSpace
If blockobj.HasAttributes = True Then
Set ArrayAtribs = blockobj.GetAttributes 'GET "ERROR 424 OBJECT REQUIRED" BUT THIS CODE WORKS WELL WITH ZW 2010
End If
Next
End Sub
//end code
I use this code for to extract attributes from blocks with ZW2010 but it doesn't work with 2011 , I get 426 error.
Please help me.
Thanks.
Best regards.
Sergio
//code
Public Sub NowGo()
Dim blockobj As ZwcadBlockReference
Dim ArrayAtribs As ZwcadAttributeReferences
Dim disegno As ZwcadDocument
nometemplate = "C:'Pubblica'Sergio'abc.dwt" 'TEMPLATE WITH ONE BLOCK WITH MANY ATTRIBUTES
Set disegno = ZwCAD.Documents.Add(nometemplate)
For Each blockobj In disegno.ModelSpace
If blockobj.HasAttributes = True Then
Set ArrayAtribs = blockobj.GetAttributes 'GET "ERROR 424 OBJECT REQUIRED" BUT THIS CODE WORKS WELL WITH ZW 2010
End If
Next
End Sub
//end code
06-04-2011 08:50 . pm | View his/her posts only
The problem happened because we have made a change on the return type of GetAttribute method, you can refer to Help menu -> Developer Help -> VBA Reference -> Code Examples -> GetAttribute Example section to see the difference.
And we suggest you modify your code to :
Public Sub NowGo()
Dim blockobj As ZwcadBlockReference
Dim ArrayAtribs As Variant
Dim disegno As ZwcadDocument
nometemplate = "C:'Pubblica'Sergio'abc.dwt"
Set disegno = ZwCAD.Documents.Add(nometemplate)
For Each blockobj In disegno.ModelSpace
If blockobj.HasAttributes = True Then
ArrayAtribs = blockobj.GetAttributes
End If
Next
End Sub
And we suggest you modify your code to :
Public Sub NowGo()
Dim blockobj As ZwcadBlockReference
Dim ArrayAtribs As Variant
Dim disegno As ZwcadDocument
nometemplate = "C:'Pubblica'Sergio'abc.dwt"
Set disegno = ZwCAD.Documents.Add(nometemplate)
For Each blockobj In disegno.ModelSpace
If blockobj.HasAttributes = True Then
ArrayAtribs = blockobj.GetAttributes
End If
Next
End Sub
07-04-2011 02:14 . am | View his/her posts only
Perfect Daniel ,I'm sorry but I missed the help reference,you've done a really good job.
I changed the way to go trough the attributes from
//code
For s = 0 To attributes.count-1
.......
next s
//end code
in
//code
For s = 0 To Ubound(attributes)
.....
next s
//end code
Thanks again.
sergio
I changed the way to go trough the attributes from
//code
For s = 0 To attributes.count-1
.......
next s
//end code
in
//code
For s = 0 To Ubound(attributes)
.....
next s
//end code
Thanks again.
sergio
06-04-2011 08:50 . pm | View his/her posts only
You're welcome, nice to hear that your problem solved.
29-04-2011 04:12 . am | View his/her posts only
Daniel please I need your help again. ffice
ffice" />
Could you explain me which is the way that ZW use for to go through the several blocks inside the drawing?
I try to explain better what I need: I use one routine that collect the attributes from various blocks inside my drawing and put some values in the BOM .Now I need to take the blocks in the same order that they are drawn in the dwg, from left to right.
Is it possible to set some vales in the block that learn to ZW to process the block in some order?
Is necessary to add one more attribute "PROCESS_ORDER" at the blocks and set the value as I need?
Thanks a lot.
Sergio
06-04-2011 08:50 . pm | View his/her posts only
Hi sergior,
ZWCAD go through blocks by Handle ID, which can be checked by LIST command. There is no other way to go through them.
But the method you mentioned by add an extra attribute like "PROCESS_ORDER" , and use this flag variable to go through blocks as you need, therotically I think it works. You can try to write some codes to realize it.
ZWCAD go through blocks by Handle ID, which can be checked by LIST command. There is no other way to go through them.
But the method you mentioned by add an extra attribute like "PROCESS_ORDER" , and use this flag variable to go through blocks as you need, therotically I think it works. You can try to write some codes to realize it.
04-05-2011 06:57 . am | View his/her posts only
One night without sleep but I found the trick.
I've already done one database and then I've added one field for "insertpoint(0)" proprety that hold the "X" coordinate of the block.
When I launch the macro it reads all the block inside the drawing for to build the BOM (and now it records also the block's position).
So I can select the blocks in the right order building one query with "... order by insertpoint(0) " and retrieve the blocks with " move first ,while not eof ,move next .. wend" routine.
It works.
06-04-2011 08:50 . pm | View his/her posts only
please help me with entry into vba for ZWCAD. all I want to do is select lines, record there start point x y z, and end point x y z and write it to a text file. I am doing something wrong and dont know where to get info.
06-04-2011 08:50 . pm | View his/her posts only
Here is a code That I have started but doesnt work
Public Sub polylinethingy()
Dim obj As ZwcadPolyline
Dim pt As Variant
Dim fso As New Collection
Dim TS As ZcTextGenerationFlag
Set TS = fso.CreateTextFile("c:'temp'test2.txt", True)
Dim nItems As Integer
nItems = ThisDocument.ActiveSelectionSet.Count
For n = 0 To nItems - 1 Step 1
Dim iSelected As Integer
iSelected = ThisDrawing.ActiveSelectionSet.Count
Set obj = ThisDocument.ActiveSelectionSet.Item(n)
'ThisDrawing.Utility.GetEntity obj, pt, "polyline"
If TypeOf obj Is ZwcadLWPolyline Then
Dim pts As Variant
Dim Poly As ZwcadLWPolyline
Set Poly = obj
pts = Poly.Coordinates
Dim icount As Integer
icount = UBound(pts)
Dim i As Integer
For i = 0 To icount - 1 Step 2
TS.WriteLine pts(i) & "," & pts(i + 1) & "," & Poly.Elevation
Next i
ElseIf TypeOf zwcadObject Is zcPolyline Then
Dim Poly As ZwcadPolyline
Set Poly = zwcadObject
pts = Poly.Coordinates
icount = UBound(pts)
For i = 0 To icount - 1 Step 3
If i = 0 Then
TS.WriteLine "S" & pts(i) & " " & pts(i + 1) & " " & pts(i + 2) & " " & "3DPolyline" & Format(n + 1)
Else
TS.WriteLine " " & pts(i) & " " & pts(i + 1) & " " & pts(i + 2)
End If
Next i
End If
Next n
End Sub
I dont know what I am doing wrong
Public Sub polylinethingy()
Dim obj As ZwcadPolyline
Dim pt As Variant
Dim fso As New Collection
Dim TS As ZcTextGenerationFlag
Set TS = fso.CreateTextFile("c:'temp'test2.txt", True)
Dim nItems As Integer
nItems = ThisDocument.ActiveSelectionSet.Count
For n = 0 To nItems - 1 Step 1
Dim iSelected As Integer
iSelected = ThisDrawing.ActiveSelectionSet.Count
Set obj = ThisDocument.ActiveSelectionSet.Item(n)
'ThisDrawing.Utility.GetEntity obj, pt, "polyline"
If TypeOf obj Is ZwcadLWPolyline Then
Dim pts As Variant
Dim Poly As ZwcadLWPolyline
Set Poly = obj
pts = Poly.Coordinates
Dim icount As Integer
icount = UBound(pts)
Dim i As Integer
For i = 0 To icount - 1 Step 2
TS.WriteLine pts(i) & "," & pts(i + 1) & "," & Poly.Elevation
Next i
ElseIf TypeOf zwcadObject Is zcPolyline Then
Dim Poly As ZwcadPolyline
Set Poly = zwcadObject
pts = Poly.Coordinates
icount = UBound(pts)
For i = 0 To icount - 1 Step 3
If i = 0 Then
TS.WriteLine "S" & pts(i) & " " & pts(i + 1) & " " & pts(i + 2) & " " & "3DPolyline" & Format(n + 1)
Else
TS.WriteLine " " & pts(i) & " " & pts(i + 1) & " " & pts(i + 2)
End If
Next i
End If
Next n
End Sub
I dont know what I am doing wrong
23-08-2011 03:12 . am | View his/her posts only
Hi rjbuljubasic
here is my solution for a similar problem :this routine check the drawings for 3d polylines (you can convert to other poly however) and write one text file for each poly with start and end point.
**
*** GENERAL DECLARATIONS *****
Public filenote
Const DEFAULT_PATH="" '********** write your path here
*** END GENERAL DECLARATIONS *****
Public Sub WRITE_POINTS()
Dim mia_poly As Zwcad3DPolyline
For Each entobj In ThisDocument.ModelSpace
If entobj.EntityType = 2 Then '3DPOLY
Set mia_poly = entobj
Call sub_txt_punti(mia_poly)
End If
Next
Set mia_poly = Nothing
End Sub
Private Sub sub_txt_punti(pol As Zwcad3DPolyline)
Dim a As Byte, lay As String, filenotename As String
Dim plineObj As ZwcadPolyline
Static inc As Integer
lay = pol.Layer
inc = inc + 1
filenotename = DEFAULT_PATH & "'" & lay & "_" & inc & ".txt"
Call crea_report(filenotename)
For a = 0 To UBound(pol.Coordinates) Step 3
note = Round(pol.Coordinates(a)) & "; " & Round(pol.Coordinates(a + 1)) & "; " & Round(pol.Coordinates(a + 2))
filenote.writeline (note)
Next a
note = ""
filenote.writeline (note)
note = "#" & pol.Layer
filenote.writeline (note)
filenote.Close
Set filenote = Nothing
Dim mostra
mostra = Shell("C:'Windows'system32'notepad.exe " & filenotename, vbNormalFocus)
Set mostra = Nothing
End Sub
Private Sub crea_report(nome_file As String)
Set fs = CreateObject("Scripting.FileSystemObject")
Set filenote = fs.CreateTextFile(nome_file, True)
End Sub
here is my solution for a similar problem :this routine check the drawings for 3d polylines (you can convert to other poly however) and write one text file for each poly with start and end point.
**
*** GENERAL DECLARATIONS *****
Public filenote
Const DEFAULT_PATH="" '********** write your path here
*** END GENERAL DECLARATIONS *****
Public Sub WRITE_POINTS()
Dim mia_poly As Zwcad3DPolyline
For Each entobj In ThisDocument.ModelSpace
If entobj.EntityType = 2 Then '3DPOLY
Set mia_poly = entobj
Call sub_txt_punti(mia_poly)
End If
Next
Set mia_poly = Nothing
End Sub
Private Sub sub_txt_punti(pol As Zwcad3DPolyline)
Dim a As Byte, lay As String, filenotename As String
Dim plineObj As ZwcadPolyline
Static inc As Integer
lay = pol.Layer
inc = inc + 1
filenotename = DEFAULT_PATH & "'" & lay & "_" & inc & ".txt"
Call crea_report(filenotename)
For a = 0 To UBound(pol.Coordinates) Step 3
note = Round(pol.Coordinates(a)) & "; " & Round(pol.Coordinates(a + 1)) & "; " & Round(pol.Coordinates(a + 2))
filenote.writeline (note)
Next a
note = ""
filenote.writeline (note)
note = "#" & pol.Layer
filenote.writeline (note)
filenote.Close
Set filenote = Nothing
Dim mostra
mostra = Shell("C:'Windows'system32'notepad.exe " & filenotename, vbNormalFocus)
Set mostra = Nothing
End Sub
Private Sub crea_report(nome_file As String)
Set fs = CreateObject("Scripting.FileSystemObject")
Set filenote = fs.CreateTextFile(nome_file, True)
End Sub
06-04-2011 08:50 . pm | View his/her posts only
dear sergioc , thank you for your sharing.



