Здравствуйте, я создаю макрос в VBA для SW 2011 построения 3D катушки.
Есть кромка состоящая из нескольких отрезков. Мне нужно перпендикулярно каждому отрезку провести вспомогательную плоскость. Проблема в том что количество этих отрезков и координаты будут различным для разных катушек. Подскажите пожалуйста, как можно считать координаты этих отрезков в макрос?^ наверх ^
# 9
Артем Татуревич
АдминистраторЗдравствуйте,
Не совсем понял, что Вы имеете ввиду. Если не ошибаюсь, речь идет об объектах IEdge. Получать их можно многими способами (см. пункт Accessors в API Help для интерфейса IEdge). Уточните, какие исходное данные у Вас есть. Хорошо бы приложить модель, или хотя бы скриншот.
Но, как я это понимаю, Вам будет нужен обход всех кромок (IBody2::GetEdges) и отсеивание лишних по какому-либо критерию, например Edge::GetCurve:: IsCircle. Чтообы получить координаты кромки, используйте Edge::GetEndVertex/ Edge::GetStartVertex.
Получение параметров объектов в SW макросом
Сообщений 1 страница 5 из 5
Поделиться12013-04-18 20:02:21
- Администратор
- Зарегистрирован: 2006-10-09
- Приглашений: 0
- Сообщений: 5169
- Уважение: +1
- Позитив: +7
- Провел на форуме:
4 месяца 8 дней - Последний визит:
Сегодня 06:24:53
Поделиться22013-06-05 13:43:16
- Администратор
- Зарегистрирован: 2006-10-09
- Приглашений: 0
- Сообщений: 5169
- Уважение: +1
- Позитив: +7
- Провел на форуме:
4 месяца 8 дней - Последний визит:
Сегодня 06:24:53
Вроде это
Get Sketch Points Example (VBA)
This example shows how to loop through the active sketch and extract the x and y values of every sketch point.
'-------------------------------------------------------
' Preconditions:
' 1. Open a sketch containing sketch points.
' 2. Open the Immediate window.
' 3. Run the macro.
'
' Postconditions:
' 1. The x and y values of each sketch
' point in the sketch are printed to the
' Immediate window.
' 2. Examine the Immediate window.
'--------------------------------------------------------
Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim Part As SldWorks.PartDoc
Dim theSketch As SldWorks.Sketch
Dim sketchPointArray As Variant
Dim i As Long
Dim pointCount As Long
Dim xValue As Double
Dim yValue As Double
Dim zValue As Double
Set swApp = CreateObject("SldWorks.Application")
Set Part = swApp.ActiveDoc
Set theSketch = Part.GetActiveSketch2sketchPointArray = theSketch.GetSketchPoints2
pointCount = UBound(sketchPointArray) + 1
' For each SketchPoint
For i = 0 To (pointCount - 1)
' Get the coordinates
xValue = sketchPointArray(i).X
yValue = sketchPointArray(i).Y
zValue = sketchPointArray(i).Z
Debug.Print "Sketch point x and y coordinates: " & xValue; " and " & yValue
Debug.Print " "
' Do something useful with the data
Next iEnd Sub
Поделиться32013-06-05 14:15:30
- Администратор
- Зарегистрирован: 2006-10-09
- Приглашений: 0
- Сообщений: 5169
- Уважение: +1
- Позитив: +7
- Провел на форуме:
4 месяца 8 дней - Последний визит:
Сегодня 06:24:53
Get Polyline Data from Drawing View Example (VBA)
This example shows how to retrieve the defining data of arcs, circles, ellipses, splines, and lines in a drawing view.
' -----------------------------------------------------------------------------
' Preconditions: Open a drawing of a part.
'
' Postconditions: Inspect the Immediate window for edge and geometry data.
' -----------------------------------------------------------------------------
Option Explicit
Dim swApp As SldWorks.SldWorks
Sub main()
Dim swModel As SldWorks.ModelDoc2
Dim swDrawing As SldWorks.DrawingDoc
Dim swView As SldWorks.View
Dim swSheetView As SldWorks.View
Dim swSketch As SldWorks.Sketch
' Get SolidWorks application.
Set swApp = Application.SldWorks
' Get active document.
Set swModel = swApp.ActiveDoc
' Downcast model to a drawing.
Set swDrawing = swModel
' The first view is the drawing sheet.
Set swSheetView = swDrawing.GetFirstView
' Print its contents.
PrintView swSheetView
' Get the sketch for the drawing sheet view.
Set swSketch = swSheetView.GetSketch
' Print its contents.
PrintSketch swSketch
'
' Traverse all "real" views on the sheet.
'
' First view on the sheet.
Set swView = swSheetView.GetNextView
Do While Not swView Is Nothing
PrintView swView
Set swSketch = swView.GetSketch
PrintSketch swSketch
' Go to next view on the sheet.
Set swView = swView.GetNextView
Loop
End Sub
Function PrintView(swView As SldWorks.View) As Boolean
Dim vEdges As Variant
Dim vPolyLinesBuffer As Variant
Dim vLines As Variant
Dim lNumGeomData As Long
Dim i As Integer
Dim iGeomIndex As Integer
Dim lNumLines As Long
Dim lItemType As Long
Dim lBufferSize As Long
Dim lBufferIdx As Long
Dim lGeomDataSize As Long
Dim dGeomData(11) As Double
Dim lLineData(3) As Long
Dim lLayerData(1) As Long
Dim lNumPoints As Long
Dim dPoint(2) As Double
Dim lGeomDataIdx As Long
Dim lLineDataIdx As Long
Dim lLayerDataIdx As Long
Dim lStartIdx As Long
Dim lEndIdx As Long
Dim lLineDataSize As Long
Dim lLayerDataSize As Long
Dim lNumProjectedElements As Long
Dim lNumSketchedElements As Long
If swView Is Nothing Then
Exit Function
End If
Debug.Print "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++"
Debug.Print "View = " + swView.Name
'
' Report projected model geometry.
'
' Initialize the number of projected elements for data is contained in the buffer.
lNumProjectedElements = 0
' Get the edges and put all the polyline data into a buffer.
' - no cross-hatch lines.
vEdges = swView.GetPolylines7(1, vPolyLinesBuffer)
If Not IsEmpty(vEdges) Then
Debug.Print "Number of edges: " & (UBound(vEdges) - LBound(vEdges) + 1)
End If
' Any polyline data present ?
If Not IsEmpty(vPolyLinesBuffer) Then
' Entries for line data and layer data have a fixed size.
lLineDataSize = 4
lLayerDataSize = 2
' Get the total buffer size.
lBufferSize = UBound(vPolyLinesBuffer) - LBound(vPolyLinesBuffer) + 1
' We start to traverse the buffer at index 0.
lBufferIdx = 0
' Traverse the buffer, consuming data elements.
Do While lBufferIdx < lBufferSize
' Determine type.
lItemType = vPolyLinesBuffer(lBufferIdx)
lBufferIdx = lBufferIdx + 1
' We have found another projected element.
lNumProjectedElements = lNumProjectedElements + 1
' Handle type specific data.
If lItemType = 0 Then
' HERE: polylines
Debug.Print " polyline"
' Get GeomDataSize:
' - should be zero, but consume it anyway.
lGeomDataSize = vPolyLinesBuffer(lBufferIdx)
lBufferIdx = lBufferIdx + 1
' Ignore GeomData.
Else
' HERE: arc:
' - next to the piecewise linear approximation of the projected model geometry,
' the buffer also contains the arc definining the model geometry projection.
Debug.Print " arc"
' Get GeomDataSize:
' - should be 12.
lGeomDataSize = vPolyLinesBuffer(lBufferIdx)
lBufferIdx = lBufferIdx + 1
' Get GeomData.
lGeomDataIdx = 0
lStartIdx = lBufferIdx
lEndIdx = lStartIdx + (lGeomDataSize - 1)
For lBufferIdx = lStartIdx To lEndIdx
dGeomData(lGeomDataIdx) = vPolyLinesBuffer(lBufferIdx)
lGeomDataIdx = lGeomDataIdx + 1
Next lBufferIdx
Debug.Print " center pt = (" & dGeomData(0) * 1000# & ", " & dGeomData(1) * 1000# & ", " & dGeomData(2) * 1000# & ") mm"
Debug.Print " start pt = (" & dGeomData(3) * 1000# & ", " & dGeomData(4) * 1000# & ", " & dGeomData(5) * 1000# & ") mm"
Debug.Print " end pt = (" & dGeomData(6) * 1000# & ", " & dGeomData(7) * 1000# & ", " & dGeomData(8) * 1000# & ") mm"
Debug.Print " normal = (" & dGeomData(9) & ", " & dGeomData(10) & ", " & dGeomData(11) & ")"
End If
' Get line data.
lLineDataIdx = 0
lStartIdx = lBufferIdx
lEndIdx = lStartIdx + (lLineDataSize - 1)
For lBufferIdx = lStartIdx To lEndIdx
lLineData(lLineDataIdx) = vPolyLinesBuffer(lBufferIdx)
lLineDataIdx = lLineDataIdx + 1
Next lBufferIdx
' Get layer data.
lLayerDataIdx = 0
lStartIdx = lBufferIdx
lEndIdx = lStartIdx + (lLayerDataSize - 1)
For lBufferIdx = lStartIdx To lEndIdx
lLayerData(lLayerDataIdx) = vPolyLinesBuffer(lBufferIdx)
lLayerDataIdx = lLayerDataIdx + 1
Next lBufferIdx
' Get point data.
lNumPoints = vPolyLinesBuffer(lBufferIdx)
Debug.Print " #points = " & CStr(lNumPoints)
lBufferIdx = lBufferIdx + 1
lStartIdx = lBufferIdx
lEndIdx = lStartIdx + lNumPoints * 3 - 1
For lBufferIdx = lStartIdx To lEndIdx Step 3
dPoint(0) = vPolyLinesBuffer(lBufferIdx)
dPoint(1) = vPolyLinesBuffer(lBufferIdx + 1)
dPoint(2) = vPolyLinesBuffer(lBufferIdx + 2)
Next lBufferIdx
Loop
End If
' Report the number of projected elements we found.
Debug.Print " #projected elements = " & CStr(lNumProjectedElements)
'
' Report sketched geometry; only show lines.
'
' Initialize to zero.
lNumSketchedElements = 0
lNumLines = swView.GetLineCount2(1)
If lNumLines <> 0 Then
vLines = swView.GetLines4(1)
If Not IsEmpty(vLines) Then
For i = 0 To lNumLines - 1
Debug.Print " line[" & i & "]"
Debug.Print " start pt = (" & vLines(i * 12 + 6) * 1000# & ", " & vLines(i * 12 + 7) * 1000# & ", " & vLines(i * 12 + 8) * 1000# & ") mm"
Debug.Print " end pt = (" & vLines(i * 12 + 9) * 1000# & ", " & vLines(i * 12 + 10) * 1000# & ", " & vLines(i * 12 + 11) * 1000# & ") mm"
Next i
End If
End If
lNumSketchedElements = lNumSketchedElements + lNumLines
lNumSketchedElements = lNumSketchedElements + swView.GetArcCount
lNumSketchedElements = lNumSketchedElements + swView.GetEllipseCount
lNumSketchedElements = lNumSketchedElements + swView.GetParabolaCount
' Report the number of sketched elements found.
Debug.Print " #sketched elements = " & CStr(lNumSketchedElements)
End Function
Function PrintSketch(swSketch As SldWorks.Sketch) As Boolean
Dim vSegments As Variant
Dim lNumSegments As Long
If swSketch Is Nothing Then
Debug.Print "No Sketch"
End If
' Get the sketch segments.
vSegments = swSketch.GetSketchSegments
' Determine number of segments.
If Not IsEmpty(vSegments) Then
lNumSegments = UBound(vSegments) - LBound(vSegments) + 1
Else
lNumSegments = 0
End If
Debug.Print "Sketch = "
Debug.Print " #points = " & CStr(swSketch.GetUserPointsCount())
Debug.Print " #segments = " & CStr(lNumSegments)
' Get count of specific sketch segments.
If lNumSegments > 0 Then
Debug.Print " #arcs = " & CStr(swSketch.GetArcCount())
Debug.Print " #lines = " & CStr(swSketch.GetLineCount2(1))
Debug.Print " #ellipses = " & CStr(swSketch.GetEllipseCount())
Debug.Print " #parabolas = " & CStr(swSketch.GetParabolaCount())
End If
End Function
Поделиться42013-06-05 14:49:10
- Администратор
- Зарегистрирован: 2006-10-09
- Приглашений: 0
- Сообщений: 5169
- Уважение: +1
- Позитив: +7
- Провел на форуме:
4 месяца 8 дней - Последний визит:
Сегодня 06:24:53
Get Components in Drawing View Example (VBA)
This example shows how to get the components in a drawing view and how to change their line font styles.
'------------------------------------------------------------------
' Preconditions:
' 1. Drawing document opened by the macro exists.
' 2. Drawing view is selected.
' 3. Open the Immediate window.
'
' Postconditions:
' 1. Specified drawing document is opened.
' 2. Drawing View1 is selected.
' 3. Gets the root and children components for Drawing
' View1.
' 4. For each component:
' a. Prints the name of the component and configuration
' to the Immediate window.
' b. Disables the use of the document defaults for the
' the component's line font style.
' c. Sets new line style and line thickness for the component's
' visible edges and prints the new settings and values to
' the Immediate window.
' d. Prints the file name of the component to the Immediate window.
'------------------------------------------------------------------
Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swSelMgr As SldWorks.SelectionMgr
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swView As SldWorks.View
Dim swRootDrawComp As SldWorks.DrawingComponent
Dim vDrawChildCompArr As Variant
Dim vDrawChildComp As Variant
Dim swDrawComp As SldWorks.DrawingComponent
Dim swComp As SldWorks.Component2
Dim swCompModel As SldWorks.ModelDoc2
Dim assemblyDrawing As String
Dim status As Boolean
Dim errors As Long
Dim warnings As Long
Dim lineWeight As Long
Dim lineThickness As Double
Set swApp = Application.SldWorks
assemblyDrawing = "C:\Program Files\SolidWorks Corp\SolidWorks\samples\tutorial\driveworksxpress\mobile gantry.slddrw"
Set swModel = swApp.OpenDoc6(assemblyDrawing, swDocDRAWING, swOpenDocOptions_Silent, "", errors, warnings)
Set swDraw = swModel
Set swModelDocExt = swModel.Extension
Set swSelMgr = swModel.SelectionManager
status = swDraw.ActivateView("Drawing View4")
status = swModelDocExt.SelectByID2("Drawing View1", "DRAWINGVIEW", 0.104008832128, 0.1163870710783, 0, False, 0, Nothing, 0)
Set swView = swSelMgr.GetSelectedObject6(1, -1)
swModel.ViewZoomtofit2
Set swRootDrawComp = swView.RootDrawingComponent
Debug.Print "File = " & swModel.GetPathName
Debug.Print " View = " & swView.Name
vDrawChildCompArr = swRootDrawComp.GetChildren
For Each vDrawChildComp In vDrawChildCompArr
Set swDrawComp = vDrawChildComp
' Returns NULL if underlying model is open in a different configuration
Set swComp = swDrawComp.Component
If Not Nothing Is swComp Then
' Returns NULL if drawing is lightweight
Set swCompModel = swComp.GetModelDoc2
Debug.Print " "
Debug.Print " Component = " & swComp.Name2
Debug.Print " Configuration = " & swComp.ReferencedConfiguration
' Turn off using document default settings for component's line font style
swDrawComp.UseDocumentDefaults = False
Debug.Print " Default component line font in use = " & swDrawComp.UseDocumentDefaults
' Set new line style for visible edges
swDrawComp.SetLineStyle swDrawingComponentLineFontVisible, swLineCHAIN
Debug.Print " Line style for visible edges = " & swDrawComp.GetLineStyle(swDrawingComponentLineFontVisible)
' Set new line thickness for visible edges
swDrawComp.SetLineThickness swDrawingComponentLineFontVisible, swLW_CUSTOM, 0.0003
lineWeight = swDrawComp.GetLineThickness(swDrawingComponentLineFontVisible, lineThickness)
Debug.Print " Line weight style and thickness for visible edges = " & lineWeight & ", " & lineThickness * 1000 & " mm"
If Not Nothing Is swCompModel Then
Debug.Print " File = " & swCompModel.GetPathName
Debug.Print " "
End If
End If
Next
End Sub
Поделиться52013-06-05 14:58:00
- Администратор
- Зарегистрирован: 2006-10-09
- Приглашений: 0
- Сообщений: 5169
- Уважение: +1
- Позитив: +7
- Провел на форуме:
4 месяца 8 дней - Последний визит:
Сегодня 06:24:53
Sub GetPointCoords()
Dim swApp As Object, Part As Object, skPoint As Object
Dim dX As Double, dY As Double, dZ As Double
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set skPoint = Part.Sketch("Sketch1").SketchPoint("Point1")
dX = skPoint.X
dY = skPoint.Y
dZ = skPoint.Z
End Sub
