Translate

domingo, 28 de outubro de 2012

VBA: Rotina para desenhar Circunferência e Hatch (Routine to draw a circle and batch)

A rotina que se segue mostra como podemos desenhar uma circunferência e colocar um hatch no seu interior, mas dizendo que a boundarie é a própria circunferência.

Para Autocad :

Sub circhatch()

'variáveis
Dim centro As Variant
Dim raio As Double
Dim trama As AcadHatch
Dim limite As AcadCircle
Dim OuterLoop(0) As AcadEntity

'input para desenhar a circunferência
centro = ThisDrawing.Utility.GetPoint(, "Centro da primeira circunferência?")
raio = ThisDrawing.Utility.GetReal("Qual o raio?")

'desenha a circuferência atribuindo logo a fronteira do hatch
Set limite = ThisDrawing.ModelSpace.AddCircle(centro, raio)

'define e desenha o hatch
Set OuterLoop(0) = limite
Set trama = ThisDrawing.ModelSpace.AddHatch(acHatchPatternTypePreDefined, "SOLID", True)
trama.AppendOuterLoop (OuterLoop)
trama.Evaluate
trama.Update

ZoomExtents

End Sub

Para GstarCad :


Sub circhatch()

'variáveis
Dim centro As Variant
Dim raio As Double
Dim trama As GcadHatch
Dim limite As GcadCircle
Dim OuterLoop(0) As GcadEntidy

'input para desenhar a circunferência
centro = ThisDrawing.Utility.GetPoint(, "Centro da primeira circunferência?")
raio = ThisDrawing.Utility.GetReal("Qual o raio?")

'desenha a circuferência atribuindo logo a fronteira do hatch
Set limite = ThisDrawing.ModelSpace.AddCircle(centro, raio)

'define e desenha o hatch
Set OuterLoop(0) = limite
Set trama = ThisDrawing.ModelSpace.AddHatch(HatchPatternTypePreDefined, "SOLID", True)
trama.AppendOuterLoop (OuterLoop)
trama.Evaluate
trama.Update

ZoomExtents

End Sub

Para ZwCad : 

O Zwcad + alterou algumas coisas do seu código. A que mais se destaca é que deixou de ser ThisDocument e passou a ser ThisDrawing, uma grande ajuda para quem programa para vários Cad's. Outra das alterações é que deixámos de ter o ZWcad...... e passou a ser Zcad......
Fazendo estas chamadas de atenção fica aqui a primeira rotina feita para o ZWcad+ que se tornou muito melhor

Sub circhatch()

'variáveis
Dim centro As Variant
Dim raio As Double
Dim trama As ZcadHatch
Dim limite As ZcadCircle
Dim OuterLoop(0) As ZcadEntity

'input para desenhar a circunferência
centro = ThisDrawing.Utility.GetPoint(, "Centro da primeira circunferência?")
raio = ThisDrawing.Utility.GetReal("Qual o raio?")

'desenha a circuferência atribuindo logo a fronteira do hatcf
Set limite = ThisDrawing.ModelSpace.AddCircle(centro, raio)

'define e desenha o hatch
Set OuterLoop(0) = limite
Set trama = ThisDrawing.ModelSpace.AddHatch(zcHatchPatternTypePreDefined, "SOLID", True)
trama.AppendOuterLoop (OuterLoop)
trama.Evaluate
trama.Update

ZoomExtents

End Sub

Obrigado


Boa programação

Sem comentários:

Enviar um comentário