Hallo zusammen,
als Autodidakt versuche ich gerade, mir die Programmierung von NX-Journals anzueignen. Mit der VB-Syntax in MS Excel bin ich schon vertraut. Mit meinem vorhandenen Wissen habe ich einen Code geschrieben (siehe unten), der an jedes Mass einer Zeichnung einen Index (Dreieck) mit fortlaufender Nummer fügt und das Mass mit Toleranz in eine Excel-Vorlage (EMPB) überträgt.
Nun das Problem, für welches ich in diesem Forum noch keine Lösung gefunden habe: die automatisiert erstellten Indizes lassen sich nicht mehr von Hand verschieben. ich habe es schon mit "idSymbolBuilder1.Style.DisplayStyle.LockSizeAndPosition = False" versucht, jedoch ohne Erfolg. Auch die Verwendung eines anderen Arbeitslayers hat nicht funktioniert. Kennt ihr eine Lösung für dieses Problem?
Zusatzfrage: Die Platzierung der Symbole ("OffsetFactor") soll in Abhängigkeit der Mass-Ausrichtung (horizontal/vertikal) erfolgen. Besteht die Möglichkeit die Ausrichtung auszulesen und diese in einer Select-Case-Routine weiter zu verwenden? Bei Rückfragen stehe ich euch gerne zur Verfügung.
P. S.: Aufgrund der Firewall-Einstellungen kann ich den Code leider nicht als .txt-File posten.
' NX 11.0.2.7
' Journal created by hacklj on Thu Sep 20 15:47:49 2018 Mitteleuropäische Sommerzeit
Option Strict Off
Imports System
Imports NXOpen
Imports NXOpen.UF
Imports NXOpen.UI
Imports NXOpen.Annotations
Module NXJournal
Sub Main()
'Offsets from dimension text
Const XOffsetDim as Double = -2
Const YOffsetDim as Double = 0
'Offsets from notes
Const XOffsetNote as Double = -2
Const YOffsetNote as Double = 0
Const excelFileName As String = "H:\(12) Sonstige Tätigkeiten\2018-09-04_Template_AMPB\MQXL_ISIR_Template_(HJE) - Kopie.xlsm"
Dim myDimText() As String
Dim myDimDualText() As String
Dim myToleranceType As String
Dim myToleranceLower As String
Dim myToleranceUpper As String
'MS-Office Excel
Dim objExcel = CreateObject("Excel.Application")
Dim objWorkbook = objExcel.Workbooks.Open(excelFileName)
Dim dblTol As Double
Dim row As Long = 11
Dim column As Long = 1
Dim line As Long = 1
'Siemens NX
Dim theSession As Session = Session.GetSession()
Dim theUISession As UI = UI.GetUI
Dim workPart As Part = theSession.Parts.Work
Dim noteDim As Annotation
Dim noteDimOrigin as Point3D = Nothing
Dim symbolPref as SymbolPreferences = Nothing
Dim noteNumber As Integer = 1
Dim markId1 As Session.UndoMarkId = theSession.SetUndoMark(Session.MarkVisibility.Visible, "journal")
Dim theAnnotationManager as AnnotationManager = workPart.Annotations
Dim nullAnnotations_IdSymbol As Annotations.IdSymbol = Nothing
Dim idSymbolBuilder1 As Annotations.IdSymbolBuilder
Dim assocOrigin1 As Annotations.Annotation.AssociativeOriginData
Dim QC_IDSymbol As IDSymbol
markId1 = theSession.SetUndoMark(Session.MarkVisibility.Visible, "Start")
'Excel header
With objExcel
.Visible = True
'.Cells(1, 10) = workPart.FullPath
End With
'Excel dimension listing
On Error Resume Next
For Each myDimension As Annotations.Dimension In workPart.Dimensions
noteDimOrigin = myDimension.AnnotationOrigin
symbolPref = theAnnotationManager.Preferences.GetSymbolPreferences()
idSymbolBuilder1 = workPart.Annotations.IdSymbols.CreateIdSymbolBuilder(nullAnnotations_IdSymbol)
idSymbolBuilder1.Origin.Plane.PlaneMethod = Annotations.PlaneBuilder.PlaneMethodType.XyPlane
idSymbolBuilder1.Type = Annotations.IdSymbolBuilder.SymbolTypes.TriangleUp
idSymbolBuilder1.UpperText = noteNumber
idSymbolBuilder1.Size = symbolPref.IDSymbolSize '8.5
idSymbolBuilder1.Style.LetteringStyle.GeneralTextSize = symbolPref.IDSymbolSize / 3.2 '1.5
idSymbolBuilder1.Style.DisplayStyle.LockSizeAndPosition = False
With assocOrigin1
.OriginType = Annotations.AssociativeOriginType.OffsetFromText
.OffsetAnnotation = myDimension
.OffsetAlignmentPosition = Annotations.AlignmentPosition.TopLeft
If myDimension.GetType().ToString() = "NXOpen.Annotations.Note" Then
.XOffsetFactor = XOffsetNote
.YOffsetFactor = YOffsetNote
Else
.XOffsetFactor = XOffsetDim
.YOffsetFactor = YOffsetDim
End If
End With
idSymbolBuilder1.Origin.SetAssociativeOrigin(assocOrigin1)
QC_IDSymbol = idSymbolBuilder1.Commit
QC_IDSymbol.Layer = 1
idSymbolBuilder1.Destroy()
myDimension.GetDimensionText(myDimText, myDimDualText)
myToleranceType = myDimension.ToleranceType.ToString
If Not myDimText(0) = " " Then
objExcel.Sheets(4).Cells(row, column + 1) = Replace(myDimText(0), "<$s>", "")
Else
objExcel.Sheets(4).Cells(row, column + 1) = 0.1
End If
objExcel.Sheets(4).Cells(row, column + 2) = myToleranceType
objExcel.Sheets(4).Cells(row, column) = noteNumber
Select Case myDimension.ToleranceType
Case Is = Annotations.ToleranceType.UnilateralBelow
myToleranceLower = myDimension.LowerMetricToleranceValue.ToString
objExcel.Sheets(4).Cells(row, column + 4) = myToleranceLower
Case Is = Annotations.ToleranceType.LimitsAndFits
myToleranceLower = myDimension.LimitFitDeviation
myToleranceUpper = myDimension.LimitFitGrade
objExcel.Sheets(4).Cells(row, column + 3) = myToleranceLower & myToleranceUpper
Case Is = Annotations.ToleranceType.BilateralOneLine
myToleranceUpper = myDimension.UpperMetricToleranceValue.ToString
objExcel.Sheets(4).Cells(row, column + 3) = myToleranceUpper
objExcel.Sheets(4).Cells(row, column + 4) = myToleranceUpper
Case Is = Annotations.ToleranceType.BilateralTwoLines
myToleranceLower = myDimension.LowerMetricToleranceValue.ToString
myToleranceUpper = myDimension.UpperMetricToleranceValue.ToString
objExcel.Sheets(4).Cells(row, column + 4) = myToleranceLower
objExcel.Sheets(4).Cells(row, column + 3) = myToleranceUpper
Case Is = Annotations.ToleranceType.UnilateralAbove
myToleranceUpper = myDimension.UpperMetricToleranceValue.ToString
objExcel.Sheets(4).Cells(row, column + 3) = myToleranceUpper
Case Is = Annotations.ToleranceType.None
dblTol = CDbl(Replace(myDimText(0), "<$s>", ""))
dblTol = 0
Select Case dblTol
Case Is <= 6
myToleranceUpper = 0.1
myToleranceLower = 0.1
Case Is <= 15
myToleranceUpper = 0.15
myToleranceLower = 0.15
Case Is <= 30
myToleranceUpper = 0.2
myToleranceLower = 0.2
Case Is <= 70
myToleranceUpper = 0.3
myToleranceLower = 0.3
End Select
objExcel.Sheets(4).Cells(row, column + 3) = myToleranceUpper
objExcel.Sheets(4).Cells(row, column + 4) = myToleranceLower
End Select
noteNumber = noteNumber + 1
row = row + 1
Next myDimension
'For line = line To row
'If objExcel.Cells(line, column).Text = " " Then objExcel.Rows(line).EntireRow.Delete: line = line - 1
'Next Line
objWorkbook = Nothing
objExcel = Nothing
theSession.SetUndoMarkName(markId1, "Label Dimensions")
theSession.SetUndoMarkVisibility(markId1, Nothing, Session.MarkVisibility.Visible)
'lw.Close()
End Sub
Public Function GetUnloadOption(ByVal dummy As String) As Integer
GetUnloadOption = NXOpen.Session.LibraryUnloadOption.Immediately
End Function
End Module
------------------
Vielen Dank und freundliche Grüsse
Jens Hackl
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP