inner69923
2005-02-22, 04:27 PM
Public Sub ImportarAtributos()
Dim aListaPuntos() As Double
Dim aListaTextos() As String
Dim insertionPoint(0 To 2) As Double
Dim sIdentificador As String
Dim sSolicitud As String
Dim sValor As String
Dim attributeObj As AcadAttribute
Dim blockObj As AcadBlock
Dim blockRefObj As AcadBlockReference
Dim iBloquesExistentes As Integer
Dim varAttributes As Variant
ReDim aListaPuntos(5)
aListaPuntos(0) = 10: aListaPuntos(1) = 10: aListaPuntos(2) = 10
aListaPuntos(3) = 20: aListaPuntos(4) = 20: aListaPuntos(5) = 20
ReDim aListaTextos(1)
aListaTextos(0) = "First on point 10,10,10"
aListaTextos(1) = "Second on point 20,20,20"
iBloquesExistentes = ThisDrawing.Blocks.Count
insertionPoint(0) = 0
insertionPoint(1) = 0
insertionPoint(2) = 0
Set blockObj = ThisDrawing.Blocks.Add(insertionPoint, "ISBlock" & iBloquesExistentes + 1)
Set PointObj = blockObj.AddPoint(insertionPoint)
sSolicitud = "prompt"
sValor = aListaTextos(0)
sIdentificador = "tag"
Set attributeObj = blockObj.AddAttribute(1, acAttributeModeVerify, sSolicitud, insertionPoint, sIdentificador, sValor)
insertionPoint(0) = aListaPuntos(0)
insertionPoint(1) = aListaPuntos(1)
insertionPoint(2) = aListaPuntos(2)
Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPoint, "ISBlock" & iBloquesExistentes + 1, 1#, 1#, 1#, 0)
varAttributes = blockRefObj.GetAttributes
varAttributes(0).TextString = aListaTextos(1)
'tomamos el punto de insercion del bloque
insertionPoint(0) = aListaPuntos(3)
insertionPoint(1) = aListaPuntos(4)
insertionPoint(2) = aListaPuntos(5)
Set PointObj = ThisDrawing.ModelSpace.AddPoint(insertionPoint)
Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPoint, "ISBlock" & iBloquesExistentes + 1, 1#, 1#, 1#, 0)
End Sub
the first is on the second point and the second is on the first point
how can i fix this?
thanks
Dim aListaPuntos() As Double
Dim aListaTextos() As String
Dim insertionPoint(0 To 2) As Double
Dim sIdentificador As String
Dim sSolicitud As String
Dim sValor As String
Dim attributeObj As AcadAttribute
Dim blockObj As AcadBlock
Dim blockRefObj As AcadBlockReference
Dim iBloquesExistentes As Integer
Dim varAttributes As Variant
ReDim aListaPuntos(5)
aListaPuntos(0) = 10: aListaPuntos(1) = 10: aListaPuntos(2) = 10
aListaPuntos(3) = 20: aListaPuntos(4) = 20: aListaPuntos(5) = 20
ReDim aListaTextos(1)
aListaTextos(0) = "First on point 10,10,10"
aListaTextos(1) = "Second on point 20,20,20"
iBloquesExistentes = ThisDrawing.Blocks.Count
insertionPoint(0) = 0
insertionPoint(1) = 0
insertionPoint(2) = 0
Set blockObj = ThisDrawing.Blocks.Add(insertionPoint, "ISBlock" & iBloquesExistentes + 1)
Set PointObj = blockObj.AddPoint(insertionPoint)
sSolicitud = "prompt"
sValor = aListaTextos(0)
sIdentificador = "tag"
Set attributeObj = blockObj.AddAttribute(1, acAttributeModeVerify, sSolicitud, insertionPoint, sIdentificador, sValor)
insertionPoint(0) = aListaPuntos(0)
insertionPoint(1) = aListaPuntos(1)
insertionPoint(2) = aListaPuntos(2)
Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPoint, "ISBlock" & iBloquesExistentes + 1, 1#, 1#, 1#, 0)
varAttributes = blockRefObj.GetAttributes
varAttributes(0).TextString = aListaTextos(1)
'tomamos el punto de insercion del bloque
insertionPoint(0) = aListaPuntos(3)
insertionPoint(1) = aListaPuntos(4)
insertionPoint(2) = aListaPuntos(5)
Set PointObj = ThisDrawing.ModelSpace.AddPoint(insertionPoint)
Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPoint, "ISBlock" & iBloquesExistentes + 1, 1#, 1#, 1#, 0)
End Sub
the first is on the second point and the second is on the first point
how can i fix this?
thanks