Macro to export Solidworks Part to dxf - vba

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.

Related

LibreOffice Writer API - Cursors and text selection / replacement from VB6

I have been attempting to replace Office OLE in a vb6 application with LibreOffice.
I have had some success, however, I am falling short trying to search for text, then create a cursor based on the text that was found, then insert an image at that cursors point in the document.
I have been able to piece together working code that will allow me to search for text, replace text and insert an image, however, I cannot seem to figure out how to create a cursor that will allow me to insert an image at the pace where the text is that I have found . In the provided example, the [PICTUREPLACEHOLDER] text in the document.
Has anyone ever done this before and do they have any suggestions how I can create a cursor that will allow me to specify where the image will be inserted.
I have included the code for the VB6 test app so you can see the source code to see how its currently working.
Any suggestions would be very much appreciated.
Please Note - this is experimental code - very rough and ready - not final code by a long shot - just trying to figure out how this works with LibreOffice Writer.
To run this, you will need to create an empty vb6 app with a button.
You also need LibreOffice installed.
Many thanks
Rod.
Sub firstOOoProc()
Dim oSM 'Root object for accessing OpenOffice from VB
Dim oDesk, oDoc As Object 'First objects from the API
Dim arg() 'Ignore it for the moment !
'Instanciate OOo : this line is mandatory with VB for OOo API
Set oSM = CreateObject("com.sun.star.ServiceManager")
'Create the first and most important service
Set oDesk = oSM.createInstance("com.sun.star.frame.Desktop")
Dim oProvider As Object
Set oProvider = oSM.createInstance("com.sun.star.graphic.GraphicProvider")
'Open an existing doc (pay attention to the syntax for first argument)
Set oDoc = oDesk.loadComponentFromURL("file:///c:/dev/ooo/testfile.doc", "_blank", 0, arg())
' now - replace some text in the document
Dim Txt
Txt = oDoc.GetText
Dim TextCursor
TextCursor = Txt.CreateTextCursor
' attempt to replace some text
Dim SearchDescriptor
Dim Replace
Replace = oDoc.createReplaceDescriptor
Replace.SearchString = "[TESTDATA1]"
Replace.ReplaceString = "THIS IS A TEST"
oDoc.replaceAll Replace
Dim searchCrtiteria
SearchDescriptor = oDoc.createReplaceDescriptor
' Now - attempt try to replace some text with an image
SearchDescriptor.setSearchString ("[PICTUREPLACEHOLDER]")
SearchDescriptor.SearchRegularExpression = False
Dim Found
Found = oDoc.findFirst(SearchDescriptor)
' create cursor to know where to insert the image
Dim oCurs As Object
Set thing = oDoc.GetCurrentController
Set oCurs = thing.GetViewCursor
' make hte call to insert an image from a file into the document
InsertImage oDoc, oCurs, "file:///c:/dev/ooo/imagefilename.jpg", oProvider
'Save the doc
Call oDoc.storeToURL("file:///c:/dev/ooo/test2.sxw", arg())
'Close the doc
oDoc.Close (True)
Set oDoc = Nothing
oDesk.Terminate
Set oDesk = Nothing
Set oSM = Nothing
End Sub
Function createStruct(strTypeName)
Set classSize = objCoreReflection.forName(strTypeName)
Dim aStruct
classSize.CreateObject aStruct
Set createStruct = aStruct
End Function
Sub InsertImage(ByRef oDoc As Object, ByRef oCurs As Object, sURL As String, ByRef oProvider As Object)
' Init variables and instance object
Dim oShape As Object
Dim oGraph As Object
Set oShape = oDoc.createInstance("com.sun.star.drawing.GraphicObjectShape")
Set oGraph = oDoc.createInstance("com.sun.star.text.GraphicObject")
'Set oProvider = serviceManager.CreateInstance("com.sun.star.graphic.GraphicProvider")
' Add shape to document
oDoc.getDrawPage.Add oShape
' Set property path of picture
Dim oProps(0) As Object
Set oProps(0) = MakePropertyValue("URL", sURL)
' Get size from picture to load
Dim oSize100thMM
Dim lHeight As Long
Dim lWidth As Long
Set oSize100thMM = RecommendGraphSize(oProvider.queryGraphicDescriptor(oProps))
If Not oSize100thMM Is Nothing Then
lHeight = oSize100thMM.Height
lWidth = oSize100thMM.Width
End If
' Set size and path property to shape
oShape.graphic = oProvider.queryGraphic(oProps)
' Copy shape in graphic object and set anchor type
oGraph.graphic = oShape.graphic
oGraph.AnchorType = 1 'com.sun.star.Text.TextContentAnchorType.AS_CHARACTER
' Remove shape and resize graphix
Dim oText As Object
Set oText = oCurs.GetText
oText.insertTextContent oCurs, oGraph, False
oDoc.getDrawPage.Remove oShape
If lHeight > 0 And lWidth > 0 Then
Dim oSize
oSize = oGraph.Size
oSize.Height = lHeight * 500
oSize.Width = lWidth * 500
oGraph.Size = oSize
End If
End Sub
'
'Converts a Ms Windows local pathname in URL (RFC 1738)
'Todo : UNC pathnames, more character conversions
'
Public Function ConvertToUrl(strFile) As String
strFile = Replace(strFile, "\", "/")
strFile = Replace(strFile, ":", "|")
strFile = Replace(strFile, " ", "%20")
strFile = "file:///" + strFile
ConvertToUrl = strFile
End Function
'
'Creates a sequence of com.sun.star.beans.PropertyValue s
'
Public Function MakePropertyValue(cName, uValue) As Object
Dim oStruct, oServiceManager As Object
Set oServiceManager = CreateObject("com.sun.star.ServiceManager")
Set oStruct = oServiceManager.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
oStruct.Name = cName
oStruct.Value = uValue
Set MakePropertyValue = oStruct
End Function
'
'A simple shortcut to create a service
'
Public Function CreateUnoService(strServiceName) As Object
Dim oServiceManager As Object
Set oServiceManager = CreateObject("com.sun.star.ServiceManager")
Set CreateUnoService = oServiceManager.createInstance(strServiceName)
End Function
Public Function RecommendGraphSize(oGraph)
Dim oSize
Dim lMaxW As Double
Dim lMaxH As Double
lMaxW = 6.75 * 2540
lMaxH = 9.5 & 2540
If IsNull(oGraph) Or IsEmpty(oGraph) Then
Exit Function
End If
oSize = oGraph.Size100thMM
If oSize.Height = 0 Or oSize.Width = 0 Then
oSize.Height = oGraph.SizePixel.Height * 2540# * Screen.TwipsPerPixelY() '/ 1440
oSize.Width = oGraph.SizePixel.Width * 2540# * Screen.TwipsPerPixelX() '/ 1440
End If
If oSize.Height = 0 Or oSize.Width = 0 Then
Exit Function
End If
If oSize.Width > lMaxW Then
oSize.Height = oSizeHeight * lMax / oSize.Width
oSize.Width = lMaxW
End If
If oSize.Height > lMaxH Then
oSize.Width = oSize.Width * lMaxH / oSize.Height
oSize.Height = lMaxH
End If
RecommendGraphSize = oSize
End Function
Private Sub Command1_Click()
firstOOoProc
End Sub
The content of the testFile.Doc file is as shown below:
This is a test File
[TESTDATA1]
[PICTUREPLACEHOLDER]
It looks like you need to move the view cursor to the found location.
Found = oDoc.findFirst(SearchDescriptor)
oVC = oDoc.getCurrentController().getViewCursor()
oVC.gotoRange(Found, False)
oVC.setString("")

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/

Save model from drawing

I have VBA code to issue drawings. It allows properties of the model to be changed, issue, date of issue etc.
The idea is to open the drawing, update issue, date, etc. (save as pdf and dwg). It works, properties changed, and saves the correct view.
The property changes are not saved to the model, unless I open the model and force a save, hence when I reopen the drawing/model they revert to the old.
How can I force a save of the model, even if it is not open?
See last few lines for my attempt:
Sub WriteModelProperties(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2)
Dim element As Integer
Dim boolstatus As Boolean
Dim ctrl As MSForms.Control
Dim fieldName As String
Dim fieldType As Integer
Dim fieldValue As String
For element = 0 To 25
fieldName = propertiesValue(0, element)
Select Case propertiesValue(1, element)
Case "Text": fieldType = 30
Case "Date": fieldType = 64
End Select
Set ctrl = UserForm1.Controls(propertiesValue(2, element)) 'to make a compact code
Select Case propertiesValue(3, element)
Case "Caption": fieldValue = ctrl.Caption
Case "Value": fieldValue = ctrl.Value
End Select
Debug.Print fieldValue
boolstatus = swCustProp.Add3(fieldName, fieldType, fieldValue, swCustomPropertyDeleteAndAdd)
Next element
swModel.Rebuild (swRebuildAll)
swModel.EditRebuild3 ' Update model properties
swModel.ViewZoomtofit2
boolstatus = swModel.Save3(swSaveAsOptions_Silent, lErrors, lWarnings)
End Sub
Sorry ... tad bit of egg on my face ... it didnt work had to split parts and assemblies :(
This appears to work ... my apologies if its an insult to vba.
You only need to open the drawing, not the part or assembly :) Sorry couldn't resist.
Option Explicit
Public swApp As SldWorks.SldWorks
Public swModDoc As SldWorks.ModelDoc2
Dim swView As SldWorks.View
Dim swPart As PartDoc
Dim swAss As AssemblyDoc
Dim boolstatus As Boolean
Dim lErrors As Long 'Varaible to collect Errors
Dim lWarnings As Long 'Varaible to collect Errors
Sub main()
Set swApp = Application.SldWorks
Set swModDoc = swApp.ActiveDoc
Set swView = swModDoc.GetFirstView
Set swView = swView.GetNextView
If swView.ReferencedDocument.GetType = 1 Then
Set swPart = swView.ReferencedDocument
boolstatus = swPart.Save3(swSaveAsOptions_Silent, lErrors, lWarnings)
ElseIf swView.ReferencedDocument.GetType = 2 Then
Set swAss = swView.ReferencedDocument
boolstatus = swAss.Save3(swSaveAsOptions_Silent, lErrors, lWarnings)
End If
End Sub

Saving all parts in an assembly as STEP with custom properties. How to solve run-time error 91?

I'm trying to write a macro with VBA in Solidworks that will go through all the sub assemblies and save every part as STEP-file where the name is determined by a custom property. I don't have a lot of programming experience as I'm an mechanical engineer but I try to automate some processes from time to time. Most of this code I got from others and I tried to tweak it to my situation. I do understand most of what is happening though.
The problem I'm having is that I keep getting a
91 runtime error
When I go to debugging Solidworks tells me the problem is in the line name = swPart.GetTitle. At first it said "name = nothing". I tried looking for the problem and when i added Set swApp = Application.SldWorks to the sub I still got the error but now name is always something.
Dim swApp As SldWorks.SldWorks
Dim swAssy As SldWorks.AssemblyDoc
Dim swConf As SldWorks.Configuration
Dim swRootComp As SldWorks.Component2
Dim retVal As Boolean
Dim errors As Long, warnings As Long
Dim revision As String
Dim vaultPath As String
Dim name As String
Dim longstatus As Long, longwarnings As Long
Sub main()
Set swApp = Application.SldWorks
Set swAssy = swApp.ActiveDoc
Set swConf = swAssy.GetActiveConfiguration
Set swRootComp = swConf.GetRootComponent3(True)
vaultPath = "C:\Users\Engineering\Desktop\test\" 'set folder for vault (change this later)
TraverseComponent swRootComp, 1, vaultPath
End Sub
Sub TraverseComponent(swComp As SldWorks.Component2, nLevel As Long, vaultPath As String)
Dim vChilds As Variant, vChild As Variant
Dim swChildComp As SldWorks.Component2
Dim MyString As String
Dim swCustPropMgr As SldWorks.CustomPropertyManager
Set swApp = Application.SldWorks
vChilds = swComp.GetChildren
For Each vChild In vChilds
Set swChildComp = vChild
Dim FileName As String
FileName = swChildComp.GetPathName
FileName = Left(FileName, InStr(FileName, ".") - 1)
FileName = Right(FileName, Len(FileName) - InStrRev(FileName, "\"))
Debug.Print "Part Name : " & FileName
MyString = FileName
Dim ActiveConfig As String
ActiveConfig = swChildComp.ReferencedConfiguration
Debug.Print "Configuration: " & ActiveConfig
FileName = swChildComp.GetPathName
If UCase(Right(FileName, 6)) = "SLDPRT" Then
'MsgBox ("part found")
Dim swPart As SldWorks.ModelDoc2
Set swPart = swApp.OpenDoc6(swChildComp.GetPathName, 1, 0, "", longstatus, longwarnings)
'Dim name As String 'I tried adding this but it made no difference
name = swPart.GetTitle 'get the title of the active document
'chop the extension off if present
If Right(name, 7) = ".SLDPRT" Or Right(name, 7) = ".SLDasm" Then
name = Left(name, Len(name) - 7)
End If
Set swCustPropMgr = swPart.Extension.CustomPropertyManager("") 'get properties
revision = swCustPropMgr.Get("Revision") 'get revision
retVal = swApp.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swStepAP, 214) 'change the step file options
'save with revision if present
If revision = "" Or revision = Null Then
retVal = swPart.Extension.SaveAs(vaultPath & name & ".step", swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, Nothing, errors, warnings)
Else
retVal = swPart.Extension.SaveAs(vaultPath & name & " - Rev " & revision & ".step", swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, Nothing, errors, warnings)
End If
swApp.CloseDoc swPart.GetTitle
End If
Debug.Print
TraverseComponent swChildComp, nLevel + 1, vaultPath
Next
End Sub
A suppressed component is not the only reason why you could get a "nothing" after calling OpenDoc. This happens e.g. if the component is loaded lightweight or is otherwise not fully loaded. Then you are also not able to get the ModelDoc (PartDoc) data of a component object.
To prevent this completely you could execute the next lines only if the swPart variable is not nothing.
If (Not swPart Is Nothing) Then
name = swPart.GetTitle 'get the title of the active document
...
End If
Additionally I can say you don't necessarily need to use OpenDoc/CloseDoc because the component is already loaded into memory when the assembly is loaded. Therefore it is enough to call GetModelDoc2 of the child component. But in the end it has the same behaviour and will return nothing if the component is not fully loaded.
set swPart = swChildcomp.GetModelDoc2()

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

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.