Translate

quarta-feira, 22 de fevereiro de 2012

VBA: Criar Circulo e mover em Autocad, GstarCad, ZwCad e BricsCad

Fica aqui uma rotina para  fazer um circulo e depois o move, infelizmente continuo sem experimentar no ZwCad e no BricsCad.

Para Autocad :

Sub Move_Circulo()

    Dim CirculoObj As AcadCircle
    Dim centro(0 To 2) As Double
    Dim raio As Double
    centro(0) = 3#: centro(1) = 1#: centro(2) = 0#
    raio = 2.5
    Set Circulo = ThisDrawing.ModelSpace.AddCircle(centro, raio)
   
    Dim ponto1(0 To 2) As Double
    Dim ponto2(0 To 2) As Double
    ponto1(0) = 0: ponto1(1) = 0: ponto1(2) = 0
    ponto2(0) = 10: ponto2(1) = 20: ponto2(2) = 0
  
    Circulo.Move ponto1, ponto2
    ZoomExtents
  
End Sub

Para GstarCad :


Sub Move_Circulo()

    Dim CirculoObj As GcadCircle
    Dim centro(0 To 2) As Double
    Dim raio As Double
    centro(0) = 3#: centro(1) = 1#: centro(2) = 0#
    raio = 2.5
    Set Circulo = thisDrawing.ModelSpace.AddCircle(centro, raio)
   
    Dim ponto1(0 To 2) As Double
    Dim ponto2(0 To 2) As Double
    ponto1(0) = 0: ponto1(1) = 0: ponto1(2) = 0
    ponto2(0) = 10: ponto2(1) = 20: ponto2(2) = 0
  
    Circulo.Move ponto1, ponto2
    ZoomExtents
  
End Sub

Para ZwCad : 
(Infelizmente não tenho possibilidade de experimentar neste Cad fica a possível solução)

Sub Move_Circulo()

    Dim CirculoObj As ZwcadCircle
    Dim centro(0 To 2) As Double
    Dim raio As Double
    centro(0) = 3#: centro(1) = 1#: centro(2) = 0#
    raio = 2.5
    Set Circulo = ThisDocument.ModelSpace.AddCircle(centro, raio)
   
    Dim ponto1(0 To 2) As Double
    Dim ponto2(0 To 2) As Double
    ponto1(0) = 0: ponto1(1) = 0: ponto1(2) = 0
    ponto2(0) = 10: ponto2(1) = 20: ponto2(2) = 0
  
    Circulo.Move ponto1, ponto2
    ZoomExtents
  
End Sub

Para Bricscad :
(Infelizmente não tenho possibilidade de experimentar neste Cad fica a possível solução)


Sub Move_Circulo()

    Dim CirculoObj As AcadCircle
    Dim centro(0 To 2) As Double
    Dim raio As Double
    centro(0) = 3#: centro(1) = 1#: centro(2) = 0#
    raio = 2.5
    Set Circulo = ThisDrawing.ModelSpace.AddCircle(centro, raio)
   
    Dim ponto1(0 To 2) As Double
    Dim ponto2(0 To 2) As Double
    ponto1(0) = 0: ponto1(1) = 0: ponto1(2) = 0
    ponto2(0) = 10: ponto2(1) = 20: ponto2(2) = 0
  
    Circulo.Move ponto1, ponto2
    ZoomExtents
  
End Sub

Obrigado.

Boa programação

Sem comentários:

Enviar um comentário