CATIA-VBA error: Function or interface marked restricted ... automation type not supported in Visual Basic - vba

I've recorded a line creation in a VBA macro file, and it generated the following code:
Sub CATMain()
Dim partDocument1 As PartDocument
Set partDocument1 = CATIA.ActiveDocument
Dim part1 As Part
Set part1 = partDocument1.Part
Dim bodies1 As Bodies
Set bodies1 = part1.Bodies
Dim body1 As Body
Set body1 = bodies1.Item("PartBody")
Dim sketches1 As Sketches
Set sketches1 = body1.Sketches
Dim originElements1 As OriginElements
Set originElements1 = part1.OriginElements
Dim reference1 As Reference
Set reference1 = originElements1.PlaneYZ
Dim sketch1, sketch1Variant As Sketch *
Set sketch1 = sketches1.Add(reference1)
Dim arrayOfVariantOfDouble1(8)
arrayOfVariantOfDouble1(0) = 0#
...
arrayOfVariantOfDouble1(8) = 1#
Set sketch1Variant = sketch1
sketch1Variant.SetAbsoluteAxisData **
arrayOfVariantOfDouble1
part1.InWorkObject = sketch1
Dim factory2D1 As Factory2D
Set factory2D1 = sketch1.OpenEdition()
Dim geometricElements1 As GeometricElements
Set geometricElements1 = sketch1.GeometricElements
Dim axis2D1 As Axis2D
Set axis2D1 = geometricElements1.Item("AbsoluteAxis")
Dim line2D1 As Line2D
Set line2D1 = axis2D1.GetItem("HDirection")
line2D1.ReportName = 1
Dim line2D2 As Line2D
Set line2D2 = axis2D1.GetItem("VDirection")
line2D2.ReportName = 2
Dim point2D1 As Point2D
Set point2D1 = factory2D1.CreatePoint(21.285706, -30.501825)
point2D1.ReportName = 3
Dim point2D2 As Point2D
Set point2D2 = factory2D1.CreatePoint(112.826553, -68.875053)
point2D2.ReportName = 4
Dim line2D3 As Line2D
Set line2D3 = factory2D1.CreateLine(21.285706, -30.501825, 112.826553, -68.875053)
line2D3.ReportName = 5
line2D3.StartPoint = point2D1
line2D3.EndPoint = point2D2
sketch1.CloseEdition
part1.InWorkObject = body1
part1.Update
End Sub
Now
The issue is that when i run the code as is after recording I get the following error:
Error in loading dll.
Than I add sketch1Variant object at line * and run the code again.
This time I get the
"Function or interface marked restricted, or the function uses an automation type not supported in Visual Basic" error for line **.
I don't know what's wrong.
Any info is highly appreciated.
Thank you in advance.

The basic rule is this: When using VBA, any CATIA method which takes an array as an argument, or returns through an argument must be called on a variant object.
You have declared Sketch1Variant as Sketch. And SetAbsoluteAxisData takes an array as an argument.
What you want is this:
Dim Sketch1 as Sketch
Dim Sketch1Variant as Variant
(or just leave the "as variant" part off).
With this change you should be able to get past your problem.
In the future please do a web search first, because this is a VERY common question. coe.org is a good site to search.

Related

Macro to export Solidworks Part to dxf

