Autor
|
Thema: Pickingpoint in MS-VBA (809 mal gelesen)
|
Macxsis Mitglied Ingenieur Fahrzeugtechnik
Beiträge: 21 Registriert: 09.10.2007 Dell Precision T3500 Catia V5 R19 Windows XP64
|
erstellt am: 25. Aug. 2010 08:30 <-- editieren / zitieren --> Unities abgeben:
Hallo zusammen, ich suche gerade die Funktion, mit der ich die Koordinaten von einem Pickingpoint auslesen kann, um sie dann weiter zu verarbeiten. Allerdings finde ich nirgendwo Hinweise, wie der Befehl lautet. Hat jemand damit schon einmal Erfahrungen gemacht? Bin für jede Antwort dankbar. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
| Techniker / Technischer Produktdesigner (m/w/d) für die Serienbetreuung | "BEREIT, TEIL EINES DYNAMISCHEN TEAMS ZU WERDEN, DAS DIE ZUKUNFT GESTALTET? GESUCHT WIRD EIN TECHNIKER O. TECHNISCHER PRODUKTDESIGNER (M/W/D) FÜR DIE SERIENBETREUUNG Willkommen bei der Verder Gruppe ? einem globalen Innovator in der Welt der Technik und Engineering! Bei uns stehst du im Mittelpunkt unserer wegweisenden Produkte, die in den Bereichen Labor- und Analysetechnik sowie in der industriellen Pumpenherstellung eingesetzt werden.... | Anzeige ansehen | Technischer Zeichner, Bauzeichner |
|
DanielFr. Moderator Manager
Beiträge: 2506 Registriert: 10.08.2005 HP Compaq 8710w, Intel Core Duo T7700, 2,40 Ghz, 3GB RAM, Windows XP Professionel @32bit, Quadro FX 1600M, CATIA V5 R19 SP3
|
erstellt am: 25. Aug. 2010 10:00 <-- editieren / zitieren --> Unities abgeben: Nur für Macxsis
Hallo , den PickingPoint bekommst du nur wenn du ein Objekt selektierst hast. IMHO ist es nicht möglich einen Klick in den Hintergrund abzufragen. Aber hier mal ein Makro das dir einen Punkt auf einem von dir selektierten Punkt (auf einem Objekt) erstellst. Code:
Option Explicit '----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- --------------------------------------------------------------------------- '-------------------------------------------------CreatePickingPoint v1.0------------------------------------------------------------------------------------------------------ 'Author: Daniel Frauenrath 'Mail: daniel.frauenrath@cedas.de 'Release: 25.08.2010 'Version: 1.0 ' '************************************************************************************************************************************************************************* '<<<<<<<<<<<<<<<<Beschreibung / Discription>>>>>>>>>>>>>>>>>>>> '************************************************************************************************************************************************************************** ' 'DE: Das Makro erstellt einen physikalischen Punkt auf den vom Anwender selektierten PickingPoint '\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ' 'EN: The macro creates as physical point on the coordinates witch or selected from user ' '************************************************************************************************************************************************************************* '<<<<<<<<<<<<<<<<Veraenderungen / Change log>>>>>>>>>>>>>>>>>>>> '************************************************************************************************************************************************************************** 'Autor: Datum: Zeile/Line: Modul / UserForm: Anmerkung/Remark: '-------------------------------------------------------------------------------------------------------------------------- ' ' ' '**************************************************************************************************************************************************** '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<Hauptmakro>>>>>>>>>& gt;>>>>>>>>>>>>>>>>>>>>>>> '****************************************************************************************************************************************************Sub CATMain() '***DEKLARATIONEN Dim intDocObj As Document Dim intPartObj As Part Dim intHybBodiesObj As HybridBodies Dim intHybBodyObj As HybridBody Dim intHybFacObj As HybridShapeFactory Dim intSelObj As Object Dim intSelEleObj As Object Dim intSelFilter(0) Dim intSelState As String Dim intPickPointArr(2) Dim intPointObj As Point Dim intGeoSetExistsBoo As Boolean Dim intPointCountStr As String '***OBJECTE INSTANZEIREN Set intDocObj = CATIA.ActiveDocument Set intPartObj = intDocObj.Part Set intHybBodiesObj = intPartObj.HybridBodies Set intHybFacObj = intPartObj.HybridShapeFactory '***SELECTIONSOBJECT ERSTELLEN UND LEEREN Set intSelObj = intDocObj.Selection intSelObj.Clear '***SELECTIONSFILTER EINSTELLEN intSelFilter(0) = "AnyObject" '***SELECTION EINES OBJEKTES intSelState = intSelObj.SelectElement2(intSelFilter, "Bitte Objekt wählen / ESC zum Abbrechen", False) If intSelState = "Normal" Then Set intSelEleObj = intSelObj.Item(1) Else MsgBox "Sie haben die Auswahl eines Objektes abgebrochen!" + vbNewLine + _ "Das Makro wird beendet", vbCritical, "ABBRUCH DURCH ANWENDER" Exit Sub End If '***KOORDINATEN DES SELEKTIERTEN PUNKTES LESEN intSelEleObj.GetCoordinates (intPickPointArr) '***GEOMETRISCHES SET HOLEN BZW. ERSTELLEN On Error Resume Next Set intHybBodyObj = intHybBodiesObj.Item("PickPoint") If Err.Number <> 0 Then Err.Clear Set intHybBodyObj = intHybBodiesObj.Add intHybBodyObj.Name = "PickPoint" intGeoSetExistsBoo = False Else intGeoSetExistsBoo = True End If On Error GoTo 0 '***NEUEN PUNKTE ERSTELLEN (KOORDINATENPUNKTE) intPointCountStr = CStr(GetPointSuffixFunc(intHybBodyObj)) Set intPointObj = intHybFacObj.AddNewPointCoord(intPickPointArr(0), intPickPointArr(1), intPickPointArr(2)) intHybBodyObj.AppendHybridShape intPointObj If intGeoSetExistsBoo = False Then intPointObj.Name = "PickPoint." & intPointCountStr Else intPointObj.Name = "PickPoint." & intPointCountStr End If '***PUNKT UPATEN intPartObj.UpdateObject intPointObj '***SELEKTION LEEREN UND OBJEKTE ZERSTÖREN intSelObj.Clear Set intDocObj = Nothing Set intPartObj = Nothing Set intHybBodiesObj = Nothing Set intHybFacObj = Nothing End Sub '***ZÄHLER AUSLESEN FÜR PUNKTNAMEN Private Function GetPointSuffixFunc(ByVal uebHybBody As HybridBody) As Integer GetPointSuffixFunc = uebHybBody.HybridShapes.Count + 1 End Function
------------------ MFG Daniel Systeminformation | Inoffizielle CATIA Hilfeseite | CATIA FAQ | Suche | TraceParts (Normteile...) | 3D Content Central (noch mehr Normteile...) Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
| Anzeige.:
Anzeige: (Infos zum Werbeplatz >>)
|