VBA - Continuando...

[sobral_1]

Caríssimos Amigos:
O método GetPoint dá as coordenadas do desenho de cada ponto que seja "Pikado" com o rato. Assim posso armazenar num array as coordenadas dos pontos pretendidos.
Se "Pikar" os 4 pontos (mais à esquerda, mais à direita, mais acima e mais abaixo) obtenho
o quadrângulo envolvente do desenho.
As propriedades WindowLeft ... etc dão também uns valores para as coordenadas que não sei muito bem o que representam... Ex: 0 12
Claro que posso utilizar o método GetPoint mas não haverá uma maneira mais elegante de fazer isto?
Um Abraço a todos!
a.sobral

[Rui Pestana]

Caro Sobral,

que coordenadas é que pretende obter exactamente? São as coordenadas que contém os elementos de um desenho em ModelSpace? São as coordenadas de uma esquadria de desenho?

[sobral_1]

Oi Rui!!!
São as coordenadas dos elementos do desenho em ModelSpace (x,y,z), aquelas que aparecem na linha de comando quando se movimenta o rato pelo desenho.
Cumprimentos!
antonio sobral

[Rui Pestana]

Caro Sobral,

parece-me que o que pretende é saber qual é o menor rectângulo que contém todos os elementos do desenho.
Para isso pode usar o método "GetBoundingBox" em cada objecto do ModelSpace. Este método devolve os 2 pontos da diagonal do menor rectângulo que contém o objecto: o ponto mínimo (canto inferior esquerdo do rectângulo) e o ponto máximo (canto superior direito do rectângulo).

Se tiver uma esquadria a envolver os elementos do desenho, basta aplicar esse método a essa entidade, senão vai ter de percorrer todas as entidades, aplicar esse método e determinar obter as cotas mínimas e máximas de todas as iterações.

Dê-me algum tempo que enviar-lhe-ei um exemplo para ser mais claro.

[Rui Pestana]

Aqui tem um exemplo de como obter os pontos máximo e mínimo do menor rectângulo que contém todas as entidades do ModelSpace:

' start code
Option Explicit
Dim Pmax(0 To 2) As Double
Dim Pmin(0 To 2) As Double
Sub teste()

Call GetMaxMinPoints(ThisDrawing.ModelSpace)
ThisDrawing.ModelSpace.AddPoint Pmin
ThisDrawing.ModelSpace.AddPoint Pmax
End Sub

' Como o ModelSpace e o PaperSpace são Blocos especiais o argumento da rotina pode ser do tipo AcadBlock
Sub GetMaxMinPoints(Space As AcadBlock)


Dim Entidade As AcadEntity

Dim i As Integer
Dim n As Integer
'indice máximo dos items do Space
n = Space.Count - 1
'percorrer todos os items do Space
For i = 0 To n
Dim PminTemp As Variant
Dim PmaxTemp As Variant
'definir Entidade como o item i do Space
Set Entidade = Space.Item(i)
'obter o rectângulo mínimo que contém a Entidade
Entidade.GetBoundingBox PminTemp, PmaxTemp
'verificar os valores obtidos e colocá-los nas coordenadas finais
'para inicializar os valores das coordenadas colocamos o 1º resultado nas coordenadas
If i = 0 Then
Pmin(0) = PminTemp(0)
Pmin(1) = PminTemp(1)
Pmin(2) = PminTemp(2)
Pmax(0) = PmaxTemp(0)
Pmax(1) = PmaxTemp(1)
Pmax(2) = PmaxTemp(2)
Else
'Comparamos os valores obtidos e X, Y e Z.
'Se estes forem menores para que os valores de Pmin colocamo-los em Pmin
If PminTemp(0) < Pmin(0) Then
Pmin(0) = PminTemp(0)
End If
If PminTemp(1) < Pmin(1) Then
Pmin(1) = PminTemp(1)
End If
If PminTemp(2) < Pmin(2) Then
Pmin(2) = PminTemp(2)
End If
'Se estes forem maiore para que os valores de Pmax colocamo-los em Pmax
If PmaxTemp(0) > Pmax(0) Then
Pmax(0) = PmaxTemp(0)
End If
If PmaxTemp(1) > Pmax(1) Then
Pmax(1) = PmaxTemp(1)
End If
If PmaxTemp(2) < Pmax(2) Then
Pmax(2) = PmaxTemp(2)
End If
End If


Next i

End Sub
' end of code

Espero que entenda. Qualquer dúvida, pergunte.

[sobral_1]

Rui, esteve a incomodar-secomigo e a gastar o seu tempo........
Realmente atinou naquilo que eu pretendia.
Vou experimentar o seu código e lhe agradeço muito.
Muitos Cumprimentos.
a.sobral

[sobral_1]

Olá Rui!!
Entendi perfeitamente o seu raciocínio e já fiz o teste. Acrescentei somente uma MsgBox para visualizar os valores das coordenadas. Certíssimo, era precisamente o que pretendia. Mais uma vez Obrigado.
Entretanto tenho novidades:
Um colega de outro forum apresentou uma solução simplesmente DIVINAL. Faz o mesmo apenas com 4 linhas de código. Aqui vai:

MinD = ThisDrawing . GetVariable (“extmin”)
MaxD = ThisDrawing . GetVariable (“extmax”)
Xmin = MinD(0):Xmax = MaxD(0)
Ymin = MinD(1):Ymax = MaxD(1)

Não é sensacional? Fiquei maravilhado e dei pulos na cadeira!!
Vivam os Foruns!!! Viva o VBA!!! Viva o Brogueira!!! Vivam Todos!!! Viva Você e eu também (já agora)!!!!
Estou agradecido por tudo. Muito Obrigado!!
antonio sobral