I want to export my part as dxf as part of a macro. I tried recording it, but when I execute the recording it runs into erroors (see below). Thus I took it to the internet and tried the answer provided to this question
"Macro for Saving Solidworks part configurations as dxf files",
but it doesn't seem to work for me either.
I have tried exporting to other formats, such as step, xt and stl, which all work flawlessly. The macro for dxf export though executes without any errors, but it also does not export/save anything.
Trying to use this with Solidworks2017
I have also tried to record my own macro but it stops at:
Set myView = Part.CreateDrawViewFromModelView3(Part, "*Oben", 0, 0, 0)
with the errormsg:
Runtime error '438': object does not support this property or method.
here the recorded macro in full:
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Dim COSMOSWORKSObj As Object
Dim CWAddinCallBackObj As Object
Set CWAddinCallBackObj = swApp.GetAddInObject("CosmosWorks.CosmosWorks")
Set COSMOSWORKSObj = CWAddinCallBackObj.COSMOSWORKS
Dim FilePath As String
Dim PathSize As Long
Dim PathNoExtention As String
Dim NewFilePath As String
FilePath = Part.GetPathName
PathSize = Strings.Len(FilePath)
PathNoExtention = Strings.Left(FilePath, PathSize - 6)
NewFilePath = PathNoExtention & "dxf"
' Save As
longstatus = Part.SaveAs3(NewFilePath, 0, 0)
' Redraw
Part.GraphicsRedraw2
Set Part = swApp.ActiveDoc
Dim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameLeft = 0
myModelView.FrameTop = 22
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
Set Part = swApp.NewDocument("C:\ProgramData\SolidWorks\SOLIDWORKS 2017\templates\Zeichnung.drwdot", 0, 0, 0)
swApp.ActivateDoc2 "Zeichnung5 - Blatt1", False, longstatus
Set Part = swApp.ActiveDoc
Set Part = swApp.ActiveDoc
Set myModelView = Part.ActiveView
myModelView.FrameLeft = 0
myModelView.FrameTop = 0
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
swApp.ActivateDoc2 FilePath, False, longstatus
Set Part = swApp.ActiveDoc
Dim myView As Object
Set myView = Part.CreateDrawViewFromModelView3(Part, "*Oben", 0, 0, 0)
Set myView = Part.CreateDrawViewFromModelView3(Part, "*Normal auf", 0, 0, 0)
Part.ClearSelection2 True
Part.ClearSelection2 True
End Sub
Exporting to DXF (or DWG) is different to saving other formats from SolidWorks as you have found out. It's typically used to export flat patterns of sheet metal components.
ExportToDWG2 (IPartDoc) is the API method you need to call to export to either of these two formats. As per the docs it allows you to:
Saves various aspects of a part (sheet metal, faces, loops, and annotation views) to one or more DXF/DWG files'
As such how you use this call will vary based on what you want to export.
Sheet Metal
If you are exporting sheet metal, as per the example you linked, then you will output a flat pattern. However if you try to export sheet metal with a model that does not contain any sheet metal features then the result will be that the call returns false and nothing is output.
The following would be suitable for a sheet metal part:
Dim success As Boolean
success = swPart.ExportToDWG2(dxfFilePath, modelFilePath, swExportToDWG_e.swExportToDWG_ExportSheetMetal, True, Nothing, False, False, sheetMetalOptions, Nothing)
There is no enum in SolidWorks for the sheet metal options but here's one you could use:
Enum SheetMetalOptions_e
None = 0
Geometry = 1
HiddenEdges = 2
BendLines = 4
Sketches = 8
CoplanarFaces = 16
LibraryFeatures = 32
FormingTools = 64
BoundingBox = 2048
End Enum
Usage would be as follows:
' Export geometry, hidden edges and bend lines
Dim sheetMetalOptions As SheetMetalOptions_e
sheetMetalOptions = Geometry Or HiddenEdges Or BendLines
A full macro may look like the below:
Enum SheetMetalOptions_e
None = 0
Geometry = 1
HiddenEdges = 2
BendLines = 4
Sketches = 8
CoplanarFaces = 16
LibraryFeatures = 32
FormingTools = 64
BoundingBox = 2048
End Enum
Sub Main()
' Connect to SolidWorks
Dim swApp As SldWorks.SldWorks
Set swApp = Application.SldWorks
' Connect to the active model
Dim swModel As ModelDoc2
Set swModel = swApp.ActiveDoc
' Validate a model is open
If swModel Is Nothing Then
swApp.SendMsgToUser2 "Open a part to run this macro", swMessageBoxIcon_e.swMbStop, swMessageBoxBtn_e.swMbOk
Exit Sub
End If
' Validate the open model is a part document
If swModel.GetType <> swDocumentTypes_e.swDocPART Then
swApp.SendMsgToUser2 "This macro only runs on part documents", swMessageBoxIcon_e.swMbStop, swMessageBoxBtn_e.swMbOk
Exit Sub
End If
Dim swPart As PartDoc
Set swPart = swModel
' Build the new file path
Dim filePath As String
Dim pathSize As Long
Dim pathNoExtention As String
Dim newFilePath As String
filePath = swModel.GetPathName 'WARNING: this will be an empty string if the part document has not been saved
pathSize = Strings.Len(filePath)
pathNoExtention = Strings.Left(filePath, pathSize - 6) 'WARNING: this assumes the file extension is 6 characters (sldprt)
newFilePath = pathNoExtention & "dxf"
' Define sheet metal information to export
Dim sheetMetalOptions As SheetMetalOptions_e
sheetMetalOptions = Geometry Or HiddenEdges Or BendLines
' Export the DXF
Dim success As Boolean
success = swPart.ExportToDWG2(newFilePath, filePath, swExportToDWG_e.swExportToDWG_ExportSheetMetal, True, Nothing, False, False, 0, Nothing)
' Report success or failure to the user
If success Then
swApp.SendMsgToUser2 "The DXF was exported successfully", swMessageBoxIcon_e.swMbInformation, swMessageBoxBtn_e.swMbOk
Else
swApp.SendMsgToUser2 "Failed to export the DXF", swMessageBoxIcon_e.swMbStop, swMessageBoxBtn_e.swMbOk
End If
End Sub
Faces, Loops or Annotation Views
If your part does not contain sheet metal features then you will have to use one of the alternative export actions: Selected Faces or Loops or Annotation Views.
Annotation Views is supposed to let you pass in an array of view names (such as *Front or *Current) but in my experience it does not work reliably and I am aware that there are some SPRs open against this in SolidWorks.
Selected Faces or Loops requires you to pre-select a face or loop prior to calling ExportToDWG2, so you would have to write some code to determine which faces or loop you want to use and select it, then call ExportToDWG2 with the action parameter set to swExportToDWG_e.swExportToDWG_ExportSelectedFacesOrLoops.

