- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
I have been working on a project where I need to be able to identify isometric views automatically. The drawings we use mostly have views that have been projected off a base view and when I try to identify views' camera.ViewOrientationType, most of them return back as arbitrary. I have figured out a way to discern iso views from the other views using my rule below.
The issue with this rule is that it currently only handles 4 views, I would like it to be able to handle however many views are on a sheet. I think if I used arrays or object collections this code could be a lot shorter and more powerful but I am having trouble figuring out how to do so. Any help and or advice for improving this rule would be greatly appreciated.
Sub Main()
'run on IDW containing views of a rectangular profile part to delete any iso views
Start:
Dim oDoc As DrawingDocument = ThisApplication.ActiveDocument
Dim oSheet As Sheet = oDoc.ActiveSheet
Dim oViews As DrawingViews = oSheet.DrawingViews
Dim oIntersectionIntent1 As GeometryIntent
Dim oIntersectionIntent2 As GeometryIntent
Dim oIntersectionIntent3 As GeometryIntent
Dim oIntersectionIntent4 As GeometryIntent
Dim intentPointOnSheet1 As Point2d
Dim intentPointOnSheet2 As Point2d
Dim intentPointOnSheet3 As Point2d
Dim intentPointOnSheet4 As Point2d
Dim intersectionPoint1 As Point2d
Dim intersectionPoint2 As Point2d
Dim intersectionPoint3 As Point2d
Dim intersectionPoint4 As Point2d
Dim minX1 As Double = oSheet.Width
Dim minX2 As Double = oSheet.Width
Dim minX3 As Double = oSheet.Width
Dim minX4 As Double = oSheet.Width
Dim maxX1 As Double = 0
Dim maxX2 As Double = 0
Dim maxX3 As Double = 0
Dim maxX4 As Double = 0
Dim minY1 As Double = oSheet.Height
Dim minY2 As Double = oSheet.Height
Dim minY3 As Double = oSheet.Height
Dim minY4 As Double = oSheet.Height
Dim maxY1 As Double = 0
Dim maxY2 As Double = 0
Dim maxY3 As Double = 0
Dim maxY4 As Double = 0
Dim i As Integer = 1 'represents DrawingView iteration
For Each oView As DrawingView In oViews
'Iterate through every drawing curve in the view
For Each oCurve As DrawingCurve In oView.DrawingCurves()
If i = 1 Then
'Check if curve is a Line
If oCurve.ProjectedCurveType = Curve2dTypeEnum.kLineSegmentCurve2d Then
'get midpoint location of line on sheet
oIntersectionIntent1 = oSheet.CreateGeometryIntent(oCurve, PointIntentEnum.kMidPointIntent)
intentPointOnSheet1 = oIntersectionIntent1.PointOnSheet
'gets and sets if point is max/min X/Y for view on sheet
If intentPointOnSheet1.X > maxX1 Then
maxX1 = intentPointOnSheet1.X
maxLineSegmentX1 = oCurve.Segments(1).Geometry
End If
If intentPointOnSheet1.X < minX1 Then
minX1 = intentPointOnSheet1.X
minLineSegmentX1 = oCurve.Segments(1).Geometry
End If
If intentPointOnSheet1.Y > maxY1 Then
maxY1 = intentPointOnSheet1.Y
maxLineSegmentY1 = oCurve.Segments(1).Geometry
End If
If intentPointOnSheet1.Y < minY1 Then
minY1 = intentPointOnSheet1.Y
minLineSegmentY1 = oCurve.Segments(1).Geometry
End If
End If
Else If i = 2 Then
'Check if curve is a Line
If oCurve.ProjectedCurveType = Curve2dTypeEnum.kLineSegmentCurve2d Then
'get midpoint location of line on sheet
oIntersectionIntent2 = oSheet.CreateGeometryIntent(oCurve, PointIntentEnum.kMidPointIntent)
intentPointOnSheet2 = oIntersectionIntent2.PointOnSheet
'gets and sets if point is max/min X/Y for view on sheet
If intentPointOnSheet2.X > maxX2 Then
maxX2 = intentPointOnSheet2.X
maxLineSegmentX2 = oCurve.Segments(1).Geometry
End If
If intentPointOnSheet2.X < minX2 Then
minX2 = intentPointOnSheet2.X
minLineSegmentX2 = oCurve.Segments(1).Geometry
End If
If intentPointOnSheet2.Y > maxY2 Then
maxY2 = intentPointOnSheet2.Y
maxLineSegmentY2 = oCurve.Segments(1).Geometry
End If
If intentPointOnSheet2.Y < minY2 Then
minY2 = intentPointOnSheet2.Y
minLineSegmentY2 = oCurve.Segments(1).Geometry
End If
End If
Else If i = 3 Then
'Check if curve is a Line
If oCurve.ProjectedCurveType = Curve2dTypeEnum.kLineSegmentCurve2d Then
'get midpoint location of line on sheet
oIntersectionIntent3 = oSheet.CreateGeometryIntent(oCurve, PointIntentEnum.kMidPointIntent)
intentPointOnSheet3 = oIntersectionIntent3.PointOnSheet
'gets and sets if point is max/min X/Y for view on sheet
If intentPointOnSheet3.X > maxX3 Then
maxX3 = intentPointOnSheet3.X
maxLineSegmentX3 = oCurve.Segments(1).Geometry
End If
If intentPointOnSheet3.X < minX3 Then
minX3 = intentPointOnSheet3.X
minLineSegmentX3 = oCurve.Segments(1).Geometry
End If
If intentPointOnSheet3.Y > maxY3 Then
maxY3 = intentPointOnSheet3.Y
maxLineSegmentY3 = oCurve.Segments(1).Geometry
End If
If intentPointOnSheet3.Y < minY3 Then
minY3 = intentPointOnSheet3.Y
minLineSegmentY3 = oCurve.Segments(1).Geometry
End If
End If
Else If i = 4 Then
'Check if curve is a Line
If oCurve.ProjectedCurveType = Curve2dTypeEnum.kLineSegmentCurve2d Then
'get midpoint location of line on sheet
oIntersectionIntent4 = oSheet.CreateGeometryIntent(oCurve, PointIntentEnum.kMidPointIntent)
intentPointOnSheet4 = oIntersectionIntent4.PointOnSheet
'gets and sets if point is max/min X/Y for view on sheet
If intentPointOnSheet4.X > maxX4 Then
maxX4 = intentPointOnSheet4.X
maxLineSegmentX4 = oCurve.Segments(1).Geometry
End If
If intentPointOnSheet4.X < minX4 Then
minX4 = intentPointOnSheet4.X
minLineSegmentX4 = oCurve.Segments(1).Geometry
End If
If intentPointOnSheet4.Y > maxY4 Then
maxY4 = intentPointOnSheet4.Y
maxLineSegmentY4 = oCurve.Segments(1).Geometry
End If
If intentPointOnSheet4.Y < minY4 Then
minY4 = intentPointOnSheet4.Y
minLineSegmentY4 = oCurve.Segments(1).Geometry
End If
End If
End If
Next
If i = 1 Then
'create minX/Y lines to find intersection
Dim lineX1 = ThisApplication.TransientGeometry.CreateLine2d(minLineSegmentX1.StartPoint, minLineSegmentX1.Direction)
Dim lineY1 = ThisApplication.TransientGeometry.CreateLine2d(minLineSegmentY1.StartPoint, minLineSegmentY1.Direction)
'get intersection point of minX/Y lines
intersectionPoint1 = lineX1.IntersectWithCurve(lineY1)(1)
'if intersection point is inline with minX/Y midpoints then view is not iso
If intersectionPoint1.X = minX1 And intersectionPoint1.Y = minY1 Then
MsgBox(oView.Name & " NOT iso")
MsgBox("minX1: " & minX1 & " intersectionPoint1.X: " & intersectionPoint1.X & " minY1: " & minY1 & " intersectionPoint1.Y: " & intersectionPoint1.Y)
Else
MsgBox(oView.Name & " IS iso")
MsgBox("minX1: " & minX1 & " intersectionPoint1.X: " & intersectionPoint1.X & " minY1: " & minY1 & " intersectionPoint1.Y: " & intersectionPoint1.Y)
Try
oView.Delete
GoTo Start
Catch
MsgBox("View deletion failed")
End Try
End If
Else If i = 2 Then
'create minX/Y lines to find intersection
Dim lineX2 = ThisApplication.TransientGeometry.CreateLine2d(minLineSegmentX2.StartPoint, minLineSegmentX2.Direction)
Dim lineY2 = ThisApplication.TransientGeometry.CreateLine2d(minLineSegmentY2.StartPoint, minLineSegmentY2.Direction)
'get intersection point of minX/Y lines
intersectionPoint2 = lineX2.IntersectWithCurve(lineY2)(1)
'if intersection point is inline with minX/Y midpoints then view is not iso
If intersectionPoint2.X = minX2 And intersectionPoint2.Y = minY2 Then
MsgBox(oView.Name & " NOT iso")
MsgBox("minX2: " & minX2 & " intersectionPoint2.X: " & intersectionPoint2.X & " minY2: " & minY2 & " intersectionPoint2.Y: " & intersectionPoint2.Y)
Else
MsgBox(oView.Name & " IS iso")
MsgBox("minX2: " & minX2 & " intersectionPoint2.X: " & intersectionPoint2.X & " minY2: " & minY2 & " intersectionPoint2.Y: " & intersectionPoint2.Y)
Try
oView.Delete
GoTo Start
Catch
MsgBox("View deletion failed")
End Try
End If
Else If i = 3 Then
'create minX/Y lines to find intersection
Dim lineX3 = ThisApplication.TransientGeometry.CreateLine2d(minLineSegmentX3.StartPoint, minLineSegmentX3.Direction)
Dim lineY3 = ThisApplication.TransientGeometry.CreateLine2d(minLineSegmentY3.StartPoint, minLineSegmentY3.Direction)
'get intersection point of minX/Y lines
intersectionPoint3 = lineX3.IntersectWithCurve(lineY3)(1)
'if intersection point is inline with minX/Y midpoints then view is not iso
If intersectionPoint3.X = minX3 And intersectionPoint3.Y = minY3 Then
MsgBox(oView.Name & " NOT iso")
MsgBox("minX3: " & minX3 & " intersectionPoint3.X: " & intersectionPoint3.X & " minY3: " & minY3 & " intersectionPoint3.Y: " & intersectionPoint3.Y)
Else
MsgBox(oView.Name & " IS iso")
MsgBox("minX3: " & minX3 & " intersectionPoint3.X: " & intersectionPoint3.X & " minY3: " & minY3 & " intersectionPoint3.Y: " & intersectionPoint3.Y)
Try
oView.Delete
GoTo Start
Catch
MsgBox("View deletion failed")
End Try
End If
Else If i = 4 Then
'create minX/Y lines to find intersection
Dim lineX4 = ThisApplication.TransientGeometry.CreateLine2d(minLineSegmentX4.StartPoint, minLineSegmentX4.Direction)
Dim lineY4 = ThisApplication.TransientGeometry.CreateLine2d(minLineSegmentY4.StartPoint, minLineSegmentY4.Direction)
'get intersection point of minX/Y lines
intersectionPoint4 = lineX4.IntersectWithCurve(lineY4)(1)
'if intersection point is inline with minX/Y midpoints then view is not iso
If intersectionPoint4.X = minX4 And intersectionPoint4.Y = minY4 Then
MsgBox(oView.Name & " NOT iso")
MsgBox("minX4: " & minX4 & " intersectionPoint4.X: " & intersectionPoint4.X & " minY4: " & minY4 & " intersectionPoint4.Y: " & intersectionPoint4.Y)
Else
MsgBox(oView.Name & " IS iso")
MsgBox("minX4: " & minX4 & " intersectionPoint4.X: " & intersectionPoint4.X & " minY4: " & minY4 & " intersectionPoint4.Y: " & intersectionPoint4.Y)
Try
oView.Delete
GoTo Start
Catch
MsgBox("View deletion failed")
End Try
End If
End If
i = i + 1
Next
End Sub
Solved! Go to Solution.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
As far as the code you posted goes, if you can get rid of the "i" Integer check there isn't really a reason it shouldn't work for any number of drawing views. I'm not sure why you want to keep track of 4 sets of values.
As far as solving the question asked; I had an issue where an ISO view was set for general dimensions to be Projected instead of True in a drawing. This caused the shop to produce a product that was too small. In order to identify this potential issue in the future I wrote a script to identify ISO views and check that property. I ran into the same issue with Arbitrary views so I came up with a function that works well in my working set.
I just multiply the X, Y, & Z values of the vector from Camera Eye to Camera Target and return as ISO if the output value is not 0. This works for me because all my views are oriented orthogonal to at least one of the origin planes unless it is an ISO/Custom orientation view, so I will have at least one value that is 0. If this will work for your working set you can use this function:
Function IsArbitraryViewISO(dv As DrawingView) As Boolean
Dim CameraDirectionUnitVector As UnitVector = dv.Camera.Eye.VectorTo(dv.Camera.Target).AsUnitVector
Dim VectorCoordinateMultiplication As Double = CameraDirectionUnitVector.X * CameraDirectionUnitVector.Y * CameraDirectionUnitVector.Z
If VectorCoordinateMultiplication <> 0 Then Return True
Return False
End Function
I call it anytime the "ViewOrientationTypeEnum" of the DrawingView returns as "kArbitraryViewOrientation".
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
@J-Camper I really appreciate your advice and the function provided, thank you! The reason I was keeping all the dimensions separate is because this code was based off a profile dimensioning function used in the same rule this code is for. So while it wasn't necessary for this code, I was trying to get a better understanding of collections in general. The goal of the rule is to export all the necessary data from blueprints to excel to be used with our panel saw optimizer. I was having trouble picking the desired view so I made my rule check each view for the info its looking for. The code I posted was working well enough if the view it was analyzing was a rectangular part but would not be able to handle non-rectangular ones. I have modified the function you provided to identify ISO views of parts of any shape. Using this and the profile dimension finder as well as a few other functions to identify notes and symbols containing keywords, I can now find my desired view and gather data from it without having to save information from all views. Thanks again!
Modified Function:
Function isViewISO(dv As DrawingView) As Boolean
Dim CameraDirectionUnitVector As UnitVector = dv.Camera.Eye.VectorTo(dv.Camera.Target).AsUnitVector
If Round(Abs(CameraDirectionUnitVector.X), 10) = 0.5773502692 Or _
Round(Abs(CameraDirectionUnitVector.Y), 10) = 0.5773502692 Or _
Round(Abs(CameraDirectionUnitVector.Z), 10) = 0.5773502692 Then
MsgBox(dv.Name & " IS ISO")
Return True
End If
Return False
End Function
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Here is an example of using Lists to collect information:
Sub Main
Dim dDoc As DrawingDocument = TryCast(ThisApplication.ActiveDocument, DrawingDocument)
If IsNothing(dDoc) Then Logger.Debug("Not Run In Drawing Document") : Exit Sub
Dim PickView As DrawingView = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kDrawingViewFilter, "Select a View to collection points")
If IsNothing(PickView) Then Exit Sub ' If nothing gets selected then we're done
Dim CoordinateList As New List(Of List(Of Double))
For Each dc As DrawingCurve In PickView.DrawingCurves
If IsNothing(dc.MidPoint) Then Continue For 'Skip
Dim MidPointList As New List(Of Double)
MidPointList.AddRange({dc.MidPoint.X, dc.MidPoint.Y}) 'Add for 3D points: , dc.CenterPoint.Z})
CoordinateList.Add(MidPointList)
Next
For Each CollectedList As List(Of Double) In CoordinateList
Dim MessageString As String = Nothing
If CollectedList.Count = 3
MessageString = "X: " & CollectedList.Item(0) & " | Y: " & CollectedList.Item(1) & " | Z: " & CollectedList.Item(2)' 3D Points
Else If CollectedList.Count = 2
MessageString = "X: " & CollectedList.Item(0) & " | Y: " & CollectedList.Item(1)' 2D Points
End If
Logger.Trace(MessageString)
Next
End Sub
It is not the only way to collect information, but it might help you understand value collections. If you want the objects themselves, you can use an ObjectCollection:
Sub Main
Dim dDoc As DrawingDocument = TryCast(ThisApplication.ActiveDocument, DrawingDocument)
If IsNothing(dDoc) Then Logger.Debug("Not Run In Drawing Document") : Exit Sub
Dim PickView As DrawingView = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kDrawingViewFilter, "Select a View to collection points")
If IsNothing(PickView) Then Exit Sub ' If nothing gets selected then we're done
Dim DrawingCurveCollection As ObjectCollection = ThisApplication.TransientObjects.CreateObjectCollection
For Each dc As DrawingCurve In PickView.DrawingCurves
DrawingCurveCollection.Add(dc)
Next
Dim testingLimiter As Integer = 15 'Testing purposes only to limit messageboxes if user selects a view with many drawing curves
Dim TextCounter As Integer = 0 'Testing purposes only to limit messageboxes if user selects a view with many drawing curves
Dim selectThis As HighlightSet = ThisApplication.ActiveDocument.CreateHighlightSet
For Each CollectedDrawingCurve As DrawingCurve In DrawingCurveCollection
TextCounter += 1
If TextCounter > testingLimiter Then Exit For
selectThis.AddItem(CollectedDrawingCurve.Segments(1))
MessageBox.Show("Highlighted First Segment of a DrawingCurve")
selectThis.Clear
Next
End Sub