OK, after searching thru the newsgroup and trying all of the (not that many to try actually) suggestions, I am still baffled as to why the following code does not work. At first I thought it was because I was trying to perform the CopyObjects inside a For..Next loop, so I commented that out and I get the same result...nadda. No error, no nothing. I must restate that: Everything works as desired except for the CopyObjects portion. What am I missing? Jeff 'GridX & GridY are global Longs Private Sub dwgsplit(dblMin As Variant, numX As Long, numY As Long) Dim dwgSS As AcadSelectionSet Dim Y As Long Dim X As Long Dim dwgCount As Long Dim llp(0 To 2) As Double Dim urp(0 To 2) As Double Dim dwgPath As String Dim dwgName As String Dim dwgPre As String Dim newDwg As AcadDocument Dim docs As AcadDocuments Dim dwgOrig As String dwgOrig = doc.Name Set docs = doc.Application.Documents dwgPath = doc.Path dwgPre = doc.Utility.GetString(True, "Enter prefix for new drawings: ") 'For Y = 0 To numY - 2 'For X = 0 To numX - 2 On Error Resume Next doc.SelectionSets.Item("split").Delete Set dwgSS = doc.SelectionSets.Add("split") llp(0) = dblMin(0) + (GridX * X) llp(1) = dblMin(1) + (GridY * Y) urp(0) = llp(0) + GridX urp(1) = llp(1) + GridY dwgSS.Select acSelectionSetCrossing, llp, urp If dwgSS.Count > 4 Then ReDim exportSS(0 To dwgSS.Count - 1) As AcadObject Dim I As Long For I = 0 To dwgSS.Count - 1 Set exportSS(I) = dwgSS.Item(I) I = I + 1 Next I dwgCount = dwgCount + 1 dwgName = dwgPath & "\" & dwgPre & Format(dwgCount, "00") _ & ".dwg" Set newDwg = docs.Add newDwg.SaveAs (dwgName) docs.Item(dwgOrig).Activate Dim id As Variant doc.CopyObjects exportSS, newDwg.ModelSpace, id newDwg.Application.ZoomExtents newDwg.Save newDwg.Close End If 'Next X 'Next Y End Sub
Jeff, your code is using a selection set. The docs clearly show you need to use an *array of objects* with the CopyFrom method: Sub Test() Dim thisDoc As AcadDocument Set thisDoc = AcadApplication.ActiveDocument Dim otherDoc As AcadDocument Set otherDoc = AcadApplication.Documents.Add thisDoc.Activate Dim copyObjs(0) As Object Dim ptCircle(0 To 2) As Double Set copyObjs(0) = ThisDrawing.ModelSpace.AddCircle(ptCircle, 1#) AcadApplication.ZoomExtents ThisDrawing.CopyObjects copyObjs, otherDoc.ModelSpace With otherDoc.ModelSpace .Item(.Count - 1).color = 1 End With otherDoc.Activate AcadApplication.ZoomExtents End Sub -- R. Robert Bell, MCSE www.AcadX.com | OK, after searching thru the newsgroup and trying all of the (not that many | to try actually) suggestions, I am still baffled as to why the following | code does not work. At first I thought it was because I was trying to | perform the CopyObjects inside a For..Next loop, so I commented that out and | I get the same result...nadda. No error, no nothing. I must restate that: | Everything works as desired except for the CopyObjects portion. | What am I missing? | | Jeff | 'GridX & GridY are global Longs | Private Sub dwgsplit(dblMin As Variant, numX As Long, numY As Long) | Dim dwgSS As AcadSelectionSet | Dim Y As Long | Dim X As Long | Dim dwgCount As Long | Dim llp(0 To 2) As Double | Dim urp(0 To 2) As Double | Dim dwgPath As String | Dim dwgName As String | Dim dwgPre As String | Dim newDwg As AcadDocument | Dim docs As AcadDocuments | Dim dwgOrig As String | | dwgOrig = doc.Name | Set docs = doc.Application.Documents | dwgPath = doc.Path | dwgPre = doc.Utility.GetString(True, "Enter prefix for new drawings: ") | 'For Y = 0 To numY - 2 | 'For X = 0 To numX - 2 | On Error Resume Next | doc.SelectionSets.Item("split").Delete | Set dwgSS = doc.SelectionSets.Add("split") | | llp(0) = dblMin(0) + (GridX * X) | llp(1) = dblMin(1) + (GridY * Y) | urp(0) = llp(0) + GridX | urp(1) = llp(1) + GridY | dwgSS.Select acSelectionSetCrossing, llp, urp | If dwgSS.Count > 4 Then | ReDim exportSS(0 To dwgSS.Count - 1) As AcadObject | Dim I As Long | For I = 0 To dwgSS.Count - 1 | Set exportSS(I) = dwgSS.Item(I) | I = I + 1 | Next I | dwgCount = dwgCount + 1 | dwgName = dwgPath & "\" & dwgPre & Format(dwgCount, "00") _ | & ".dwg" | Set newDwg = docs.Add | newDwg.SaveAs (dwgName) | docs.Item(dwgOrig).Activate | Dim id As Variant | doc.CopyObjects exportSS, newDwg.ModelSpace, id | newDwg.Application.ZoomExtents | newDwg.Save | newDwg.Close | End If | 'Next X | 'Next Y | End Sub | |
Actually, upon further review... are you using Option Explicit in your code? I don't see where you dim the type of your exportSS variable (which means it is a variant of variants, not objects). Note my example where I dim the copyObjs array. -- R. Robert Bell, MCSE www.AcadX.com | Jeff, your code is using a selection set. The docs clearly show you need to | use an *array of objects* with the CopyFrom method: | | | Sub Test() | Dim thisDoc As AcadDocument | Set thisDoc = AcadApplication.ActiveDocument | | Dim otherDoc As AcadDocument | Set otherDoc = AcadApplication.Documents.Add | | thisDoc.Activate | Dim copyObjs(0) As Object | Dim ptCircle(0 To 2) As Double | Set copyObjs(0) = ThisDrawing.ModelSpace.AddCircle(ptCircle, 1#) | AcadApplication.ZoomExtents | | ThisDrawing.CopyObjects copyObjs, otherDoc.ModelSpace | With otherDoc.ModelSpace | .Item(.Count - 1).color = 1 | End With | otherDoc.Activate | AcadApplication.ZoomExtents | End Sub | | | -- | R. Robert Bell, MCSE | www.AcadX.com | | | | | OK, after searching thru the newsgroup and trying all of the (not that | many | | to try actually) suggestions, I am still baffled as to why the following | | code does not work. At first I thought it was because I was trying to | | perform the CopyObjects inside a For..Next loop, so I commented that out | and | | I get the same result...nadda. No error, no nothing. I must restate that: | | Everything works as desired except for the CopyObjects portion. | | What am I missing? | | | | Jeff | | 'GridX & GridY are global Longs | | Private Sub dwgsplit(dblMin As Variant, numX As Long, numY As Long) | | Dim dwgSS As AcadSelectionSet | | Dim Y As Long | | Dim X As Long | | Dim dwgCount As Long | | Dim llp(0 To 2) As Double | | Dim urp(0 To 2) As Double | | Dim dwgPath As String | | Dim dwgName As String | | Dim dwgPre As String | | Dim newDwg As AcadDocument | | Dim docs As AcadDocuments | | Dim dwgOrig As String | | | | dwgOrig = doc.Name | | Set docs = doc.Application.Documents | | dwgPath = doc.Path | | dwgPre = doc.Utility.GetString(True, "Enter prefix for new drawings: ") | | 'For Y = 0 To numY - 2 | | 'For X = 0 To numX - 2 | | On Error Resume Next | | doc.SelectionSets.Item("split").Delete | | Set dwgSS = doc.SelectionSets.Add("split") | | | | llp(0) = dblMin(0) + (GridX * X) | | llp(1) = dblMin(1) + (GridY * Y) | | urp(0) = llp(0) + GridX | | urp(1) = llp(1) + GridY | | dwgSS.Select acSelectionSetCrossing, llp, urp | | If dwgSS.Count > 4 Then | | ReDim exportSS(0 To dwgSS.Count - 1) As AcadObject | | Dim I As Long | | For I = 0 To dwgSS.Count - 1 | | Set exportSS(I) = dwgSS.Item(I) | | I = I + 1 | | Next I | | dwgCount = dwgCount + 1 | | dwgName = dwgPath & "\" & dwgPre & Format(dwgCount, "00") | _ | | & ".dwg" | | Set newDwg = docs.Add | | newDwg.SaveAs (dwgName) | | docs.Item(dwgOrig).Activate | | Dim id As Variant | | doc.CopyObjects exportSS, newDwg.ModelSpace, id | | newDwg.Application.ZoomExtents | | newDwg.Save | | newDwg.Close | | End If | | 'Next X | | 'Next Y | | End Sub | | | | | |
Robert, Thanks for responding so quickly. I guess my variable naming conventions need some work. Although my variable is "exportSS", it IS Dim'ed as an AcadObject array and it is filled from the entities of a Selection set. However! I just went to run thru it again to give you a cut/paste of the Locals for that var and I noticed that only the odd numbered dimensions in the array were entities, the even numbers were Nothing....so looking back at my code I see this: | For I = 0 To dwgSS.Count - 1 | Set exportSS(I) = dwgSS.Item(I) | I = I + 1 | Next I I was incrementing I AND Next'ing I, which really fouled things up......After fixing that, I just went through and ran it with my For..Next loops uncommented and it works great. Another slap to the forehead. Thanks again, Jeff