Creating new sketch in a planar face

In CATIA, a new sketch can be created on a origin plane (XY, YZ, XZ) or a planar face of a object. I have a pad and want to take its top face as the support plane for the next pocket operation. I've strived to do it by the latter but without success due to the failure of Add method in Sketches collection. What was I wrong about?
Here are a piece of my code, which produces the error:
Dim reference3 As Reference
Set reference3 = product1.CreateReferenceFromName("Assembly_Two_Parts/Chi_Tiet_1.1/!Selection_RSur:(Face:(Brp:(Pad.1;0:(Brp:(Sketch.1;1)));None:();Cf11:());Pad.1_ResultOUT;Z0;G6937)")
Set Sketch2 = MyBody1.Sketches.Add(reference3)
Set MyFactory2 = Sketch2.OpenEdition()
Set Circle1 = MyFactory2.CreateClosedCircle(0, 0, 5)
Sketch2.CloseEdition
your string reference is not possible in automation... or you gonna have difficult.
If it can help you :
Sub CATMain()
Dim s ' as selection
Dim myProduct As Product
Dim myPart As Part
Dim myRef 'as reference
'selection of face
Set s = CATIA.ActiveDocument.Selection
s.Clear
Dim Filters(0)
Filters(0) = "PlanarBiDimInfinite" 'after the comment from Shrotter
Status = s.SelectElement2(Filters, "Select a face", True)
If (Status = "Cancel") Then Exit Sub
Set myRef = s.Item2(1).Value
'get your part
Set myProduct = s.Item2(1).LeafProduct
Set myPart = CATIA.Documents.Item(myProduct.PartNumber & ".CATPart").Part
s.Clear
'set your circle in sketch
myPart.InWorkObject = myPart.MainBody
Dim myCircle As Sketch
Set myCircle = myPart.MainBody.Sketches.Add(myRef)
Dim myCircle_ As Circle2D
Set myCircle_ = myCircle.OpenEdition.CreateClosedCircle(0, 0, 50)
'update your part
myPart.Update
End Sub
my website : https://www.catiavb.net/

Change variable type mysteriously

I have a sub with a variant variable set up that changes its type midway for now apparent reason.
I have the variables declared at the beginning of the procedure:
Dim acsp As Variant
Dim oldmaster As Variant
Dim acontacts As Variant
Dim avp As Variant
Dim acctst As Variant
Dim ashipto As Variant
Dim abillto As Variant
Dim found, found1, found2 As Boolean
acsp = Sheet6.UsedRange.Value2
acontacts = Sheet5.UsedRange.Value2
avp = Sheet9.UsedRange.Value2
acctst = Sheet20.UsedRange.Value2
ashipto = Sheet11.UsedRange.Value
abillto = Sheet15.UsedRange.Value
The code runs and based on an IF condition it might call this code (inside the same sub):
c = UBound(acsp) + 1
shipto = Trim(UCase(acctst(aa, 27)))
billto = Trim(UCase(acctst(aa, 38)))
shiptofound = False
For shiptorow = 2 To UBound(ashipto)
ashipto1 = Trim(UCase(ashipto(shiptorow, 2)))
If ashipto1 = shipto Then
shiptofound = True
Exit For
End If
Next shiptorow
Up until the shiptofound=False line the abillto variant is shown as variant/variant (1 to 677, 1 to 18) which is correct.
But as soon it runs the line For shiptorow = 2 To UBound(ashipto) then the abillto variant changes to a type variant/long with a value of 2?
At no point prior to this code abillto is used in the code.
Why does VBA do this?

