09-22-2020
01:30 PM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
09-22-2020
01:30 PM
I condensed the code a little and change the Try/Catch into a loop:
Sub Main()
If ThisApplication.ActiveDocumentType <> kDrawingDocumentObject Then MessageBox.Show("This rule is designed to only work in drawing documents.", "Wrong Document Type") : Exit Sub
Start:
Dim oDrawDoc As DrawingDocument = ThisApplication.ActiveDocument
' Select a drawing view.
Dim oView As DrawingView = ThisApplication.CommandManager.Pick(kDrawingViewFilter, "Select a drawing view.")
'Set a reference to the active sheet.
Dim oSheet As Sheet = oView.Parent
Dim dXval As Double = oView.Left
Dim dYval As Double = oView.Center.Y
Dim dLeftXval As Double = dXval - 3
'add height to y value
Dim dUpperYval As Double = dYval + (0.5 * oView.Height) + 1
'subract height To y value
Dim dLowerYval As Double = dYval - (0.5 * oView.Height) - 1
Dim oPoint1 As Point2d = ThisApplication.TransientGeometry.CreatePoint2d(dLeftXval,dUpperYval)
Dim oPoint2 As Point2d = ThisApplication.TransientGeometry.CreatePoint2d(dLeftXval,dLowerYval)
'create a new sketch For the section
Dim oDrawingSketch As DrawingSketch = oView.Sketches.Add
Dim oSketchPoint1 As Point2d = oDrawingSketch.SheetToSketchSpace(oPoint1)
Dim oSketchPoint2 As Point2d = oDrawingSketch.SheetToSketchSpace(oPoint2)
oDrawingSketch.Edit
Dim oSketchLine As SketchLine = oDrawingSketch.SketchLines.AddByTwoPoints(oSketchPoint1,oSketchPoint2)
oDrawingSketch.ExitEdit
'set the location for the view
Dim olocal As Point2d = ThisApplication.TransientGeometry.CreatePoint2d(6,oView.Center.Y)
Dim oView2 As SectionDrawingView = oSheet.DrawingViews.AddSectionView(oView, oDrawingSketch, olocal,DrawingViewStyleEnum.kFromBaseDrawingViewStyle, Nothing, , , False, True)
oDrawingSketch.Visible = True
'AutoGenerate PartList
Dim oPlacementPoint As Point2d = ThisApplication.TransientGeometry.CreatePoint2d(dLeftXval+22, dUpperYval+3)
iLogicVb.UpdateWhenDone = True
For Each pl As PartsList In oSheet.PartsLists
If pl.ReferencedDocumentDescriptor.FullDocumentName = oView.ReferencedDocumentDescriptor.FullDocumentName
GoTo Done 'Parts list Exists so exiting loop to avoid making again
End If
Next
'If exiting loop normally, then Partslist was not found so we will make it
Dim oPartslist As PartsList = oSheet.PartsLists.Add(oView, oPlacementPoint)
Done :
'Selection if you want to continue with section cut
Dim oChoice As String = MsgBox(" Do you want to create another section cut?", vbQuestion + vbYesNo + vbDefaultButton2, "Section Cut")
If oChoice = vbYes Then GoTo Start
End SubLet me know if you're still having issues.