Create text in Points Entities

Hello,

I need to create a selection set with all the Points of DWG File.

Next step is create a text with the Z value of each point.

Best regards,
António Miranda.

 

Hello, Again

I've this code:

´***************************

Private Sub CommandButton3_Click()
Me.Hide

Dim Pt As AcadPoint
Dim FilterType(0 To 0) As Integer
Dim FilterData(0 To 0) As Variant
Dim ssPoints As AcadSelectionSet
Dim DimText As String
Dim TextValue As String

FilterType(0) = 0: FilterData(0) = "Point"
Set ssPoints = CreateSelectionSet
ssPoints.Select acSelectionSetAll, , , FilterType, FilterData

DimText = 7.5
TextValue = "Write Here"

For Each Pt In ssPoints
ThisDrawing.ModelSpace.AddText TextValue, Pt.Coordinates, DimText
Pt.Highlight True
Next

ThisDrawing.Regen acAllViewports
ZoomAll
End Sub

Public Function CreateSelectionSet(Optional ssName As String = "ss") As AcadSelectionSet
Dim ss As AcadSelectionSet

On Error Resume Next
Set ss = ThisDrawing.SelectionSets(ssName)
If Err Then Set ss = ThisDrawing.SelectionSets.Add(ssName)
ss.Clear
Set CreateSelectionSet = ss
End Function


'************************************

I need to replace the string TextValue to the Z value of each point, can anyone help me, please.

Best regards.

 

ok, thak's

Here the code:

Me.Hide
Dim VarPnt As Variant
Dim Pt As AcadPoint
Dim FilterType(0 To 0) As Integer
Dim FilterData(0 To 0) As Variant
Dim ssPoints As AcadSelectionSet
Dim DimText As String
Dim TextValue As String

FilterType(0) = 0: FilterData(0) = "Point"
Set ssPoints = CreateSelectionSet
ssPoints.Select acSelectionSetAll, , , FilterType, FilterData

DimText = 7.5
TextValue = "Write Here"

For Each Pt In ssPoints
VarPnt = Pt.Coordinates
teste = VarPnt(2)
ThisDrawing.ModelSpace.AddText teste, Pt.Coordinates, DimText
Pt.Highlight True
Next

ThisDrawing.Regen acAllViewports
ZoomAll
End Sub

Public Function CreateSelectionSet(Optional ssName As String = "ss") As AcadSelectionSet
Dim ss As AcadSelectionSet

On Error Resume Next
Set ss = ThisDrawing.SelectionSets(ssName)
If Err Then Set ss = ThisDrawing.SelectionSets.Add(ssName)
ss.Clear
Set CreateSelectionSet = ss
End Function