PDA

View Full Version : attributes, what hell is this?



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

inner69923
2005-02-22, 06:38 PM
solved, thanks anyway

Option Explicit

Public Sub ImportarAtributos()

Dim aListaTextos(0 To 1) As String

Dim blkBasePoint(0 To 2) As Double
Dim blkIP1(0 To 2) As Double
Dim blkIP2(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 PointObj As AcadPoint

Dim iBloquesExistentes As Integer
Dim varAttributes As Variant

blkIP1(0) = 10: blkIP1(1) = 10: blkIP1(2) = 10
blkIP2(0) = 20: blkIP2(1) = 20: blkIP2(2) = 20

blkBasePoint(0) = 0: blkBasePoint(1) = 0: blkBasePoint(2) = 0
aListaTextos(0) = "First on point 10,10,10"
aListaTextos(1) = "Second on point 20,20,20"

iBloquesExistentes = ThisDrawing.Blocks.Count

Set blockObj = ThisDrawing.Blocks.Add(blkBasePoint, "ISBlock" & iBloquesExistentes + 1)
Set PointObj = blockObj.AddPoint(blkBasePoint)
sSolicitud = "prompt"
sValor = " "
sIdentificador = "tag"
Set attributeObj = blockObj.AddAttribute _
(1, acAttributeModeVerify, sSolicitud, blkBasePoint, sIdentificador, sValor)

blkBasePoint(0) = blkIP1(0)
blkBasePoint(1) = blkIP1(1)
blkBasePoint(2) = blkIP1(2)
Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock _
(blkBasePoint, "ISBlock" & iBloquesExistentes + 1, 1#, 1#, 1#, 0)
varAttributes = blockRefObj.GetAttributes
varAttributes(0).TextString = aListaTextos(0)


blkBasePoint(0) = blkIP2(0)
blkBasePoint(1) = blkIP2(1)
blkBasePoint(2) = blkIP2(2)
Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock _
(blkBasePoint, "ISBlock" & iBloquesExistentes + 1, 1#, 1#, 1#, 0)
varAttributes = blockRefObj.GetAttributes
varAttributes(0).TextString = aListaTextos(1)
End Sub