Continue to Site

Eng-Tips is the largest engineering community on the Internet

Intelligent Work Forums for Engineering Professionals

  • Congratulations KootK on being selected by the Eng-Tips community for having the most helpful posts in the forums last week. Way to Go!

How move corners of rectangular to new coordinates?

Status
Not open for further replies.

WitOld_Pl

Industrial
Sep 1, 2021
2
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.

Part and Inventory Search

Sponsor