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.
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/
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?
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.
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?