Hi folks,
I've been plugging away at a couple little tasks. Years ago I had created a macro that created cut lines and bleeds for my work. Since that time I've learned so much more I'm doing a "clean room" implementation of it that I can share with others.
On the previous version of the macro I checked each shape against all the others in a selection and selectively trimmed away anything that wasn't needed. Loops and loops of checks.
I figured this time I could just use the Simplify function, once Steve Blosser showed me that I could call that via the "FrameWork" API in VBA.
The one thing I'm stuck on at the moment is that after I do the simplify, make shapes don't exist. Even if they are the only shapes on the layer and I re-select them after the simplify.
I can contour the first shape, but the rest of the references no longer exist.
From what I can see I can't automatically get the reference to the resulting shapes from the "Framework" call.
I would definitely appreciate it if someone could take a look at this and point out what I'm (probably obviously) missing?
On the page I set-up a number of overlapping basic shapes to test. I select them, then run the macro. Creating the contour will fail. If I comment out the "Framework..." line the script proceeds to the end.
Sub testSimplify() Dim bleedWidth As Double Dim targetLayer As Layer Dim workLayer As Layer Dim bleedRange As ShapeRange Dim dupRange As ShapeRange Dim workSh As Shape Dim tmpSh As Shape Dim origSel As Shape Dim conSh As Shape Dim cEff As Effect Dim targetLayerName As String Dim bleedCount As Long Dim conRange As ShapeRange Dim origRange As ShapeRange bleedWidth = 0.125 Set origRange = ActiveDocument.SelectionRange Set origSel = ActiveDocument.Selection Set dupRange = New ShapeRange If (origRange Is Nothing) Then Exit Sub End If If (origRange.Count < 1) Then Exit Sub End If If (targetLayerName = "") Then reqTargetLayerName = "Bleeds" End If targetLayerName = reqTargetLayerName & ".Working.XXX" Set workLayer = ActiveDocument.ActivePage.CreateLayer(targetLayerName) ' Create duplicates or cutable items of each shape we have For Each workSh In origRange.Shapes Set tmpSh = workSh.Duplicate tmpSh.MoveToLayer workLayer dupRange.Add tmpSh Next workSh ' Simplify the dupRange dupRange.CreateSelection FrameWork.Automation.InvokeItem ("7da36c72-627c-4782-b51a-01718a43551b") ' Now contour each shape For Each conSh In dupRange.Shapes MsgBox ("After simplifying there are now " & dupRange.Count & " duplicates left.") If (Not conSh Is Nothing) Then Set cEff = conSh.CreateContour(cdrContourOutside, bleedWidth, CornerType:=cdrContourCornerBevel) Set conRange = cEff.Separate bleedCount = bleedCount + 1 conRange.Shapes(1).Name = "Bleed-" & bleedCount conRange.Shapes(1).Fill.CopyAssign conSh.Fill End If Next conSh ' origSel.CreateSelectionEnd Sub
Sub testSimplify()
Dim bleedWidth As Double
Dim targetLayer As Layer
Dim workLayer As Layer
Dim bleedRange As ShapeRange
Dim dupRange As ShapeRange
Dim workSh As Shape
Dim tmpSh As Shape
Dim origSel As Shape
Dim conSh As Shape
Dim cEff As Effect
Dim targetLayerName As String
Dim bleedCount As Long
Dim conRange As ShapeRange
Dim origRange As ShapeRange
bleedWidth = 0.125
Set origRange = ActiveDocument.SelectionRange
Set origSel = ActiveDocument.Selection
Set dupRange = New ShapeRange
If (origRange Is Nothing) Then
Exit Sub
End If
If (origRange.Count < 1) Then
If (targetLayerName = "") Then
reqTargetLayerName = "Bleeds"
targetLayerName = reqTargetLayerName & ".Working.XXX"
Set workLayer = ActiveDocument.ActivePage.CreateLayer(targetLayerName)
' Create duplicates or cutable items of each shape we have
For Each workSh In origRange.Shapes
Set tmpSh = workSh.Duplicate
tmpSh.MoveToLayer workLayer
dupRange.Add tmpSh
Next workSh
' Simplify the dupRange
dupRange.CreateSelection
FrameWork.Automation.InvokeItem ("7da36c72-627c-4782-b51a-01718a43551b")
' Now contour each shape
For Each conSh In dupRange.Shapes
MsgBox ("After simplifying there are now " & dupRange.Count & " duplicates left.")
If (Not conSh Is Nothing) Then
Set cEff = conSh.CreateContour(cdrContourOutside, bleedWidth, CornerType:=cdrContourCornerBevel)
Set conRange = cEff.Separate
bleedCount = bleedCount + 1
conRange.Shapes(1).Name = "Bleed-" & bleedCount
conRange.Shapes(1).Fill.CopyAssign conSh.Fill
Next conSh
' origSel.CreateSelection
End Sub