Как выбрать геометрический набор в CATIA V5 R26 с помощью VBA? - PullRequest
0 голосов
/ 10 января 2020

, поэтому моя проблема в том, что я хочу написать макрос, который может выбрать определенные c геометрические наборы и анализ, скрыть их, сделать снимок, экспортировать этот pi c в ppt, go назад в CATIA скрыть упомянул геосет и покажу еще один.

Еще один момент заключается в том, что все это можно запрограммировать в oop.

Дополнительная информация: - Я знаю каждое название геосета и количество их не меняется. - Съемка работает так же, как экспортная часть - CATIA V5 R26

На данный момент это мой код:

Sub CATMain()

'Msg

Dim response
response = MsgBox ("Mit einem Klick auf OK beginnt das Makro seine Arbeit. Prüfen sie zuvor ob das Startmodell richtig befüllt ist.", vbOKCancel + vbInformation + vbDefaultButton2)
If response = vbOK Then

On Error resume next
Dim Window1
Set Window1 = CATIA.ActiveWindow
Dim WindowLayout1
WindowLayout1 = Window1.Layout
Window1.Layout = catWindowSpecsAndGeom
CATIA.StartCommand "CompassDisplayOn"

Else
Exit Sub
End If

##########################################
In here I want to select the geosets.
##########################################



On Error resume next
Catia.ActiveWindow.Viewers.item(1).CaptureToFile 1, "C:\Temp\temp_pic.jpg"
On error goto 0

' Set PowerPoint
Dim ppt
On Error Resume Next
Set ppt = GetObject (,"PowerPoint.Application")
If Err.Number = 0 Then
Err.Clear
Else
Set ppt = CreateObject("PowerPoint.Application")
PPT.Visible=True
Set Pres = PPT.Presentations.Open("G:\PowerPoint_template.pptx")

on error resume next
End If
Set uNewS = ppt.ActivePresentation.slides.Add(ppt.ActivePresentation.slides.count + 1 , 3)

If (err) then
Set uNewP = ppt.Presentations.Add(True)
ppt.Visible = true
ppt.windowstate = 2
Set uNewS = uNewP.slides.Add(uNewP.slides.count + 1 , 3)
else
Set uNewP = ppt.ActivePresentation
End if

On error goto 0

uNewS.Layout = 12
uuInput = 1
uPictureFormat = 0

call ppt.Windows.item(1).Activate
call pasteGraphic( ppt, uNewP, ab, uMultiGraph )

CATIA.ActiveWindow.ActiveViewer.FullScreen = false


End Sub



Set oDoc = CATIA.ActiveDocument
Set oCams = oDoc.Cameras
Set oCam = oCams.Item(2)
Set oViewPoint = oCam.Viewpoint3D
Set oSpecWindow = CATIA.ActiveWindow
Set oViewer = oSpecWindow.ActiveViewer
oViewer.Viewpoint3D = oViewPoint
oViewer.Reframe






Public Function pasteGraphic( ppt, uNewP, ab, uuInput )

ppt.ActiveWindow.view.GotoSlide(uNewP.slides.count)

fullname = "C:\Temp\temp_pic" & uuInput-1 & ".jpg"
If uuInput < 2 then fullname = "C:\Temp\temp_pic.jpg"

set oyoy = ppt.ActiveWindow.Selection.SlideRange.item(1).Master

ppt.ActiveWindow.Selection.SlideRange.Shapes.AddPicture(fullname, 0,1,65,68,1024,576).select

Set yoyo = ppt.ActiveWindow.Selection.ShapeRange.item(1)

yoyo.PictureFormat.Contrast = 0.5
yoyo.PictureFormat.Brightness = 0.5
yoyo.PictureFormat.ColorType = 1
yoyo.PictureFormat.TransparentBackground = 0
yoyo.Fill.Visible = 0
yoyo.Line.Visible = 0
yoyo.Rotation = 0
yoyo.PictureFormat.CropLeft = 0
yoyo.PictureFormat.CropRight = 0
yoyo.PictureFormat.CropTop = 0
yoyo.PictureFormat.CropBottom = 0
yoyo.LockAspectRatio = -1
yoyo.ScaleHeight 1, 1, 0
yoyo.ScaleWidth 1, 1, 0

yoyo.Width = oyoy.Width/3*2


'''''set distance from top and left side
yoyo.top = 150
yoyo.Left = 290
ppt.ActiveWindow.Selection.Unselect

'Back Spec and Compass
Dim Window1
Set Window1 = CATIA.ActiveWindow
Dim WindowLayout1
WindowLayout1 = Window1.Layout
Window1.Layout = catWindowSpecsAndGeom
CATIA.StartCommand "CompassDisplayOn"
On Error GoTo 0
Set PptObject = Nothing
Set Viewer1 = Nothing

''''''''''''''delete captured picture
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFile"C:\Temp\temp_pic.jpg"
Set fso = nothing


End Function

1 Ответ

2 голосов
/ 10 января 2020

Интерактивное выделение:

Dim fil(0)
fil(0) = "HybridBody"
Dim sel as Selection
Set sel = CATIA.ActiveDocument.Selection
Dim vSel as Variant
Set vSel = sel
ans = vSel.SelectElement2(fil,"Select a geo set",false)
if not ans = "Normal" Then exit sub
Dim oGS as HybridBody
Set oGS = sel.item(1).Value
...

Добавление чего-либо к выделению с помощью кода:

Dim oGS as HybridBody
Set oGS = ...
Dim sel as Selection
Set sel = CATIA.ActiveDocument.Selection 
sel.add oGS
...