VBA function cannot locate a bookmark

I am trying to call a REST web service in a VBA module to populate some bookmarks in a Word document. For some reason the code freezes at this line
Set cCap1 = ActiveDocument.Bookmarks("CCAP1").Range
cCap1.Text = keyResult.SelectSingleNode("//cCap").Text
saying that the bookmark "CCAP1" does not exist inside the document, when in fact is perfectly visible in the bookmarks list, as you see here
I checked the webservice and it returns a valid XML document which should not pose any problem.
Following you will find the complete VBA module code
Public Static Sub callRestService()
Dim idC As String
Dim custDate As String
Dim query As String
idC = mdlFormVal.getIdC
custDate = mdlFormVal.getCustDate
query = "http://path/to/webservice/service?key=" + idC
Dim keyResult As New MSXML2.DOMDocument60
Dim keyService As New MSXML2.XMLHTTP60
keyService.Open "GET", query, False
keyService.send
keyResult.LoadXML (keyService.responseText)
Dim cRas As Range
Dim cRas1 As Range
Dim cRas2 As Range
Dim cRas3 As Range
Dim cRas4 As Range
Dim cCap As Range
Dim cCap1 As Range
Dim cCap2 As Range
Dim cCf As Range
Dim cCf1 As Range
Dim cInd As Range
Dim cInd1 As Range
Dim cInd2 As Range
Dim cLoc As Range
Dim cLoc1 As Range
Dim cLoc2 As Range
Dim cPIva As Range
Dim cPIva1 As Range
Dim cPrvn As Range
Dim cPrvn1 As Range
Dim cPrvn2 As Range
Dim cusDate As Range
Set cRas = ActiveDocument.Bookmarks("CRAS").Range
cRas.Text = keyResult.SelectSingleNode("//cRas").Text
Set cRas1 = ActiveDocument.Bookmarks("CRAS1").Range
cRas1.Text = keyResult.SelectSingleNode("//cRas").Text
Set cRas2 = ActiveDocument.Bookmarks("CRAS2").Range
cRas2.Text = keyResult.SelectSingleNode("//cRas").Text
Set cRas3 = ActiveDocument.Bookmarks("CRAS3").Range
cRas3.Text = keyResult.SelectSingleNode("//cRas").Text
Set cRas4 = ActiveDocument.Bookmarks("CRAS4").Range
cRas4.Text = keyResult.SelectSingleNode("//cRas").Text
Set cCap = ActiveDocument.Bookmarks("CCAP").Range
cCap.Text = keyResult.SelectSingleNode("//cCap").Text
Set cCap1 = ActiveDocument.Bookmarks("CCAP1").Range
cCap1.Text = keyResult.SelectSingleNode("//cCap").Text
Set cCap2 = ActiveDocument.Bookmarks("CCAP2").Range
cCap2.Text = keyResult.SelectSingleNode("//cCap").Text
Set cCf = ActiveDocument.Bookmarks("CCF").Range
cCf.Text = keyResult.SelectSingleNode("//cCf").Text
Set cCf1 = ActiveDocument.Bookmarks("CCF1").Range
cCf1.Text = keyResult.SelectSingleNode("//cCf").Text
Set cInd = ActiveDocument.Bookmarks("CIND").Range
cInd.Text = keyResult.SelectSingleNode("//cInd").Text
Set cInd1 = ActiveDocument.Bookmarks("CIND1").Range
cInd1.Text = keyResult.SelectSingleNode("//cInd").Text
Set cInd2 = ActiveDocument.Bookmarks("CIND2").Range
cInd2.Text = keyResult.SelectSingleNode("//cInd").Text
Set cLoc = ActiveDocument.Bookmarks("CLOC").Range
cLoc.Text = keyResult.SelectSingleNode("//cLoc").Text
Set cLoc1 = ActiveDocument.Bookmarks("CLOC1").Range
cLoc1.Text = keyResult.SelectSingleNode("//cLoc").Text
Set cLoc2 = ActiveDocument.Bookmarks("CLOC2").Range
cLoc2.Text = keyResult.SelectSingleNode("//cLoc").Text
Set cPIva = ActiveDocument.Bookmarks("CPIVA").Range
cPIva.Text = keyResult.SelectSingleNode("//cPIva").Text
Set cPIva1 = ActiveDocument.Bookmarks("CPIVA1").Range
cPIva1.Text = keyResult.SelectSingleNode("//cPIva").Text
Set cPrvn = ActiveDocument.Bookmarks("CPRVN").Range
cPrvn.Text = keyResult.SelectSingleNode("//cPrvn").Text
Set cPrvn1 = ActiveDocument.Bookmarks("CPRVN1").Range
cPrvn1.Text = keyResult.SelectSingleNode("//cPrvn").Text
Set cPrvn2 = ActiveDocument.Bookmarks("CPRVN2").Range
cPrvn2.Text = keyResult.SelectSingleNode("cPrvn").Text
Set cusDate = ActiveDocument.Bookmarks("CUSTDATE").Range
cusDate.Text = custDate
End Sub
Has anyone ever encountered something like this?
Thank you for your time.
I managed to solve the issue, "simply" recreating all the document bookmarks.

