Below is the code I've written so far. If you run through for one loop of the FOR loop, it works fine (check the numeral '5' on the attached example.dwg before and after you run the code), but when you run through a second time I get a catastrophic failure at line "SET ADDITEM(0) = SSET (X1)" and I'm not sure why. If you re-run through the first loop again, you'll error immediately after "THISDRAWING.SENDCOMMAND" because the selected spline is a closed loop.
Sub JoinSplines()Dim SSet As AcadSelectionSetDim oSSetGroup As AcadGroupDim sGRName As StringDim FilterType(0) As IntegerDim FilterData(0) As VariantDim X1 As IntegerDim AddItem() As AcadEntityOn Error Resume NextIf ThisDrawing.SelectionSets.Item("SSet") Is Nothing Then Set SSet = ThisDrawing.SelectionSets.Add("SSet")Else ThisDrawing.SelectionSets.Item("SSet").Clear Set SSet = ThisDrawing.SelectionSets("SSet")End IfOn Error GoTo 0Err.ClearFilterType(0) = 0FilterData(0) = "Spline"SSet.Select acSelectionSetAll, , , FilterType, FilterDataReDim AddItem(0) As AcadEntityFor X1 = 1 To SSet.Count Set oSSetGroup = ThisDrawing.Groups.Add("SG") sGRName = oSSetGroup.Name ''CATASTROPHIC FAILURE HERE Set AddItem(0) = SSet(X1) oSSetGroup.AppendItems AddItem '''NEED TO END ANY, AND ALL EXISTING COMMANDS BEFORE PROCEEDING On Error Resume Next ThisDrawing.SendCommand "splinedit" + vbCr + "G" + vbCr + sGRName + vbCr + "J" + vbCr + _ "all" + vbCr + vbCr + vbCr If Not Err Is Nothing Then ThisDrawing.SendCommand "!(command)" & vbCr '''NEED TO END CURRENT COMMAND HERE. Err.Clear End If On Error GoTo 0 oSSetGroup.Delete ReDim AddItem(X1) As AcadEntity NextEnd Sub
The code sample you posted, RenderMan, works well if the loop contains only splines, but the code I've posted above works for loops containing loops, lines and arcs like the attached file (example.dwg). The code will process text loops like this almost exclusively. Once it's done joining splines, it will join any remaining polylines.
Thanks again.
Example.dwg AutoCAD 2012 can use the standard JOIN command (i.e., not through SPLINEDIT) to join both splines and non splines into one large composite (See returned sample).So, depending on what the end result needs to be, perhaps this variation on your posted code would do.
I can’t test it myself because my install of AutoCAD 2012 is 64 bit, with which VBA does not play nice.
Sub JoinSplines() ' This example adds objects to a selection set by prompting the user ' to select ones to add. ' Create the selection set Dim ssetObj As AcadSelectionSet On Error Resume Next ThisDrawing.SelectionSets.Item("TEST_SSET").Delete On Error GoTo 0 Set ssetObj = ThisDrawing.SelectionSets.Add("TEST_SSET") Dim mode As Integer Dim pointsArray(0 To 11) As Double mode = acSelectionSetCrossingPolygon'I just hardcoded a rectangle size to fit.May want to use extmin and extmax pointsArray(0) = 0#: pointsArray(1) = 0#: pointsArray(2) = 0# pointsArray(3) = 950#: pointsArray(4) = 0#: pointsArray(5) = 0# pointsArray(6) = 950#: pointsArray(7) = 420#: pointsArray( = 0# pointsArray(9) = 0#: pointsArray(10) = 420#: pointsArray(11) = 0# ssetObj.SelectByPolygon mode, pointsArray ThisDrawing.SendCommand "JOIN" & vbCr & "Previous" & vbCr & vbCr End Sub
Example_2012.dwg Oh damn... that would be helpful... unfortunately we won't be rolling out 2012 here for quite some time (if at all).
Either way... I think I got it sorted...
Sub JoinSplinesOnDWG()Dim SSet As AcadSelectionSetDim oSSetGroup As AcadGroupDim sGRName As StringDim FilterType(0) As IntegerDim FilterData(0) As VariantDim X1 As IntegerDim SplCountLive As IntegerDim AddItem() As AcadEntityDim acadDoc As AcadDocumentSet acadDoc = ThisDrawingOn Error Resume NextIf ThisDrawing.SelectionSets.Item("SSet") Is Nothing Then Set SSet = ThisDrawing.SelectionSets.Add("SSet")Else ThisDrawing.SelectionSets.Item("SSet").Clear Set SSet = ThisDrawing.SelectionSets("SSet")End IfOn Error GoTo 0Err.ClearFilterType(0) = 0FilterData(0) = "Spline"ReDim AddItem(0) As AcadEntitySSet.Select acSelectionSetAll, , , FilterType, FilterDataSplCountLive = SSet.CountX1 = 0Do Until X1 = SplCountLive X1 = X1 + 1 Set oSSetGroup = ThisDrawing.Groups.Add("SG") sGRName = oSSetGroup.Name Set AddItem(0) = SSet(X1) oSSetGroup.AppendItems AddItem On Error Resume Next If AddItem(0).Closed = False Then ThisDrawing.SendCommand "splinedit" + vbCr + "G" + vbCr + sGRName + vbCr + "J" + vbCr + _ "all" + vbCr + vbCr + vbCr End If If Not Err = 0 Then ThisDrawing.SendCommand "!(command)" & vbCr Err.Clear End If On Error GoTo 0 oSSetGroup.Delete SSet.Clear SSet.Select acSelectionSetAll, , , FilterType, FilterData SplCountLive = SSet.CountLoopEnd Sub
Next question... I found a good site yesterday explaining how to use multiple filters in your selection sets... But I can't find it again...
Here's what I've got...
Dim FilterType(1) As IntegerDim FilterData(1) As VariantFilterType(0) = 0FilterData(0) = "Arc"FilterType(1) = 0FilterData(1) = "Line"SSet.Select acSelectionSetAll, , , FilterType, FilterData
Unfortunately, this returns 0 items... but if I run either filter type separately, then I get plenty of objects returned...
What have I missed? Found it...
http://www.kxcad.net/autodesk/autocad/Autodesk_AutoCAD_ActiveX_and_VBA_Developer_Guide/ws1a9193826455f5ff1a32d8d10ebc6b7ccc-6c11.htm For that particular data type items can be strung together.Does this work any different:
Dim FilterType(0) As IntegerDim FilterData(0) As VariantFilterType(0) = 0FilterData(0) = "Arc,Line"SSet.Select acSelectionSetAll, , , FilterType, FilterData Oh damn... that simple... I'll have to give that a shot tomorrow at work.
I got the method mentioned on that kxcad.net website to work.. so it's all good... now when I run both bits of code, it joins all splines together, then all lines and arcs together as polylines...
Next episode, we hatch and export... then add the whole lot to the Inventor code I wrote earlier.
Thanks heaps for your help.
页:
1
[2]