Hello,
I create rule which copy all old drawing to new template.
The rule copies everything into the current template except the hole table (i know it's impossible by API) but the origin indicator is copied to the new drawing so I think it isn't possible to create new hole table by API.
I need help in creating a rule that finds a drawing view with a origin indicator, selects this drawing view and creates hole tables for it.
The position of the newly generated table will be set to the upper left corner of the drawing frame.
On screen cast you can see my rule in action and below my code:
Dim oDoc As DrawingDocument oDoc = ThisApplication.ActiveDocument Dim oSheet As Sheet oSheet = oDoc.ActiveSheet Dim invCustomPropertySet As PropertySet invCustomPropertySet = oDoc.PropertySets.Item("Inventor User Defined Properties") On Error Resume Next Dim NAZWAWL As String NAZWAWL = invCustomPropertySet.Item("NAZWA").Value 'MessageBox.Show(NAZWAWL, "Odczyt nazwy") If Err.Number <> 0 Then ' Failed to get the property, which means it doesn't exist ' so we'll create it. Call invCustomPropertySet.Add("", "NAZWA") Else End If 'MessageBox.Show(NAZWAWL, "Odczyt nazwy") 'odczyt wielkości arkusza Dim Size As DrawingSheetSizeEnum Size = oSheet.Size 'odczyt orientacji arkusza Orient = OSheet.Orientation 'odczyt nazwy If iProperties.Value("Summary", "Title")<> "" Then Nazwa_rys = iProperties.Value("Summary", "Title") Else Nazwa_rys=NAZWAWL End If oDoc.SelectSet.Clear ' Select all drawing views Dim oView As DrawingView For Each oView In oDoc.ActiveSheet.DrawingViews oDoc.SelectSet.Select(oView) Next Dim oCopyCmd As ControlDefinition oCopyCmd = ThisApplication.CommandManager.ControlDefinitions.Item("AppCopyCmd") oCopyCmd.Execute oDoc.SelectSet.Clear Dim oTargetDoc As DrawingDocument oTargetDoc = ThisApplication.Documents.Open("C:\Standard.idw", True) oTargetDoc.Activate Dim oTargetSheet As Sheet oTargetSheet = oTargetDoc.ActiveSheet oTargetSheet.Size = Size oTargetSheet.Orientation = Orient Dim oPasteCmd As ControlDefinition oPasteCmd = ThisApplication.CommandManager.ControlDefinitions.Item("AppPasteCmd") oPasteCmd.Execute If oTargetSheet.Size = 9997 And oTargetSheet.Orientation = 10243 Then oTargetDoc.ActiveSheet.Name = "A4 PIONOWO" ThisApplication.ActiveView.Fit Else If oTargetSheet.Size = 9997 And oTargetSheet.Orientation = 10242 Then oTargetDoc.ActiveSheet.Name = "A4 POZIOMO" ThisApplication.ActiveView.Fit Else If oTargetSheet.Size = 9996 And oTargetSheet.Orientation = 10243 Then oTargetDoc.ActiveSheet.Name = "A3 PIONOWO" ThisApplication.ActiveView.Fit Else If oTargetSheet.Size = 9996 And oTargetSheet.Orientation = 10242 Then oTargetDoc.ActiveSheet.Name = "A3 POZIOMO" ThisApplication.ActiveView.Fit Else If oTargetSheet.Size = 9995 And oTargetSheet.Orientation = 10243 Then oTargetDoc.ActiveSheet.Name = "A2 PIONOWO" ThisApplication.ActiveView.Fit Else If oTargetSheet.Size = 9995 And oTargetSheet.Orientation = 10242 Then oTargetDoc.ActiveSheet.Name = "A2 POZIOMO" ThisApplication.ActiveView.Fit Else If oTargetSheet.Size = 9994 And oTargetSheet.Orientation = 10243 Then oTargetDoc.ActiveSheet.Name = "A1 PIONOWO" ThisApplication.ActiveView.Fit Else If oTargetSheet.Size = 9994 And oTargetSheet.Orientation = 10242 Then oTargetDoc.ActiveSheet.Name = "A1 POZIOMO" ThisApplication.ActiveView.Fit Else If oTargetSheet.Size = 9993 And oTargetSheet.Orientation = 10243 Then oTargetDoc.ActiveSheet.Name = "A0 PIONOWO" ThisApplication.ActiveView.Fit Else If oTargetSheet.Size = 9993 And oTargetSheet.Orientation = 10242 Then oTargetDoc.ActiveSheet.Name = "A0 POZIOMO" ThisApplication.ActiveView.Fit End If Dim oNOWYDoc As DrawingDocument: oNOWYDoc = oTargetDoc Dim WLASCNOWEGO As PropertySet WLASCNOWEGO = oNOWYDoc.PropertySets.Item("Inventor User Defined Properties") WLASCNOWEGO.Item("NAZWA").Value = Nazwa_rys Arkusz=oNOWYDoc.Sheets.Item(1) 'aktualizacja danych Dim oControlDef as ControlDefinition = ThisApplication.CommandManager.ControlDefinitions.Item("UpdateCopiedModeliPropertiesCmd") oControlDef.Execute2(True) 'REGUŁA DLA ZAPISU If Arkusz.DrawingViews.Count <> 0 Then PNazwa=Arkusz.DrawingViews.Item(1).ReferencedFile.FullFileName 'MessageBox.Show(PNazwa, "Title") Pozycja=InStrRev(PNazwa,"\", -1) NazwaModelu=Right(PNazwa,Len(PNazwa)- Pozycja) scieżkaRysunki = ThisDoc.WorkspacePath()& "\" & "Rysunki" 'MessageBox.Show(scieżkaRysunki, "scieżka") If (Not System.IO.Directory.Exists(scieżkaRysunki))Then System.IO.Directory.CreateDirectory(scieżkaRysunki) End If NumerCzesci=iProperties.Value(NazwaModelu, "Project", "Part Number") 'MessageBox.Show(NumerCzesci, "Title") Plik=scieżkaRysunki & "\" & NumerCzesci & ".idw" 'MessageBox.Show(Plik, "PLIK") oDoc.Close(False) On Error Resume Next'Goto ZAPISZ' oNOWYDoc.SaveAs(Plik, False) 'REGUŁA DLA NAZWY RYSUNKU iProperties.Value("Custom", "NAZWA")= iProperties.Value(NazwaModelu, "Project", "Part Number") InventorVb.DocumentUpdate() 'If WLASCNOWEGO.Item("NAZWA").Value = "" 'TYTUL = InputBox("PODAJ NAZWĘ ELEMENTU", "NAZWA RYSUNKU", WLASCNOWEGO.Item("NAZWA").Value) 'WLASCNOWEGO.Item("NAZWA").Value= TYTUL 'InventorVb.DocumentUpdate() 'Else 'End If 'aktualizacja danych oControlDef.Execute2(True) i = GoExcel.FindRow("BOM.xls", "Arkusz1", "Numer części", "=", iProperties.Value("Project", "Part Number")) iProperties.Value("Custom", "SZTUKI") = GoExcel.CurrentRowValue("ILOŚĆ") InventorVb.DocumentUpdate() 'REGUŁA DLA NAZWY RYSUNKU TYTUL = InputBox("PODAJ NAZWĘ ELEMENTU", "NAZWA RYSUNKU", iProperties.Value("Custom", "NAZWA")) iProperties.Value("Custom", "NAZWA")= TYTUL InventorVb.DocumentUpdate() 'aktualizacja danych oControlDef.Execute2(True) End If
Can you help me with code to create hole table ??
Thanks in advance,
ralfmj
Solved! Go to Solution.
Solved by chandra.shekar.g. Go to Solution.
Hello,
File in attachment.
standard.idw - template
Part.ipt - part and part.idw. drawing for part
Thanks in advance,
ralfmj
Hoping that below iLogic code may be helpful.
Dim oDoc As DrawingDocument oDoc = ThisApplication.ActiveDocument Dim oSheet As Sheet oSheet = oDoc.ActiveSheet Dim invCustomPropertySet As PropertySet invCustomPropertySet = oDoc.PropertySets.Item("Inventor User Defined Properties") On Error Resume Next Dim NAZWAWL As String NAZWAWL = invCustomPropertySet.Item("NAZWA").Value 'MessageBox.Show(NAZWAWL, "Odczyt nazwy") If Err.Number <> 0 Then ' Failed to get the property, which means it doesn't exist ' so we'll create it. Call invCustomPropertySet.Add("", "NAZWA") Else End If 'MessageBox.Show(NAZWAWL, "Odczyt nazwy") 'odczyt wielkości arkusza Dim Size As DrawingSheetSizeEnum Size = oSheet.Size 'odczyt orientacji arkusza Orient = oSheet.Orientation 'odczyt nazwy If iProperties.Value("Summary", "Title")<> "" Then Nazwa_rys = iProperties.Value("Summary", "Title") Else Nazwa_rys = NAZWAWL End If oDoc.SelectSet.Clear ' Select all drawing views Dim oView As DrawingView For Each oView In oDoc.ActiveSheet.DrawingViews oDoc.SelectSet.Select(oView) Next Dim oPt As Point2d oPt = ThisApplication.TransientGeometry.CreatePoint2d(oSheet.HoleTables.Item(1).Position.X,oSheet.HoleTables.Item(1).Position.Y ) Dim oCopyCmd As ControlDefinition oCopyCmd = ThisApplication.CommandManager.ControlDefinitions.Item("AppCopyCmd") oCopyCmd.Execute oDoc.SelectSet.Clear Dim oTargetDoc As DrawingDocument oTargetDoc = ThisApplication.Documents.Open("D:\Chandra\Autodesk Cases\Inventor\Sep-2019\15742647\SAMPLE\Standard.idw", True) oTargetDoc.Activate Dim oTargetSheet As Sheet oTargetSheet = oTargetDoc.ActiveSheet oTargetSheet.Size = Size oTargetSheet.Orientation = Orient Dim oPasteCmd As ControlDefinition oPasteCmd = ThisApplication.CommandManager.ControlDefinitions.Item("AppPasteCmd") oPasteCmd.Execute If oTargetSheet.Size = 9997 And oTargetSheet.Orientation = 10243 Then oTargetDoc.ActiveSheet.Name = "A4 PIONOWO" ThisApplication.ActiveView.Fit Else If oTargetSheet.Size = 9997 And oTargetSheet.Orientation = 10242 Then oTargetDoc.ActiveSheet.Name = "A4 POZIOMO" ThisApplication.ActiveView.Fit Else If oTargetSheet.Size = 9996 And oTargetSheet.Orientation = 10243 Then oTargetDoc.ActiveSheet.Name = "A3 PIONOWO" ThisApplication.ActiveView.Fit Else If oTargetSheet.Size = 9996 And oTargetSheet.Orientation = 10242 Then oTargetDoc.ActiveSheet.Name = "A3 POZIOMO" ThisApplication.ActiveView.Fit Else If oTargetSheet.Size = 9995 And oTargetSheet.Orientation = 10243 Then oTargetDoc.ActiveSheet.Name = "A2 PIONOWO" ThisApplication.ActiveView.Fit Else If oTargetSheet.Size = 9995 And oTargetSheet.Orientation = 10242 Then oTargetDoc.ActiveSheet.Name = "A2 POZIOMO" ThisApplication.ActiveView.Fit Else If oTargetSheet.Size = 9994 And oTargetSheet.Orientation = 10243 Then oTargetDoc.ActiveSheet.Name = "A1 PIONOWO" ThisApplication.ActiveView.Fit Else If oTargetSheet.Size = 9994 And oTargetSheet.Orientation = 10242 Then oTargetDoc.ActiveSheet.Name = "A1 POZIOMO" ThisApplication.ActiveView.Fit Else If oTargetSheet.Size = 9993 And oTargetSheet.Orientation = 10243 Then oTargetDoc.ActiveSheet.Name = "A0 PIONOWO" ThisApplication.ActiveView.Fit Else If oTargetSheet.Size = 9993 And oTargetSheet.Orientation = 10242 Then oTargetDoc.ActiveSheet.Name = "A0 POZIOMO" ThisApplication.ActiveView.Fit End If Dim oNOWYDoc As DrawingDocument: oNOWYDoc = oTargetDoc Dim WLASCNOWEGO As PropertySet WLASCNOWEGO = oNOWYDoc.PropertySets.Item("Inventor User Defined Properties") WLASCNOWEGO.Item("NAZWA").Value = Nazwa_rys Arkusz=oNOWYDoc.Sheets.Item(1) 'aktualizacja danych Dim oControlDef As ControlDefinition = ThisApplication.CommandManager.ControlDefinitions.Item("UpdateCopiedModeliPropertiesCmd") oControlDef.Execute2(True) 'REGUŁA DLA ZAPISU If Arkusz.DrawingViews.Count <> 0 Then PNazwa=Arkusz.DrawingViews.Item(1).ReferencedFile.FullFileName 'MessageBox.Show(PNazwa, "Title") Pozycja=InStrRev(PNazwa,"\", -1) NazwaModelu=Right(PNazwa,Len(PNazwa)- Pozycja) scieżkaRysunki = ThisDoc.WorkspacePath()& "\" & "Rysunki" 'MessageBox.Show(scieżkaRysunki, "scieżka") If (Not System.IO.Directory.Exists(scieżkaRysunki))Then System.IO.Directory.CreateDirectory(scieżkaRysunki) End If NumerCzesci=iProperties.Value(NazwaModelu, "Project", "Part Number") 'MessageBox.Show(NumerCzesci, "Title") Plik= "D:\Chandra\Autodesk Cases\Inventor\Sep-2019\15742647\"&scieżkaRysunki & "\" & NumerCzesci & ".idw" 'MessageBox.Show(Plik, "PLIK") oDoc.Close(False) On Error Resume Next'Goto ZAPISZ' oNOWYDoc.SaveAs(Plik, False) oSheet = oNOWYDoc.ActiveSheet oSheet.HoleTables.Add(oNOWYDoc.ActiveSheet.DrawingViews.Item(1), oPt) 'REGUŁA DLA NAZWY RYSUNKU iProperties.Value("Custom", "NAZWA")= iProperties.Value(NazwaModelu, "Project", "Part Number") InventorVb.DocumentUpdate() 'If WLASCNOWEGO.Item("NAZWA").Value = "" 'TYTUL = InputBox("PODAJ NAZWĘ ELEMENTU", "NAZWA RYSUNKU", WLASCNOWEGO.Item("NAZWA").Value) 'WLASCNOWEGO.Item("NAZWA").Value= TYTUL 'InventorVb.DocumentUpdate() 'Else 'End If 'aktualizacja danych oControlDef.Execute2(True) i = GoExcel.FindRow("BOM.xls", "Arkusz1", "Numer części", "=", iProperties.Value("Project", "Part Number")) iProperties.Value("Custom", "SZTUKI") = GoExcel.CurrentRowValue("ILOŚĆ") InventorVb.DocumentUpdate() 'REGUŁA DLA NAZWY RYSUNKU TYTUL = InputBox("PODAJ NAZWĘ ELEMENTU", "NAZWA RYSUNKU", iProperties.Value("Custom", "NAZWA")) iProperties.Value("Custom", "NAZWA")= TYTUL InventorVb.DocumentUpdate() 'aktualizacja danych oControlDef.Execute2(True) End If
Thanks and regards,
@chandra.shekar.g - thanks but I find one problem !!!
For my better understanding - you add :
Dim oPt As Point2d oPt = ThisApplication.TransientGeometry.CreatePoint2d(oSheet.HoleTables.Item(1).Position.X,oSheet.HoleTables.Item(1).Position.Y )
For creating X,Y position of Hole Table
and :
oSheet = oNOWYDoc.ActiveSheet oSheet.HoleTables.Add(oNOWYDoc.ActiveSheet.DrawingViews.Item(1), oPt)
for add hole table to Drawing View 1 but in case when hole table is for the third, fourth drawing view this solution does not work.
Could you look at how to identify the view for which the hole table was prepared and copy it ??
In attachment you find example drawing.
Many thanks in advance,
Regards,
ralfmj
Try below code for any drawing view.
Dim oDoc As DrawingDocument oDoc = ThisApplication.ActiveDocument Dim oSheet As Sheet oSheet = oDoc.ActiveSheet Dim invCustomPropertySet As PropertySet invCustomPropertySet = oDoc.PropertySets.Item("Inventor User Defined Properties") On Error Resume Next Dim NAZWAWL As String NAZWAWL = invCustomPropertySet.Item("NAZWA").Value 'MessageBox.Show(NAZWAWL, "Odczyt nazwy") If Err.Number <> 0 Then ' Failed to get the property, which means it doesn't exist ' so we'll create it. Call invCustomPropertySet.Add("", "NAZWA") Else End If 'MessageBox.Show(NAZWAWL, "Odczyt nazwy") 'odczyt wielkości arkusza Dim Size As DrawingSheetSizeEnum Size = oSheet.Size 'odczyt orientacji arkusza Orient = oSheet.Orientation 'odczyt nazwy If iProperties.Value("Summary", "Title")<> "" Then Nazwa_rys = iProperties.Value("Summary", "Title") Else Nazwa_rys = NAZWAWL End If oDoc.SelectSet.Clear ' Select all drawing views Dim oView As DrawingView For Each oView In oDoc.ActiveSheet.DrawingViews oDoc.SelectSet.Select(oView) Next Dim cnt As Integer cnt = 0 Dim oPt As Point2d If oSheet.HoleTables.Count >= 1 Then For Each oView In oDoc.ActiveSheet.DrawingViews cnt = cnt + 1 If oView Is oSheet.HoleTables.Item(1).ParentView Then Exit For End If Next oPt = ThisApplication.TransientGeometry.CreatePoint2d(oSheet.HoleTables.Item(1).Position.X, oSheet.HoleTables.Item(1).Position.Y) End If Dim oCopyCmd As ControlDefinition oCopyCmd = ThisApplication.CommandManager.ControlDefinitions.Item("AppCopyCmd") oCopyCmd.Execute oDoc.SelectSet.Clear Dim oTargetDoc As DrawingDocument oTargetDoc = ThisApplication.Documents.Open("D:\Chandra\Autodesk Cases\Inventor\Sep-2019\15742647\SAMPLE\Standard.idw", True) oTargetDoc.Activate Dim oTargetSheet As Sheet oTargetSheet = oTargetDoc.ActiveSheet oTargetSheet.Size = Size oTargetSheet.Orientation = Orient Dim oPasteCmd As ControlDefinition oPasteCmd = ThisApplication.CommandManager.ControlDefinitions.Item("AppPasteCmd") oPasteCmd.Execute If oTargetSheet.Size = 9997 And oTargetSheet.Orientation = 10243 Then oTargetDoc.ActiveSheet.Name = "A4 PIONOWO" ThisApplication.ActiveView.Fit Else If oTargetSheet.Size = 9997 And oTargetSheet.Orientation = 10242 Then oTargetDoc.ActiveSheet.Name = "A4 POZIOMO" ThisApplication.ActiveView.Fit Else If oTargetSheet.Size = 9996 And oTargetSheet.Orientation = 10243 Then oTargetDoc.ActiveSheet.Name = "A3 PIONOWO" ThisApplication.ActiveView.Fit Else If oTargetSheet.Size = 9996 And oTargetSheet.Orientation = 10242 Then oTargetDoc.ActiveSheet.Name = "A3 POZIOMO" ThisApplication.ActiveView.Fit Else If oTargetSheet.Size = 9995 And oTargetSheet.Orientation = 10243 Then oTargetDoc.ActiveSheet.Name = "A2 PIONOWO" ThisApplication.ActiveView.Fit Else If oTargetSheet.Size = 9995 And oTargetSheet.Orientation = 10242 Then oTargetDoc.ActiveSheet.Name = "A2 POZIOMO" ThisApplication.ActiveView.Fit Else If oTargetSheet.Size = 9994 And oTargetSheet.Orientation = 10243 Then oTargetDoc.ActiveSheet.Name = "A1 PIONOWO" ThisApplication.ActiveView.Fit Else If oTargetSheet.Size = 9994 And oTargetSheet.Orientation = 10242 Then oTargetDoc.ActiveSheet.Name = "A1 POZIOMO" ThisApplication.ActiveView.Fit Else If oTargetSheet.Size = 9993 And oTargetSheet.Orientation = 10243 Then oTargetDoc.ActiveSheet.Name = "A0 PIONOWO" ThisApplication.ActiveView.Fit Else If oTargetSheet.Size = 9993 And oTargetSheet.Orientation = 10242 Then oTargetDoc.ActiveSheet.Name = "A0 POZIOMO" ThisApplication.ActiveView.Fit End If Dim oNOWYDoc As DrawingDocument: oNOWYDoc = oTargetDoc Dim WLASCNOWEGO As PropertySet WLASCNOWEGO = oNOWYDoc.PropertySets.Item("Inventor User Defined Properties") WLASCNOWEGO.Item("NAZWA").Value = Nazwa_rys Arkusz=oNOWYDoc.Sheets.Item(1) 'aktualizacja danych Dim oControlDef As ControlDefinition = ThisApplication.CommandManager.ControlDefinitions.Item("UpdateCopiedModeliPropertiesCmd") oControlDef.Execute2(True) 'REGUŁA DLA ZAPISU If Arkusz.DrawingViews.Count <> 0 Then PNazwa=Arkusz.DrawingViews.Item(1).ReferencedFile.FullFileName 'MessageBox.Show(PNazwa, "Title") Pozycja=InStrRev(PNazwa,"\", -1) NazwaModelu=Right(PNazwa,Len(PNazwa)- Pozycja) scieżkaRysunki = ThisDoc.WorkspacePath()& "\" & "Rysunki" 'MessageBox.Show(scieżkaRysunki, "scieżka") If (Not System.IO.Directory.Exists(scieżkaRysunki))Then System.IO.Directory.CreateDirectory(scieżkaRysunki) End If NumerCzesci=iProperties.Value(NazwaModelu, "Project", "Part Number") 'MessageBox.Show(NumerCzesci, "Title") Plik= "D:\Chandra\Autodesk Cases\Inventor\Sep-2019\15742647\"&scieżkaRysunki & "\" & NumerCzesci & ".idw" 'MessageBox.Show(Plik, "PLIK") oDoc.Close(False) On Error Resume Next'Goto ZAPISZ' oNOWYDoc.SaveAs(Plik, False) oSheet = oNOWYDoc.ActiveSheet If cnt > 0 Then oSheet.HoleTables.Add(oNOWYDoc.ActiveSheet.DrawingViews.Item(cnt), oPt) End If 'REGUŁA DLA NAZWY RYSUNKU iProperties.Value("Custom", "NAZWA")= iProperties.Value(NazwaModelu, "Project", "Part Number") InventorVb.DocumentUpdate() 'If WLASCNOWEGO.Item("NAZWA").Value = "" 'TYTUL = InputBox("PODAJ NAZWĘ ELEMENTU", "NAZWA RYSUNKU", WLASCNOWEGO.Item("NAZWA").Value) 'WLASCNOWEGO.Item("NAZWA").Value= TYTUL 'InventorVb.DocumentUpdate() 'Else 'End If 'aktualizacja danych oControlDef.Execute2(True) i = GoExcel.FindRow("BOM.xls", "Arkusz1", "Numer części", "=", iProperties.Value("Project", "Part Number")) iProperties.Value("Custom", "SZTUKI") = GoExcel.CurrentRowValue("ILOŚĆ") InventorVb.DocumentUpdate() 'REGUŁA DLA NAZWY RYSUNKU TYTUL = InputBox("PODAJ NAZWĘ ELEMENTU", "NAZWA RYSUNKU", iProperties.Value("Custom", "NAZWA")) iProperties.Value("Custom", "NAZWA")= TYTUL InventorVb.DocumentUpdate() 'aktualizacja danych oControlDef.Execute2(True) End If
Thanks and regards,
@chandra.shekar.g - thank you very much !!
Thanks for your time which you wasted on it.
Work like I wished.
Regards,
ralfmj
Hi @chandra.shekar.g ,
I still wanted to return to the topic related to this rule.
I would like to copy additional custom iproperities (if they exist). All or - if it's easier - like on picture below:
Is it possible and possibly how do I put this in my code ??
Thanks in advance,
Regards,
ralfmj
Hi @chandra.shekar.g ,
I would like to copy the properties from the old drawing to the new one.
Iproperities which you can see on picture it's a "old drawing" properties. You can see it on example file 🙂
Thanks in advance,
Regards,
ralfmj
Hi @chandra.shekar.g ,
You are right - I asked the wrong question. 😐
I meant not copying the properties themselves but their values.
I apologize for this - do you understand what I mean now ?
Can you help with that??
Thanks in advance,
Cheers,
ralfmj
Unfortunately no 😉
Please look on gif and sample part.
Thanks in advance,
Regards,
ralfmj
Can't find what you're looking for? Ask the community or share your knowledge.