Eng-Tips is the largest engineering community on the Internet

Intelligent Work Forums for Engineering Professionals

How move corners of rectangular to new coordinates?

Status
Not open for further replies.

WitOld_Pl

Industrial
Sep 1, 2021
2
0
0
PL
Inside the sketch, I have a rectangle of construction lines with driven dimensions.
I would like to programmatically(!), without operator intervention, change the position of the corners of this rectangle into a macro, setting their X and Y values calculated in the Macro. Has anyone tried something like this?
I have a problem with:
- how to find 2 corners of a rectangle (for example: top-left and bottom-right)
- how to give them new values
Please send me suggestions or a link to help.
 
 https://files.engineering.com/getfile.aspx?folder=70851da0-eed7-4015-ae7f-7bd5070780f5&file=XY.jpg
Replies continue below

Recommended for you

Have you looked at design-table controlled configurations? An Excel spreadsheet controls the dimensions in various model configurations.
 
I'm sorry, but I don't want use any excell, tables, and other. I want: open model with some body and one sketch with rectangle, start Macro and get sketch with sketch with modified rectangle ​(X and Y are calculated from parameters of body).
X and Y I get from:
'*** rectangle described on the solid ***
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr

Sub mainXX()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If Not swModel Is Nothing Then
Set swSelMgr = swModel.SelectionManager
swModel.GetBodies2(0, True)(0).Select2 False, Nothing
Dim swBody As SldWorks.Body2
Dim xMin As Double
Dim yMin As Double
Dim xMax As Double
Dim yMax As Double
xMin = 0
yMin = 0
xMax = 0
yMax = 0
Set swBody = swSelMgr.GetSelectedObject6(1, -1)
swModel.ClearSelection2 True
Dim vDirs(5) As Variant
vDirs(0) = Array(1, 0, 0)
vDirs(1) = Array(0, 1, 0)
vDirs(2) = Array(0, 0, 1)
vDirs(3) = Array(-1, 0, 0)
vDirs(4) = Array(0, -1, 0)
vDirs(5) = Array(0, 0, -1)
Dim i As Integer
For i = 0 To UBound(vDirs)
Dim x As Double
Dim y As Double
Dim z As Double
swBody.GetExtremePoint vDirs(i)(0), vDirs(i)(1), vDirs(i)(2), x, y, z
xMin = Min(xMin, x)
yMin = Min(yMin, y)
xMax = Max(xMax, x)
yMax = Max(yMax, y)
Next
' left-top is (xMin,yMax)
' right-down is (xMax,yMin)
' **** Place for procedure to change corners of rectangle inside the sketch. ***
Else
MsgBox "Please open part or assembly"
End If
End Sub


Public Function Max(a, b As Double) As Double
Max = IIf(a >= b, a, b)
End Function

Public Function Min(a, b As Double) As Double
Min = IIf(a <= b, a, b)
End Function
 
Status
Not open for further replies.
Back
Top