Andresig Posted June 22, 2009 Share Posted June 22, 2009 Hi again, As a good rookie, I'm struggling with the VBA... I have a selection of objects, all snaped, no gaps in between, now I need to make a polyline through the overall perimeter... but how? Before I have used the SendCommand "-boundary" but only works for single areas, now I have to make a polyline including several areas together. Any clue will help me lots!! Thank you Quote Link to comment Share on other sites More sharing options...
Andresig Posted July 22, 2009 Author Share Posted July 22, 2009 this was my plan.... I select the objects(closed lwpolylines) and make regions then I combine the regions to make one single region, I explode the region to make lines, I collect the coordinates of the lines, then I make a polyline with the coordinates retrieved, but happens that the exploded lines are not in order!!! so right now i'm stuck with it... here is what I,ve done... Starting from regions... Any help to solve this will be awesome! Sub PerimeterLine() 'To create Regions with the objects Dim DifRegs() As AcadObject Dim ObjtoConv As AcadEntity Dim ActRegion As Variant Dim FstRegs As AcadSelectionSet Dim FstRegCount As Integer Dim FstRegT(1) As Integer Dim FstRegV(1) As Variant FstRegT(0) = 8: FstRegV(0) = "0" FstRegT(1) = 0: FstRegV(1) = "Region" ' to combine all regions On Error Resume Next ThisDrawing.SelectionSets("FstRegs_0").Delete On Error GoTo 0 Set FstRegs = ThisDrawing.SelectionSets.Add("FstRegs_0") FstRegs.Select acSelectionSetAll, , , FstRegT, FstRegV FstRegCount = FstRegs.Count ReDim DifRegs(FstRegCount - 1) Dim Thefirst As AcadRegion Dim Thesecond As AcadRegion For FstObjL = 0 To FstRegCount - 1 Set DifRegs(FstObjL) = FstRegs.Item(FstObjL) If FstObjL <> 0 Then Set Thefirst = DifRegs(0) Set Thesecond = DifRegs(FstObjL) Thefirst.Boolean acUnion, Thesecond End If Next FstObjL Thefirst.Update ThisDrawing.Regen acAllViewports 'explode region in to lines Dim ExplodedRegion As Variant Dim ExplRegCount As Integer ExplodedRegion = Thefirst.Explode ExplRegCount = UBound(ExplodedRegion) 'retrieve coords to make perimeter line Dim ExRegL As Integer Dim ExRegNumCoords As Integer ExRegNumCoords = ((ExplRegCount + 1) * 2) + 1 Dim ExRegCoords() As Double Dim RegLine As AcadLine ReDim ExRegCoords(ExRegNumCoords) For ExRegL = 0 To ExplRegCount Set RegLine = ExplodedRegion(ExRegL) ExRegCoords(ExRegL * 2) = RegLine.StartPoint(0) ExRegCoords(ExRegL * 2 + 1) = RegLine.StartPoint(1) If ExRegL = ExplRegCount Then ExRegCoords(ExRegL * 2 + 2) = RegLine.EndPoint(0) ExRegCoords(ExRegL * 2 + 3) = RegLine.EndPoint(1) End If Next ExRegL 'Make the perimeter line Dim PerLine As AcadLWPolyline Set PerLine = ThisDrawing.ModelSpace.AddLightWeightPolyline(ExRegCoords) PerLine.color = acYellow End Sub Quote Link to comment Share on other sites More sharing options...
JoshKing Posted August 8, 2013 Share Posted August 8, 2013 Hi Andresig, Excellent post. This was well stated and documented, and yet there are no replies. I have been looking for this exact same solution for some time, so I am also trying to solve it. Let me know if you have found a solution, or if anyone else wants to chime in here, I would also appreciate it. Thanks, Josh Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.