could anyone help me with the problem - I am creating a program to automatically fill in the title block in drawing. Unable to get the decimal value of the Scale of front view, I also can't get the used material of the given part weight. I still have the following source code. Thank you for all the answers!
Private Sub CommandButton1_Click()
Dim DrwDocument As DrawingDocument
Set DrwDocument = CATIA.ActiveDocument
Set DrwSheets = DrwDocument.Sheets
Set Selection = DrwDocument.Selection
Set DrwSheet = DrwSheets.ActiveSheet
Set DrwView = DrwSheet.Views.ActiveView
Set DrwTexts = CATIA.ActiveDocument.Sheets.ActiveSheet.Views.ActiveView.Texts
Dim oProduct As Product
Set oProduct = DrwView.GenerativeBehavior.Document
Dim parameters4 As Parameters
Set parameters4 = DrwDocument.Parameters
Dim realParam4 As Parameter
Set realParam4 = parameters4.Item("Sheet.1\ViewMakeUp.3\Scale")
Dim parametersX As Parameters
Set parametersX = DrwDocument.Parameters
Dim realXdir As Parameter
Set realXdir = parametersX.Item("Sheet.1\ViewMakeUp.3\X")
Dim parametersY As Parameters
Set parametersY = DrwDocument.Parameters
Dim realYdir As Parameter
Set realYdir = parametersY.Item("Sheet.1\ViewMakeUp.3\Y")
DrwView.Activate
If tbProjekt = "" Then
MsgBox ("Nevyplnené pole PROJEKT!")
Else
Set Projekt = DrwTexts.Add(tbProjekt.Text, (288 - realXdir.ValueAsString), (45.5 - realYdir.ValueAsString))
Projekt.AnchorPosition = catMiddleLeft
Projekt.SetFontName 0, 0, "Monospac821 BT"
Projekt.SetFontSize 0, 0, 3
End If
Set PocetKs = DrwTexts.Add(tbPocetKs.Text "x", (36 - realXdir.ValueAsString), (78 - realYdir.ValueAsString))
PocetKs.AnchorPosition = catMiddleLeft
PocetKs.SetFontName 0, 0, "Monospac821 BT"
PocetKs.SetFontSize 0, 0, 3
If OptionZrk = True Then
Set PocetKsZrk = DrwTexts.Add(tbPocetKs.Text "x", (36 - realXdir.ValueAsString), (68 - realYdir.ValueAsString))
PocetKsZrk.AnchorPosition = catMiddleLeft
PocetKsZrk.SetFontName 0, 0, "Monospac821 BT"
PocetKsZrk.SetFontSize 0, 0, 3
Set ZrkText = DrwTexts.Add("Zrkadlový", (103 - realXdir.ValueAsString), (68 - realYdir.ValueAsString))
ZrkText.AnchorPosition = catMiddleLeft
ZrkText.SetFontName 0, 0, "Arial (TrueType)"
ZrkText.SetFontSize 0, 0, 4
End If
Set Material = DrwTexts.Add(cbMaterial.Text, (288 - realXdir.ValueAsString), (37.5 - realYdir.ValueAsString))
Material.AnchorPosition = catMiddleLeft
Material.SetFontName 0, 0, "Monospac821 BT"
Material.SetFontSize 0, 0, 3
Set Mierka = DrwTexts.Add(realParam4.ValueAsString, (238 - realXdir.ValueAsString), (40 - realYdir.ValueAsString))
Mierka.AnchorPosition = catMiddleLeft
Mierka.SetFontName 0, 0, "Monospac821 BT"
Mierka.SetFontSize 0, 0, 3
Set DatumUpravy = DrwTexts.Add(tbDatum.Text, (355 - realXdir.ValueAsString), (38 - realYdir.ValueAsString))
DatumUpravy.AnchorPosition = catMiddleLeft
DatumUpravy.SetFontName 0, 0, "Monospac821 BT"
DatumUpravy.SetFontSize 0, 0, 3
Set CisloDielu = DrwTexts.Add(tbCisloDielu.Text, (314 - realXdir.ValueAsString), (14.5 - realYdir.ValueAsString))
CisloDielu.AnchorPosition = catMiddleLeft
CisloDielu.SetFontName 0, 0, "Monospac821 BT"
CisloDielu.SetFontSize 0, 0, 4
Set NazovDielu = DrwTexts.Add(tbNazovDielu.Text, (321 - realXdir.ValueAsString), (26 - realYdir.ValueAsString))
NazovDielu.AnchorPosition = catMiddleLeft
NazovDielu.SetFontName 0, 0, "Monospac821 BT"
NazovDielu.SetFontSize 0, 0, 4
Set Pozicia = DrwTexts.Add(tbPozicia.Text, (388 - realXdir.ValueAsString), (26 - realYdir.ValueAsString))
Pozicia.AnchorPosition = catMiddleLeft
Pozicia.SetFontName 0, 0, "Monospac821 BT"
Pozicia.SetFontSize 0, 0, 5
End Property
Private Sub UserForm_Initialize()
Dim DrwDocument As DrawingDocument
Set DrwDocument = CATIA.ActiveDocument
Set DrwSheets = DrwDocument.Sheets
Set Selection = DrwDocument.Selection
Set DrwSheet = DrwSheets.ActiveSheet
Set DrwView = DrwSheet.Views.ActiveView
Set DrwTexts = CATIA.ActiveDocument.Sheets.ActiveSheet.Views.ActiveView.Texts
Dim oProduct As Product
Set oProduct = DrwView.GenerativeBehavior.Document
Dim parameters4 As Parameters
Set parameters4 = DrwDocument.Parameters
Dim realParam4 As Parameter
Set realParam4 = parameters4.Item("Sheet.1\ViewMakeUp.3\Scale")
Dim datum As Date
datum = Now()
tbDatum.Text = Format(datum, "dd.mm.yyyy")
cbMaterial.AddItem "S355J2G3"
cbMaterial.AddItem "X5CrNi18-10"
cbMaterial.AddItem "PE1000-green"
tbMierka.Text = realParam4.ValueAsString
tbCisloDielu = (oProduct.PartNumber)
tbNazovDielu = (oProduct.Nomenclature)
Dim cProjektu As String
cProjektu = tbCisloDielu.value
tbProjekt.Text = Left(cProjektu, 6)
Dim parametersX As Parameters
Set parametersX = DrwDocument.Parameters
Dim realXdir As Parameter
Set realXdir = parametersX.Item("Sheet.1\ViewMakeUp.3\X")
Dim parametersY As Parameters
Set parametersY = DrwDocument.Parameters
Dim realYdir As Parameter
Set realYdir = parametersY.Item("Sheet.1\ViewMakeUp.3\Y")
tbPriecinok.Text = "D:\3D sro\Zákazky\2022\"
End Sub
CodePudding user response:
each view has a scale property:
dScale = DrwView.Scale2
(see also the DrawingView-Object in the documentation)
Instead of using the active view try:
Set oDrwViewForground = DrwSheet.Views.Item(1)
Set oDrwViewBackground = DrwSheet.Views.Item(2)
Set oDrwViewFrontview = DrwSheet.Views.Item(3) 'first user generated view