- 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.