Debugging in autocad VBA ide is not displaying where the error is

Whenever i am trying to debug or run the program and if it encounters error, the VBE (Autocad) doesn't display the line where the error is, unlike in other IDEs, it used to come at that line and highlight with yellow color. Also, the scroll doesn't work. I know i should install plugins but i am unable to help myself.
Option Explicit
Sub Test()
'Declarations
'Opened Document
Dim acDocu As AcadDocument
Set acDocu = ThisDrawing.Application.ActiveDocument
'Select on screen
Dim acSelectionSet As AcadSelectionSet
Set acSelectionSet = ThisDrawing.SelectionSets.Add("SjjEffffT")
acSelectionSet.SelectOnScreen
'Manipulating in loops for finding group names having objects selected
Dim entity As AcadEntity
Dim entityhandle() As String
Dim Grp As AcadGroup
Dim groupname() As String
Dim i As Integer
i = 0
Dim j As Integer
j = 0
Dim temp As Integer
temp = 0
Dim GrpEnt As AcadEntity
Dim grpenthandle As String
Dim entity_count As Integer
'Dim entity_array As Variant
entity_count = acSelectionSet.Count
ReDim entityhandle(entity_count)
ReDim groupname(entity_count)
For Each entity In acSelectionSet
'entity_array = entity
entityhandle(i) = entity.Handle
For Each Grp In ThisDrawing.groups
For Each GrpEnt In Grp
grpenthandle = GrpEnt.Handle
If entityhandle(i) = grpenthandle Then
If temp = 0 Then
groupname(j) = Grp.Name
Debug.Print "Group in selection:" & groupname(j)
j = j + 1
End If
End If
temp = temp + 1
Next
temp = 0
Next
i = i + 1
Next
'Copying the objects and pasting into new drawing
Dim acDocto As AcadDocument
Dim file_name As String
'file_name = InputBox("Enter the file name along with full path and extension")
file_name = "D:\PI_Tool_files_3223\D00440023new.DWG"
Set acDocto = Documents.Open(file_name)
Dim acObject As AcadObject
Dim retvalue As Variant
retvalue = acDocu.CopyObjects(entityhandle, acDocto.ModelSpace)
acSelectionSet.Delete
End Sub
The code is written above. But i think the problem is with the add-in as i can't debug.
The VBA IDE is pretty old (1998) and it has limited debugging abilities. You should stop using this, it's an obsolete technology, not actively supported by Microsoft/Autodesk anymore.
For some errors, it is not able to locate the line where the error occurred, and you're left with obscure error codes and useless messages.
Have you tried setting a breakpoint at the first possible line? (Set acDocu = ThisDrawing.Application.ActiveDocument)
Then step through to see the offending object/property/method.
It doesn't always work.
Can you load the code into a module, instead of "ThisDrawing", then debug?