所以我的问题是我想编写一个宏,可以选择特定的几何集并进行分析,隐藏它们,拍摄图片,将此图片导出为ppt,回到CATIA隐藏所提到的地理集并显示另一个。
>另一点是,可能可以循环编程所有程序。
其他信息: -我知道每个地理集的名称和数量都不会改变。 -拍照和输出部分一样工作 -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,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,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,0
yoyo.ScaleWidth 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