Autor
|
Thema: Länge einer 2D-Linie im Drawing (1077 mal gelesen)
|
Hokay Mitglied
Beiträge: 143 Registriert: 27.07.2004 Win7-Enterprice Catia V5 R24 SP1
|
erstellt am: 12. Mrz. 2009 08:34 <-- editieren / zitieren --> Unities abgeben:
Hallo Zusammen, ich habe eine recht einfache Frage, stehe selbst aber irgendwie auf dem Schlauch. Ich brauche via CATScript die Länge einer betimmten 2D-Linie (Drawing) z.B. "Linie.13" Grund ich muß eine Abfrage basteln. "wenn die Linie kürzer als 1 mm ist färbe sie Rot ein , anderenfalls lass es bleiben. Wie gesagt ich brauche nur die Länge der Linie, den Rest bekomme ich hin. MFG Heiko Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
DMaier Mitglied Key-User CAD/PLM/ERP
Beiträge: 182 Registriert: 09.04.2008
|
erstellt am: 12. Mrz. 2009 08:57 <-- editieren / zitieren --> Unities abgeben: Nur für Hokay
|
Hokay Mitglied
Beiträge: 143 Registriert: 27.07.2004 Win7-Enterprice Catia V5 R24 SP1
|
erstellt am: 12. Mrz. 2009 09:43 <-- editieren / zitieren --> Unities abgeben:
|
zoltan.bekesi Mitglied
Beiträge: 321 Registriert: 22.10.2006 Job: CATIA V5R19 / XP 32bit MS Office 2003 Microstation V8 2004 Edition DELL Precision M6300
|
erstellt am: 12. Mrz. 2009 18:24 <-- editieren / zitieren --> Unities abgeben: Nur für Hokay
Hallo Heiko, anbei eine Lösung. Es gilt nur für die selber gezeichneten Linien, Drawing geöffnet, auf aktueller Blatt und in der aktuellen Ansicht:
Code: Sub test() Dim oActDoc As DrawingDocument Set oActDoc = CATIA.ActiveDocument Dim oSheet As DrawingSheet Set oSheet = oActDoc.Sheets.ActiveSheet Dim oSel As Selection Set oSel = oActDoc.Selection Dim DrwViews As DrawingViews Set DrwViews = oSheet.Views Dim oView As DrawingView Set oView = DrwViews.ActiveView Dim oGeometricElements As GeometricElements Set oGeometricElements = oView.GeometricElements Dim oGeomElement As GeometricElement oSel.Clear For Each oGeomElement In oGeometricElements If oGeomElement.GeometricType = catGeoTypeLine2D Then Dim oStartPoint 'As Point2D Dim oEndPoint 'As Point2D Set oStartPoint = oGeomElement.StartPoint Set oEndPoint = oGeomElement.EndPoint Dim adStartPoint(1) Dim adEndPoint(1) oStartPoint.GetCoordinates adStartPoint oEndPoint.GetCoordinates adEndPoint Dim dLength As Double dLength = Sqr((adEndPoint(0) - adStartPoint(0)) ^ 2 + (adEndPoint(1) - adStartPoint(1)) ^ 2) MsgBox (dLength) If dLength <= 1 Then oSel.Add oGeomElement End If End If Next Dim oVisProperties As VisPropertySet If oSel.Count2 > 0 Then Set oVisProperties = oSel.VisProperties oVisProperties.SetRealColor 255, 0, 0, 0 End If oSel.Clear End Sub
Gruß, Zoltan Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
| NC-Programmierer Zerspanung/Entgraten (w/m/div.) | Möchten Sie Ihre Ideen in nutzbringende und sinnvolle Technologien verwandeln? Ob im Bereich Mobility Solutions, Consumer Goods, Industrial Technology oder Energy and Building Technology - mit uns verbessern Sie die Lebensqualität der Menschen auf der ganzen Welt. Willkommen bei Bosch. Die Robert Bosch GmbH freut sich auf Ihre Bewerbung! Anstellungsart: Unbefristet Arbeitszeit: ... | Anzeige ansehen | Automatisierungstechnik |
|
Hokay Mitglied
Beiträge: 143 Registriert: 27.07.2004 Win7-Enterprice Catia V5 R24 SP1
|
erstellt am: 13. Mrz. 2009 11:13 <-- editieren / zitieren --> Unities abgeben:
|