Translate

segunda-feira, 5 de março de 2012

VBA: Criar circulo, seleccionar todas as entidades existentes e mover em Autocad, GstarCad, ZwCad e BricsCad

Na continuação do último post sobre VBA, fica um exemplo de uma rotina para  fazer um circulo, sendo de seguida seleccionado tudo o que existe no desenho e movendo.


Para Autocad :

 Sub Moveall_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 CirculoObj = ThisDrawing.ModelSpace.AddCircle(centro, raio)

    Dim selectset As AcadSelectionSet
    Set selectset = ThisDrawing.SelectionSets.Add("selectset2")
    selectset.Select acSelectionSetAll

    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) = 30: ponto2(1) = 20: ponto2(2) = 0

    For Each ent In selectset
        ent.Move ponto1, ponto2
    Next
   
    ZoomExtents

End Sub

Para GstarCad :

Sub Moveall_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 CirculoObj = thisDrawing.ModelSpace.AddCircle(centro, raio)

    Dim selectset As GcadSelectionSet
    Set selectset = thisDrawing.SelectionSets.Add("selectset2")
    selectset.Select acSelectionSetAll

    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) = 30: ponto2(1) = 20: ponto2(2) = 0

    For Each ent In selectset
        ent.Move ponto1, ponto2
    Next
   
    ZoomExtents

End Sub


Para ZwCad : 

  Sub Moveall_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 CirculoObj = ThisDocument.ModelSpace.AddCircle(centro, raio)

    Dim selectset As ZwcadSelectionSet
    Set selectset = ThisDocument.SelectionSets.Add("selectset")
    selectset.Select zcSelectionSetAll

    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) = 30: ponto2(1) = 20: ponto2(2) = 0

    For Each ent In selectset
        ent.Move ponto1, ponto2
    Next
  
    ZoomExtents

End Sub

Obrigado.

Boa programação

Sem comentários:

Enviar um comentário