I have a issue regarding the constraints in Catia VBA, please look at the below code.
Sub catmain()
Dim CAT_documents As Documents
Set CAT_documents = CATIA.Documents
Dim prod_doc As ProductDocument
Set prod_doc = CATIA.ActiveDocument
Dim prod As Product
Set prod = prod_doc.Product
Call constraint_everything(prod)
End Sub
Sub constraint_everything(cProd As Product)
Dim constraints1 As Constraints
Set constraints1 = cProd.Connections("CATIAConstraints")
Dim temp As Product
If cProd.Products.Count > 0 Then
For i = 1 To cProd.Products.Count
Set temp = cProd.Products.Item(i)
Dim osel 'as Selection
Set osel = CATIA.ActiveDocument.Selection
'On Error Resume Next
osel.Clear
osel.Add temp
Dim dispname As String
dispname = osel.Item(1).Reference.DisplayName & "!" & osel.Item(1).Reference.DisplayName
Dim ref As Reference
Set ref = cProd.CreateReferenceFromName(dispname)
Dim constraint1 As Constraint
Set constraint1 = constraints1.AddMonoEltCst(catCstTypeReference, ref)
If (temp.Products.Count > 0) Then
Call constraint_everything(temp)
Else
End If
Next
Else
End If
End Sub
please check the below image.
here i am trying to constraint the product marked in RED but the below part is getting constrained.
i think this is because both have same Instance name. is there any thing which i can do to resolve this issue. Apart from changing the instance name which is integral to the structure.
Thanks.
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.
There is a more efficient method using the GetSelectedObjectCount() and GetSelectionPoint2() methods to obtain the points that can be used with SelectByID2 method. The issue of the method below is that creation of each point is not time efficient nor tidy in the feature tree. Will update this thread once I have time.
Thank you for understanding.
I recently started some programming in VBA in SolidWorks and I am looking to write a macro. The goal for now is to create a reference plane from selected face and point(deriving it from edge). As a reminder, method to create the reference plane is InsertRefPlane, which requires the selection to be done by SelectByID2 method.
So far I've managed to save the handle for the face and point objects, but I haven't managed to successfully use the SelectByID2 method. Objects that were selected become deselected.
value = instance.SelectByID2(Name, Type, X, Y, Z, Append, Mark, Callout, SelectOption)
I have tried select just a face, but I couldn't manage to do it. Also, I have renamed the face property using the SetEntityName method, and supplied it as well, but it did not manage to select it.
Could you please share the ideas how to do create a reference plane? It doesn't have to be necessary a face and an edge/mid-point.
Thank you in advance.
Edit 1:
For further clarification, I have added two objects (face and edge) to selection and I would like to use those to properly select objects with SelectByID2 to use for InsertRefPlane. I have added the code below.
Ideas that I have are:
I have handles to the face and the edge, but can I use those for proper selection with SelectByID2?
Can I create a reference points on the selected face and edge to identify the face somehow?
SelectByRay seems feasible, but it would require some calculations with face normals so, I would try some other "simpler" methods if available. Edit 2: I have non-planar face so I can't request Normal property of the face.
Edit 3: It seems that it all comes down to identifying an object name and type is the way to solve the problem. This is probably a solution, but I'm open for another one, easier if possible. We can create a reference points when using one of appropriate Selection methods, because their names are known, we can use those for SelectbyID2 method. Will post the solution once I am done.
Regarding the GetFaces/GetFirstFace/GetNextFace methods, InsertRefPlane requires objects to be selected by SelectByID2
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swPart As SldWorks.PartDoc
Dim swSelMgr As SldWorks.SelectionMgr
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swFeatMgr As SldWorks.FeatureManager
Dim selBool As Boolean
Dim longstatus As Long, longwarnings As Long
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swModelDocExt = swModel.Extension
Set swPart = swModel
Set swSelMgr = swModel.SelectionManager
Set swFeatMgr = swModel.FeatureManager
' Check which file is opened
Dim filePath As String: filePath = swModel.GetPathName()
Debug.Print "File path is:" & filePath
' User has to select the face and the edge of the body to create plane and
' sketch to convert face entities
' Gets selection from SelectionManager
Dim numSelectedObjs As Long
Dim selectionMark As Long: selectionMark = -1
numSelectedObjs = swSelMgr.GetSelectedObjectCount2(selectionMark)
Debug.Print "Number of selected objects:" & numSelectedObjs
Dim faceObj As SldWorks.Face2
Dim edgeObj As SldWorks.Edge
Dim midpointObj As Object
If (numSelectedObjs > 0) Then
' Get and validate selection
Dim selObj As Object
Dim selObjIndex As Long
Dim selObjType As Long
For selObjIndex = 1 To numSelectedObjs ' This method uses 1 as first index
selObjType = swSelMgr.GetSelectedObjectType3(selObjIndex, selectionMark)
' Check selected object type and assign it to appropriate variable
If (selObjType = SwConst.swSelFACES) Then
Set faceObj = swSelMgr.GetSelectedObject6(selObjIndex, selectionMark)
Dim faceFeat As Object
Set faceFeat = faceObj.GetFeature()
ElseIf (selObjType = SwConst.swSelEDGES) Then
Set edgeObj = swSelMgr.GetSelectedObject6(selObjIndex, selectionMark)
swModel.SelectMidpoint ' With this line, we add point to selection, increasing the count to 3
Dim deselVal As Long
deselVal = swSelMgr.DeSelect2(selObjIndex, selectionMark) ' Deselect the edge
Set midpointObj = swSelMgr.GetSelectedObject6(selObjIndex, selectionMark) ' Set the object to the point
Else
MsgBox "Wrong objects selected, select only face and edge"
Exit For
End If
Next
End If
' Create reference plane using face and a point
' InsertRefPlane method requires selection using SelectByID2 Method
Dim objName, objType As String: objName = "": objType = SwConst.swSelectType_e.swSelFACES
Dim X, Y, Z As Double: X = 0: Y = 0: Z = 0
Dim selAppend As Boolean: selAppend = True
Dim objMark As Long: objMark = 0
Dim objCallout As Callout
Dim selOption As swSelectOption_e: selOption = 0
selBool = swModel.Extension.SelectByID2(objName, objType, X, Y, Z, selAppend, objMark, objCallout, selOption)
Debug.Print selBool
The most of the details are in my question and the last edit is the how I solved it. The way to do it is to:
Obtain a handle to the object (such as face or edge) from the SelectionManager
Create an Entity object of the selected object, this allows you to use Select4 methods
Now you can create reference geometry, and you obtain the Name property which you can use with SelectByID2 method
I tried it out on another model, but can't guarantee it will work for you as well.
' PREREQUISITES:
' User has to select the face and the edge of the body to create plane and
' sketch to convert face entities to it
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swModelDocExt = swModel.Extension
Set swPart = swModel
Set swSelMgr = swModel.SelectionManager
Set swFeatMgr = swModel.FeatureManager
Set swSelData = swSelMgr.CreateSelectData
' Check which file is opened
Dim filePath As String: filePath = swModel.GetPathName()
Debug.Print "File path is:" & filePath
' Gets selection from SelectionManager
Dim numSelectedObjs As Long
Dim selectionMark As Long: selectionMark = -1
numSelectedObjs = swSelMgr.GetSelectedObjectCount2(selectionMark)
Debug.Print "Number of selected objects:" & numSelectedObjs
Dim faceObj As SldWorks.Face2
Dim edgeObj As SldWorks.Edge
Dim vEdges, vEdge As Variant
Dim nEdges As Long
Dim edgeEntityPairs(999), tempEdgeEntity(99, 99) As Variant
Dim loopObj As SldWorks.Loop2
Dim vLoops, vLoop As Variant
Dim nLoops, nLoop As Long
Dim counter(99) As Long
If (numSelectedObjs = 2) Then
' Get and validate selection
Dim selObj As Object
Dim selObjIndex As Long
Dim selObjType As Long
For selObjIndex = 1 To numSelectedObjs ' This method uses 1 as first index
selObjType = swSelMgr.GetSelectedObjectType3(selObjIndex, selectionMark)
Debug.Print "Selected obj type:" & selObjType
' Check selected object type and assign it to appropriate variable
If (selObjType = SwConst.swSelFACES) Then ' Face
Set faceObj = swSelMgr.GetSelectedObject6(selObjIndex, selectionMark)
Set faceEntity = faceObj
vLoops = faceObj.GetLoops()
nLoops = faceObj.GetLoopCount()
' This loop gets the each loop(SW) object and its edges
For Each vLoop In vLoops
' To do: Check if there's only single loop on the face
Set loopObj = vLoop
nEdges = loopObj.GetEdgeCount()
vEdges = loopObj.GetEdges()
For Each vEdge In vEdges
Set edgeObj = vEdge
Set tempEdgeEntity(nLoop, counter(nLoop)) = edgeObj
counter(nLoop) = counter(nLoop) + 1
Next
nLoop = nLoop + 1
Next
ElseIf (selObjType = SwConst.swSelEDGES) Then ' Edge
Set edgeObj = swSelMgr.GetSelectedObject6(selObjIndex, selectionMark)
Set edgeEntity = edgeObj
Else
MsgBox "Wrong type of objects selected, select only face and edge"
Exit For
End If
Next
Else
MsgBox "Wrong number of objects selected"
Stop
End If
'
swModel.ClearSelection2 (True)
Debug.Print "Selection cleared"
selBool = edgeEntity.Select4(True, swSelData)
'Debug.Print "Edge selected - " & selBool
Dim surfaceMidpoint, edgeMidpoint As Variant
Dim surfaceMidpointString, edgeMidpointString As String
edgeMidpoint = swFeatMgr.InsertReferencePoint(2, 1, 50, 1) ' Edge midpoint
edgeMidpointString = edgeMidpoint(0).Name
'''''' To create a reference plane from face and its midpoint
'''''swModel.ClearSelection2 (True)
'''''selBool = faceEntity.Select4(True, swSelData)
'''''Debug.Print "Face selected - " & selBool
'''''
'''''surfaceMidpoint = swModel.FeatureManager.InsertReferencePoint(4, 1, 50, 1) ' Surface midpoint
'''''surfaceMidpointString = surfaceMidpoint(0).Name
'' Create 3 points from 6 edges by intersection for a reference plane
' Get an edge and the one adjacent to it to create a point by InsertReferencePoint method
' Loop that traverses through lists of loop objs, edge entities to
' filter out empty elements
' To do: handle cases where the first loop is the outer one and it has odd number
' of edges, if there are inner loops such as holes that have 2 edges each
' it is not possible to find an intersection point on those edges
kk = 0 ' kk is the number of found edges
For i = 0 To nLoops
For k = 0 To 99
If (Not IsEmpty(tempEdgeEntity(i, k))) Then
Set edgeEntityPairs(kk) = tempEdgeEntity(i, k)
kk = kk + 1
End If
Next
Next
Dim intersectPoint(2) As Variant
Dim intersectPointString(2) As String
' This If statement needs to be more robust, haven't encountered issues
' but there might be some. It is possible to find the outer loop and
' obtain enough points for reference plane just from it
If (kk = 4) Then
' Case where there's only a face that contains 1 loop with 4 edges
swModel.ClearSelection2 (True)
selBool = edgeEntityPairs(0).Select4(True, swSelData)
selBool = edgeEntityPairs(1).Select4(True, swSelData)
intersectPoint(0) = swFeatMgr.InsertReferencePoint(6, 1, 50, 1) ' Edges intersection
swModel.ClearSelection2 (True)
selBool = edgeEntityPairs(1).Select4(True, swSelData)
selBool = edgeEntityPairs(2).Select4(True, swSelData)
intersectPoint(1) = swFeatMgr.InsertReferencePoint(6, 1, 50, 1) ' Edges intersection
swModel.ClearSelection2 (True)
selBool = edgeEntityPairs(2).Select4(True, swSelData)
selBool = edgeEntityPairs(3).Select4(True, swSelData)
intersectPoint(2) = swFeatMgr.InsertReferencePoint(6, 1, 50, 1) ' Edges intersection
swModel.ClearSelection2 (True)
Else
' Case when there are multiple loops and when the first loop is a
' a hole that contains two edges
swModel.ClearSelection2 (True)
selBool = edgeEntityPairs(0).Select4(True, swSelData)
selBool = edgeEntityPairs(1).Select4(True, swSelData)
intersectPoint(0) = swFeatMgr.InsertReferencePoint(6, 1, 50, 1) ' Edges intersection
swModel.ClearSelection2 (True)
selBool = edgeEntityPairs(2).Select4(True, swSelData)
selBool = edgeEntityPairs(3).Select4(True, swSelData)
intersectPoint(1) = swFeatMgr.InsertReferencePoint(6, 1, 50, 1) ' Edges intersection
swModel.ClearSelection2 (True)
selBool = edgeEntityPairs(4).Select4(True, swSelData)
selBool = edgeEntityPairs(5).Select4(True, swSelData)
intersectPoint(2) = swFeatMgr.InsertReferencePoint(6, 1, 50, 1) ' Edges intersection
swModel.ClearSelection2 (True)
End If
' Create reference plane using 3 points
intersectPointString(0) = intersectPoint(0)(0).Name
intersectPointString(1) = intersectPoint(1)(0).Name
intersectPointString(2) = intersectPoint(2)(0).Name
' Selecting the points
For p = 0 To 2
If (p = 0) Then
selBool = swModel.Extension.SelectByID2(intersectPointString(p), "DATUMPOINT", 0, 0, 0, False, 0, Nothing, 0)
Else
selBool = swModel.Extension.SelectByID2(intersectPointString(p), "DATUMPOINT", 0, 0, 0, True, p, Nothing, 0)
End If
Next
' Creating the reference plane
Dim refPlaneObj As Object
Dim firstCon As Long: firstCon = SwConst.swRefPlaneReferenceConstraint_Coincident
Dim firstConVal As Long: firstConVal = 0
Dim secondCon As Long: secondCon = SwConst.swRefPlaneReferenceConstraint_Coincident
Dim secondConVal As Long: secondConVal = 0
Dim thirdCon As Long: thirdCon = SwConst.swRefPlaneReferenceConstraint_Coincident
Dim thirdConVal As Long: thirdConVal = 0
Set refPlaneObj = swModel.FeatureManager.InsertRefPlane(firstCon, firstConVal, _
secondCon, secondConVal, _
thirdCon, thirdConVal)
' Convert face entity to the sketch on the new plane
Dim refPlaneEntity As SldWorks.Entity
Set refPlaneEntity = refPlaneObj
swModel.ClearSelection2 (True)
selBool = refPlaneEntity.Select4(True, swSelData)
swModel.SketchManager.InsertSketch (True)
selVal = faceEntity.Select4(True, swSelData)
boolstatus = swModel.SketchManager.SketchUseEdge3(False, False)
swModel.SketchManager.InsertSketch True
End Sub
Actually it looks like there might be issues because the CAD model is
imported and faces are faces are non-planar.
Hi Mario,
You can check if the selected face is planar by using:
Face.IGetSurface().IsPlane()
Eddy
There could be many reasons why I doesn't work for you.
Without your complete code, it would be difficult to help you.
If your selection get deselected, it might be because you set "Attempt" to False.
Also "Mark" needs to be "0" for the first selection, and "1" for the second.
Look at the remarks and examples in InsertRefPlane
The best way to get a base for your code is to start recording a macro, manually insert a plane then stop and edit the code.
Also SelectByID2 is not the only method to select a face, there is also SelectByRay, or cycle through all the entities with GetFirstFace / GetNextFace or GetFaces to find the one you want.
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.
Can any one explain me to get the object entites count of the layer
using vba code acad
I think You should use SelectionSets
Public Sub SelsetByLayer()
Dim ss As AcadSelectionSet
Dim FilterType(0) As Integer
Dim FilterData(0) As Variant
FilterType(0) = 8 ' DXF code of Layer property
For I = 0 To ThisDrawing.Layers.Count
' ThisDrawing.SelectionSets.Item(0).Delete
Set ss = ThisDrawing.SelectionSets.Add("test") ' You need to ensure if such selection set not exist yet .
FilterData(0) = ThisDrawing.Layers.Item(I).Name
ss.Select acSelectionSetAll, , , FilterType, FilterData
Next
End Sub
Further to the original answer, about using selection sets.
Here it is slightly modified:
Public Sub SelsetByLayer()
Dim ss As AcadSelectionSet
Dim FilterType(0) As Integer
Dim FilterData(0) As Variant
FilterType(0) = 8 ' DXF code of Layer property
For I = 0 To ThisDrawing.Layers.Count
Set ss = CreateSelectionSet("test")
FilterData(0) = ThisDrawing.Layers.Item(I).Name
ss.Select acSelectionSetAll, , , FilterType, FilterData
Next
End Sub
Public Function CreateSelectionSet(SelName As String) As AcadSelectionSet
On Error Resume Next
' Create a new selection set
' Delete any existing selection set with the specified name
With ThisDrawing
Set CreateSelectionSet = .SelectionSets.Add(SelName)
If (Err.Number <> 0) Then
Err.Clear
.SelectionSets.Item(SelName).Delete
Set CreateSelectionSet = .SelectionSets.Add(SelName)
End If
End With
End Function
I have added in the missing method for managing the deletion of existing selection set.
ss.Count will have the number of entities found. But please bear in mind that you may have layers frozen off etc. in the drawing and I think these will be excluded from the totals.