Message 1 of 1
Boundary with Overlap

Not applicable
11-10-2021
11:54 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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?
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