Boundary with Overlap

Boundary with Overlap

Anonymous
Not applicable
442 Views
0 Replies
Message 1 of 1

Boundary with Overlap

Anonymous
Not applicable

Is it possible to make the "boundary" function below?

I know how to make it without the overlap. But is it possible with Excel VBA?

 

overlap.png

 

 

Sub Ccamada()

    Dim point1(1 To 3) As Double
    Dim point2(1 To 3) As Double
    Dim XYpoint(0 To 1) As Double
    Dim lineobj As Object
    Dim myapp As Object
    Dim AcadDwg As AcadDocument
    Set myapp = GetObject(, "Autocad.application")
    Set AcadDwg = myapp.ActiveDocument

    i = 2
    Ooffset = 0
    Ybound = Range("Ymedio").Cells(1, 1).Value
    Altura = Range("Aaltura").Cells(1, 1).Value
    'OOffset = Range("Xinicio").Cells(i, 1).Value + Range("Ooffset").Cells(i, 1).Value 'primeiro offset é zero
    While Range("Ooffset").Cells(i, 1).Value <> ""
       
        Ooffset = Ooffset + Range("Ooffset").Cells(i, 1).Value
        point1(1) = Ooffset: point1(2) = 0
        point2(1) = Ooffset: point2(2) = Altura
        Set lineobj = AcadDwg.ModelSpace.AddLine(point1, point2)
        'lineobj.Name = "LinhaInicial"
        lineobj.Update
        AutoCAD.Application.Update
        
        If i = 2 Then
            Xbound = Range("Ooffset").Cells(i, 1).Value / 2
            XYpoint(0) = Xbound: XYpoint(1) = Ybound 'valor medio se esta na linha 2 é media do offset/2
            Boundary (XYpoint)
        ElseIf i > 2 Then
            Xbound = Ooffset - Range("Ooffset").Cells(i, 1).Value / 2
            XYpoint(0) = Xbound: XYpoint(1) = Ybound 'valor medio se esta na linha >2 é media do offset/2
            Boundary (XYpoint)
            
        End If
        i = i + 1
    Wend

    MsgBox "Fim da Execução!"
        
        
        


    End Sub
 
 
Public Function Boundary(ByVal XYpoint As Variant) As AcadLWPolyline
    Dim AcadDwg As AcadDocument
    Set myapp = GetObject(, "Autocad.application")
    Set AcadDwg = myapp.ActiveDocument
    Dim XYstring As String
    With AcadDwg
    'PrevTotal = IIf(.ActiveSpace = acModelSpace, .ModelSpace.Count, .PaperSpace.Count)
    XYstring = CStr(XYpoint(0)) & "," & CStr(XYpoint(1))
    AcadDwg.SendCommand ("-boundary _a _b _e _i _n _+X _o _p _x" & vbCr & XYstring & vbCr & vbCr)
    End With
End Function
 



 

 

0 Likes
443 Views
0 Replies
Replies (0)