Dear,
I got a macro job for creation the drawing for a part. I got a lot of problem.
1/ The first one is move view:
I already create a view (e.g. oIsoView), now I want to move it to the left.
I find the DrawingView.Position method, how can I use this method? I try many time, but it's not successful yet.
Do I need to use the SelectSet method??????
Solved! Go to Solution.
Solved by YuhanZhang. Go to Solution.
Try below VBA code:
Sub MoveDrawingView() Dim oDoc As DrawingDocument Set oDoc = ThisApplication.ActiveDocument Dim oView As DrawingView Set oView = oDoc.Sheets(1).DrawingViews(1) Dim oPosition As Point2d Set oPosition = oView.Position ' move the drawing view to left oPosition.X = oPosition.X - 5 oView.Position = oPosition End Sub
I try your code, it works well. I checked by MsgBox().
However, an problem exists before I move the view, that is:
I can not use the DrawingBreakViewAlignmentCmd command although I read and try the same as Help
' I create an section view , this code worked
Dim oSectionView As SectionDrawingView
Set oSectionView = oSheet.DrawingViews.AddSectionView(oBaseView, oSectionSketch0, oPoint11_
, kFromBaseDrawingViewStyle, , True, "A", False, True)
oSectionView.ReverseDirection
'''''''Break the Alignment of Section View
oDrawDoc.SelectSet.Clear
oDrawDoc.SelectSet.Select (oSectionView)
Dim oCtrlDef As ControlDefinition
Set oCtrlDef = ThisApplication.CommandManager.ControlDefinitions.Item("DrawingBreakViewAlignmentCmd")
oCtrlDef.Execute
oDrawDoc.SelectSet.Clear
I don't understand why it can not work in this case.
I create a new drawing, and this can work. What happens here???????
Thank you!
I just create the same code in another modules, not my Form as upper.
It works well. Is any thing different here?
Sub BreakAlignment()
Dim oDoc As DrawingDocument
Set oDoc = ThisApplication.ActiveDocument
Dim oSectionView As SectionDrawingView
Set oSectionView = oDoc.Sheets(1).DrawingViews.Item("4")
oDoc.SelectSet.Clear
oDoc.SelectSet.Select oSectionView
Dim oCtrlDef As ControlDefinition
Set oCtrlDef = ThisApplication.CommandManager.ControlDefinitions.Item("DrawingBreakViewAlignmentCmd")
oCtrlDef.Execute
oDoc.SelectSet.Clear
End Sub
I copy this code to my form, but it doesn't work.
I don't understand what happens?
What's different between the Module and Form in this case?
How I can run a module (eg. Module2) from my form??????
Many thanks in advance!
The difference is that in the first case you are using parenthesis: oDrawDoc.SelectSet.Select (oSectionView)
and none in the second case: oDoc.SelectSet.Select oSectionView
In any case, it would be easier to break the alignment with: oSectionView.Aligned = False
I got that; it works very well. Thank you, Alewer!
Now is the hardest thing (with me) that is to make dimension for the drawing.
How I can select the edge as a person do? What I need to write for the program in VBA to have a drawing like this:
I find in the Programing Help > Drawnig Dimensions, but I just see something very complex.
DrawingCurveSegment, DrawingCurve, GeometryIntent,Vector2d, etc.
I found something in Mr Brain blog (modthemachine), but I don't understand too
Is it impossible mission for me to make upper drawing by VBA?? Please help!!!!
Is there any materials that simple can be worth for me in this case???
Many thanks in advance!
I got another problem with this code. I think something wrong in the Profile or BreakOutOperation.Add, but I cannot find out
Dim oProfile0 As Profile
Dim oPoint130 As Point2d
Dim oBreakOutOper As BreakOutOperation
Set oPoint130 = oTG.CreatePoint2d(0,0)
Dim oBreakOutSketch1 As DrawingSketch
Call oTopView.Sketches.Add
Set oBreakOutSketch1 = oTopView.Sketches.Item(1)
'open the sketch for edit
oBreakOutSketch1.Edit
'drawing a line in sketch for section line
Dim oCircle1 As SketchCircle
Set oCircle1 = oBreakOutSketch1.SketchCircles.AddByCenterRadius(oPoint130, 30/ 10)
'exit from editing sketch
oBreakOutSketch1.ExitEdit
Set oProfile0 = oBreakOutSketch1.Profiles.AddForSolid()
Set oBreakOutOper = oTopView.BreakOutOperations.Add(oProfile0, GeometryIntent, 100/10)
Many thanks in advance!
I got solution by myself again........
Dim oProfile0 As Profile
Dim oBreakOutOper0 As BreakOutOperation
Dim oPoint130 As Point2d
Set oPoint130 = oTG.CreatePoint2d(50, 50)
Dim oBreakOutSketch0 As DrawingSketch
Set oBreakOutSketch0 = oBaseView.Sketches.Add
'open the sketch for edit
oBreakOutSketch0.Edit
'drawing a line in sketch for section line
Dim oCircle0 As SketchCircle
Set oCircle0 = oBreakOutSketch0.SketchCircles.AddByCenterRadius(oPoint130, 5)
'Create a collection and add the circle
Dim oCollection0 As ObjectCollection
Set oCollection0 = ThisApplication.TransientObjects.CreateObjectCollection
oCollection0.Add oCircle0
Set oProfile0 = oBreakOutSketch0.Profiles.AddForSolid(False, oCollection0)
'exit from editing sketch
oBreakOutSketch0.ExitEdit
' find the left horizontal line
For Each oCurve0 In oBaseView.DrawingCurves
If Not oCurve0.StartPoint Is Nothing And Not oCurve0.EndPoint Is Nothing Then
If (WithinTol(oCurve0.StartPoint.x, oCurve0.EndPoint.x, 0.001) = False) Then
If oSelectCurve0 Is Nothing Then
Set oSelectCurve0 = oCurve0
Else
If oCurve0.MidPoint.x < oSelectCurve0.MidPoint.x Then
Set oSelectCurve0 = oCurve0
End If
End If
End If
End If
Next
'create GeometryIntent
Dim oGeometryIntentPoint0 As GeometryIntent
Set oGeometryIntentPoint0 = osheet.CreateGeometryIntent(oSelectCurve0, kMidPointIntent)
Set oBreakOutOper0 = oBaseView.BreakOutOperations.Add(oProfile0, oGeometryIntentPoint0, 0)
Something which is very complex is still waiting for me, that is I want to make the Centerlines for some views, using Centerline Bisector cmd, centerline cmd, and center mark. How to do this??????
After that, how we can choose the centerline and drawing line, I means that it seem to be the DrawingCurve is only use for Curve of Object in view, not the Annotated Line?????????
I am trying to dimension my drawing as the aforementioned picture, but there are big problem here.
I don't understand why sometimes it can get the curve and sometime it cannot?
Everything is just like a chaos here, and I cannot control this.
Sub baseview()
Dim oDrawDoc As DrawingDocument
Set oDrawDoc = ThisApplication.ActiveDocument
Dim oSheet As Sheet
Set oSheet = oDrawDoc.ActiveSheet
Dim oBaseView As DrawingView
Set oBaseView = oSheet.DrawingViews.Item(1)
Dim oTG As TransientGeometry
Set oTG = ThisApplication.TransientGeometry
'////////////////oBaseView Dimension//////////////////////
Dim oCurve100 As DrawingCurve
Dim oSelectCurve100, oSelectCurve101, oSelectCurve102, oSelectCurve103, oSelectCurve104 As DrawingCurve
Set oSelectCurve100 = Nothing
Set oSelectCurve101 = Nothing
Set oSelectCurve102 = Nothing
Set oSelectCurve103 = Nothing
Set oSelectCurve104 = Nothing
For Each oCurve100 In oBaseView.DrawingCurves
If oCurve100.CurveType = kLineSegmentCurve Then
If Not oCurve100.StartPoint Is Nothing And Not oCurve100.EndPoint Is Nothing Then
If Round(oCurve100.StartPoint.x - oCurve100.EndPoint.x, 3) = 0 Then
' MsgBox (Round(oCurve100.StartPoint.y - oCurve100.EndPoint.y, 3))
' If (WithinTol(oCurve100.StartPoint.x, oCurve100.EndPoint.x, 0.001) = True) Then
If (Round(Math.Abs(oCurve100.StartPoint.y - oCurve100.EndPoint.y), 3) = 1.28) Then
Set oSelectCurve100 = oCurve100
End If
If (Round(Math.Abs(oCurve100.StartPoint.y - oCurve100.EndPoint.y), 3) = ((80) * 0.2 / 10)) Then
Set oSelectCurve101 = oCurve100
End If
If (Round(Math.Abs(oCurve100.StartPoint.y - oCurve100.EndPoint.y), 3) = ((132) * 0.2 / 10)) Then
Set oSelectCurve102 = oCurve100
End If
If (Round(Math.Abs(oCurve100.StartPoint.y - oCurve100.EndPoint.y), 3) = ((211.5) * 0.2 / 10)) Then
Set oSelectCurve103 = oCurve100
End If
End If
End If
End If
Next
Dim oGI100, oGI101, oGI102, oGI103, oGI104, oGI105, oGI106, oGI107, oGI108, oGI109 As GeometryIntent
Set oGI100 = Nothing
Set oGI101 = Nothing
Set oGI102 = Nothing
Set oGI103 = Nothing
Set oGI104 = Nothing
Set oGI105 = Nothing
Set oGI106 = Nothing
Set oGI107 = Nothing
Set oGI108 = Nothing
Set oGI109 = Nothing
Set oGI100 = oSheet.CreateGeometryIntent(oSelectCurve100, kStartPointIntent)
Set oGI101 = oSheet.CreateGeometryIntent(oSelectCurve100, kEndPointIntent)
Set oGI102 = oSheet.CreateGeometryIntent(oSelectCurve101, kStartPointIntent)
Set oGI103 = oSheet.CreateGeometryIntent(oSelectCurve101, kEndPointIntent)
Set oGI104 = oSheet.CreateGeometryIntent(oSelectCurve102, kStartPointIntent)
Set oGI105 = oSheet.CreateGeometryIntent(oSelectCurve102, kEndPointIntent)
Set oGI106 = oSheet.CreateGeometryIntent(oSelectCurve103, kStartPointIntent)
Dim oGenDims As GeneralDimensions
Set oGenDims = oSheet.DrawingDimensions.GeneralDimensions
Dim oDimPos100, oDimPos101, oDimPos102, oDimPos103, oDimPos104, oDimPos105, oDimPos106, oDimPos107, oDimPos108, oDimPos109 As Point2d
Set oDimPos100 = Nothing
Set oDimPos101 = Nothing
Set oDimPos102 = Nothing
Set oDimPos103 = Nothing
Set oDimPos104 = Nothing
Set oDimPos105 = Nothing
Set oDimPos106 = Nothing
Set oDimPos107 = Nothing
Set oDimPos108 = Nothing
Set oDimPos109 = Nothing
If Not oSelectCurve100 Is Nothing Then
Set oDimPos100 = oTG.CreatePoint2d(oSelectCurve100.MidPoint.x - 1, oSelectCurve100.MidPoint.y)
End If
If Not oSelectCurve101 Is Nothing Then
Set oDimPos101 = oTG.CreatePoint2d(oSelectCurve101.MidPoint.x - 1.8 - 85 * 0.2 / 10, oSelectCurve101.MidPoint.y)
End If
If Not oSelectCurve102 Is Nothing Then
Set oDimPos102 = oTG.CreatePoint2d(oSelectCurve102.MidPoint.x - 2.8 - (85 + (76 - 45)) * 0.2 / 10, oSelectCurve102.MidPoint.y)
End If
If (Not oSelectCurve100 Is Nothing) And (Not oSelectCurve101 Is Nothing) Then
Set oDimPos103 = oTG.CreatePoint2d((oSelectCurve100.MidPoint.x + oSelectCurve101.MidPoint.x) / 2, oSelectCurve100.MidPoint.y - 211.5 * 0.2 / 2 / 10 - 1.8)
End If
If (Not oSelectCurve101 Is Nothing) And (Not oSelectCurve103 Is Nothing) Then
Set oDimPos104 = oTG.CreatePoint2d((oSelectCurve101.MidPoint.x + oSelectCurve103.MidPoint.x) / 2, oSelectCurve103.StartPoint.y + 1.8)
End If
If (Not oSelectCurve102 Is Nothing) And (Not oSelectCurve103 Is Nothing) Then
Set oDimPos105 = oTG.CreatePoint2d((oSelectCurve102.MidPoint.x + oSelectCurve103.MidPoint.x) / 2, oSelectCurve103.StartPoint.y + 1)
End If
Dim oLDim100, oLDim101, oLDim102, oLDim103, oLDim104, oLDim105, oLDim106, oLDim107, oLDim108, oLDim109 As LinearGeneralDimension
'dim KK
If Not oDimPos100 Is Nothing Then
If (Not oGI100 Is Nothing) And (Not oGI101 Is Nothing) Then
Set oLDim100 = oGenDims.AddLinear(oDimPos100, oGI100, oGI101, kAlignedDimensionType)
End If
End If
'dim MM
If Not oDimPos101 Is Nothing Then
If (Not oGI102 Is Nothing) And (Not oGI103 Is Nothing) Then
Set oLDim101 = oGenDims.AddLinear(oDimPos101, oGI102, oGI103, kAlignedDimensionType)
End If
End If
'dim CD
If Not oDimPos102 Is Nothing Then
If (Not oGI104 Is Nothing) And (Not oGI105 Is Nothing) Then
Set oLDim102 = oGenDims.AddLinear(oDimPos102, oGI104, oGI105, kAlignedDimensionType)
End If
End If
'dim A
If Not oDimPos103 Is Nothing Then
If (Not oGI101 Is Nothing) And (Not oGI103 Is Nothing) Then
Set oLDim103 = oGenDims.AddLinear(oDimPos103, oGI101, oGI103, kAlignedDimensionType)
End If
End If
'dim WF
If Not oDimPos104 Is Nothing Then
If (Not oGI102 Is Nothing) And (Not oGI106 Is Nothing) Then
Set oLDim104 = oGenDims.AddLinear(oDimPos104, oGI102, oGI106, kAlignedDimensionType)
End If
End If
'dim VE
If Not oDimPos105 Is Nothing Then
If (Not oGI104 Is Nothing) And (Not oGI106 Is Nothing) Then
Set oLDim105 = oGenDims.AddLinear(oDimPos105, oGI104, oGI106, kAlignedDimensionType)
End If
End If
End Sub
Private Function WithinTol(Value1 As Double, Value2 As Double, Tol As Double) As Boolean
Math.Abs (Value1 - Value2) < Tol
End Function
Why I cannot get the vertical linear curve have length 1.28 cm in my drawing, I go wrong from the first curve???????????
I feel my proficiency improved a lot with the current project, more than 1700 lines of code now.
But when I do dimensions for drawing, it's is just like impossible thing??????
Someone who already make dimension for a difficult drawing, please answer this question: "Normal or Hard or Very Hard or Impossible??????"
I've waited for few days, but it seem no Autodesk guys stop by.................so sad!
I got something currently to solve this problem.........but I wonder how to add the Ø symbol
oDDim100.Text.FormattedText = "Ø" & oDDim100.Text.FormattedText
and the result is
How can I put the symbol Ø into the dimension text?
You can use AIGDT font to the FormattedText to show symbols:
<StyleOverride Font='AIGDT' Bold='False'>n</StyleOverride>
Amazing!
Could you please give me the materials for some special symbol in Format Text? I cannot find out where I can read them.
For instance: DimensionValue, SectionViewName, etc........
I got a problem in dimension that is I cannot use GeneralDimensions.AddLinear to dimension between a centerline and a line curve
'oCLine100 is the center line, oLCurve100 is the line curve. Two lines is parallel. oDimPos is the point 2d
Dim oGI100, oGI101 As GeometryIntent
Set oGI100 = oSheet.CreateGeometryIntent(oLCurve100)
Set oGI101 = oSheet.CreateGeometryIntent(oCLine100)
Dim oLDim100 As LinearGeneralDimension
Set oLDim100 = oSheet.DrawingDimensions.GeneralDimensions.AddLinear(oDimPos100, oGI100, oGI101, kDiametricDimensionType)
Please help me to figure out what goes wrong in the code????
This GeneralDimensions.AddLinear() is really terrible. It make my Inventor crash down more than 15 time per day........... although I use "On Error Resume Next" before the code line or not.
Sometimes, the problem shows out like this following figure:
But sometimes, Inventor crash down like this
For average 30 minutes for one crash like this. If I use the GeneralDimensions.AddLinear 3 or 4 times, it crash down immediately.
Autodesk men, please check out, I am tired of crash and reopen Inventor and crash and reopen..................................so annoyed
If you can find out the solution, please make the hot-fix for it!!!!!!!!!!!
In API help, you can search the topic titled "XML Tags for FormattedText" to understand more details about FomattedText.
Can you attach a data to reproduce the failure for adding the diametric linear dimension?
Sorry, but it is the company properties, I don't have the permission to attach.......
But I really DO NOT understand why.
First,
I change the code to dimension for two line segment curves, which is only different in Y position, every else is same.
Then I create the Center Line by two kStartPoint of two lines, it worked
This means that these two GeometryIntent are right. Then the AddLinear() not work with these two GeometryIntent
If I don't create CenterLine AddLinear also didn't work!!!!!!! Run two or three time, Inventor crashs down........
---> Unbelievable
Then, I change to the most simple case. I get two geometry intent that is the StartPoint and EndPoint of a line curve.
AddLinear didn't work too. What happens??????????
Do you believe this?????
In two case, I change the color and weight of curves, and it work well---> this means that the curves is not nothing and they are right!
So, assuming that I don't understand and I write wrong code?????? Why Inventor crashes??????????? Today, I got more than 20 crashes, it is really irritated.
I know that this sounds stupid, but it was. Now I will try to make a sample to test and send for you........
I just create a simple test, it can work, and the List of Properties/Methods can work also
In my macro, even I press Ctrl+J, it not work??????
Or the wrong thing happens because my code is too long???????????????
About 3000 lines and will be 5000 lines if I can use AddLinear to dimension the drawing..................
How I can solve this problem???? Please help!!!!
If the data is protected, can you create another simple sample to reproduce the issue which you think is safe to attach? Or you can try to select a line segment curve on a drawing, and then run below VBA code to check if it works:
Sub CreateLinearDiametricDim() Dim oDoc As DrawingDocument Set oDoc = ThisApplication.ActiveDocument Dim oCurve As DrawingCurve Set oCurve = oDoc.SelectSet(1).Parent Dim oIntent1 As GeometryIntent, oIntent2 As GeometryIntent Set oIntent1 = oDoc.ActiveSheet.CreateGeometryIntent(oCurve, kStartPointIntent) Set oIntent2 = oDoc.ActiveSheet.CreateGeometryIntent(oCurve, kEndPointIntent) Dim oDim As LinearGeneralDimension Dim oPt As Point2d Set oPt = ThisApplication.TransientGeometry.CreatePoint2d(12, 12) Set oDim = oDoc.ActiveSheet.DrawingDimensions.GeneralDimensions.AddLinear(oPt, oIntent1, oIntent2, kDiametricDimensionType) End Sub
As the issue for display the List of Properties/Methods, can you check if there are two subs which have the same name in the module/class?
I just think to new solution that doesn't need to dimension automatic by VBA anymore.
Maybe in my next project, we will discuss more. Thank you so much!
I have a question about DrawingView:
How I can Delete the oBaseView but still exist the oIsoView????
If we do this manually, we can choose No when a prompt appear and ask us to Delete Projected Views or not
But I don't see any option in DrawingView.Delete() method.
Sorry for me,
I just try and only the obaseview is deleted; the isoview still be there. It's no need to do anything else, thanks IV for this!
Hi nttoan8187
I'm not really good with ilogic, maybe you can help me?
I just want to create a automatique isoview of my base you with ilogic, do you have a idea for the rule?
Thanks for your help 🙂
Can't find what you're looking for? Ask the community or share your knowledge.