Is there a way to change orientation (direction) of Hole Table axes with SolidWorks API?
I can do it manually by dragging the handles but recorded VBA macro does not contain actual changes.
This is what I would like to achieve:
Before
After
I don't have Visual Studio Tools on this PC so I cannot record a C# or VB macro and see if it contains more code. If somebody could check that on their PC I would be grateful.
I have figured it out. This time digging through SolidWorks API Help was useful.
By using HoleTable.DatumOrigin.SetAxisPoints() method it is possible to change points that define the Hole Table axes.
Important to notice is that SetAxisPoints() changes only the end points of the axis arrows (tips of the arrowheads). Start points get updated automatically.
You can get current point values with HoleTable.DatumOrigin.GetAxisPoints2() method.
Another thing to notice is that values in the hole table do not get updated automatically. They did update after I manually dragged a an axis point.
To get them update by the code set HoleTable.EnableUpdate property to False before and back to True after the call to SetAxisPoints().
Here is the code excerpt that does what I needed:
Dim ht As SldWorks.HoleTable
Dim htdo As SldWorks.DatumOrigin
Dim htdaxpts() As Double
Dim htdaxptsnew(0 To 3) As Double
Dim ystarty As Double
Dim yendx As Double
Dim yendy As Double
Dim xstartx As Double
Dim xendx As Double
Dim xendy As Double
'...
'here comes code to prepare for Hole Table insertion
'...
'insert the Hole Table
Set htann = theView.InsertHoleTable2(False, anchorx, anchory, swBOMConfigurationAnchor_BottomLeft, "A", holetemplatepath)
If Not htann Is Nothing Then
Set ht = htann.HoleTable
Set htdo = ht.DatumOrigin
'disable hole table update to get it refresh when done
ht.EnableUpdate = False
'get coordinates of the axis arrows (4 pairs of (x,y) doubles: X start(0,1), X end(2,3), Y start(4,5), Y end(6,7))
htdaxpts = htdo.GetAxisPoints2()
'take the values we use
xstartx = htdaxpts(0)
xendx = htdaxpts(2)
xendy = htdaxpts(3)
ystarty = htdaxpts(5)
yendx = htdaxpts(6)
yendy = htdaxpts(7)
'change direction only if Y arrow points up
If ystarty < yendy Then
yendy = ystarty - (yendy - ystarty)
End If
'change direction only if X arrow points left
If xstartx > xendx Then
xendx = xstartx - (xendx - xstartx)
End If
'change position only if X arrow is below Y arrow
If xendy < ystarty Then
'we can change end point only so change X end y only
xendy = xendy + (ystarty - xendy) * 2
End If
'prepare new axis points (2 pairs of (x,y) doubles: X end(0,1), Y end(2,3))
htdaxptsnew(0) = xendx
htdaxptsnew(1) = xendy
htdaxptsnew(2) = yendx
htdaxptsnew(3) = yendy
'set new axis end points
htdo.SetAxisPoints htdaxptsnew
'enable hole table update to refresh the values
ht.EnableUpdate = True
End If
Related
I'm producing a line graph and I'm plotting points according to x and y values using points.addxy(X, Y). However the xvalues are plotted through regular intervals which I want to have labeled below the axis. My code is below:
Dim AllRaceArray() As String = GetAllRaceArray() 'Array of The race names in date order
Dim RaceIDs() As Integer = GetAllRaceID() 'Array Of The Race IDs Paralell to the above array
Dim Xnum As Integer = AllRaceArray.Length
Dim Interval As Integer = Math.Floor(Chart1.Size.Width / Xnum)
Chart1.Series.Clear()
For i = 0 To 3
If CompareSlotEmpty(i) = False Then
Chart1.Series.Add(i & CompPaddler(i).Name)
Chart1.Series(i).ChartType = SeriesChartType.Line
Chart1.Series(i).XValueType = ChartValueType.String
Chart1.Series(i).BorderWidth = 2
Chart1.Series(i).MarkerStyle = DataVisualization.Charting.MarkerStyle.Circle
Chart1.Series(i).MarkerSize = 8
For p = 0 To Xnum - 1
For q = 0 To CompPaddler(i).RacePoints.Length - 1
If CompPaddler(i).RacePoints(q).RaceID = RaceIDs(p) Then
Chart1.Series(i).Points.AddXY(Interval * p, CompPaddler(i).RacePoints(q).Points) ' this point plot creates the correct ordering
Chart1.Series(i).Points.AddXY(AllRaceArray(p), CompPaddler(i).RacePoints(q).Points) ' this point plot creates the correct labels
End If
Next
Next
End If
' EDIT
' This below Section has now been added but nothing appears below the axis at all now
For t = 0 To Chart1.Series(i).Points.Count - 1
Chart1.Series(i).Points(t).AxisLabel = AllRaceArray(t)
Next
'EDIT
Next
As annotated above One chart series creates the correct looking graph (http://tinypic.com/r/sobwbc/9) but x axis labels. Then the second plotter plots the correct labels but the ordering and scale gets messed up (http://tinypic.com/r/2w2g5s4/9).
TLDR: How to I change the xAxis Labels to strings that line up with regularly interval points?
Edit: I have added a loop to change the .axislabel but now nothing shows below the axis
I am a bit confused as to how to implement code for Text boxes. I am trying to set up a form which displays a text box, for which the user has the option to enter in the values (parameters) , which then are entered into another subprogram and runs that subprogram. For example, in the following code:
Option Explicit
Sub FillSampleTable()
'This will fill an x by y grid of numbers incrementing to use for testing purposes
Dim x As Double
Dim y As Double
Dim z As Double
Dim OffsetColumn As Integer
Dim offsetrows As Integer
Dim a As Long
Application.ScreenUpdating = False
a = 10
OffsetColumn = 1
offsetrows = 1
z = 0
For x = 1 To a
For y = 1 To a
z = z + 1
Cells(x + offsetrows, y + OffsetColumn).Select
Cells(x + offsetrows, y + OffsetColumn).Value = z
Next y
Next x
Application.ScreenUpdating = True
End Sub
I would want to have a text box to prompt the user for the value of 'a', and once that value is loaded, then this subprogram is run. If no value is entered, then it would shoot an error msgbox and return to the entry screen.
When I click the box I get:
Private Sub GridSize_Change()
'I renamed text box GridSize
End Sub
but don't know what to do with this. MS Excel v 2016.
What you need is an inputbox.
You could do a simple :
a = InputBox("Enter number a")
Since you need a to be a positive integer, you should at least specify the datatype accepted by the inputbox to 1 (number). But you probably also need to make sure it is a positive integer.
I am developing a VBA macro to use in AutoCAD. At the moment it converts a circle into a 3D polyline and in itself it is working perfectly. It is just the start and I will be able to put some flesh on the final routine.
This is the VBA macro:
Sub CircleToPolyline()
Dim objSel As AcadEntity
Dim myCircle As AcadCircle
Dim pickedPoint As Variant
' Get the user to select a circle
' Eventually we will use a Selection Set with Filtering to pick them all in the drawing
Call ThisDrawing.Utility.GetEntity(objSel, pickedPoint, "Select Circle:")
If objSel.ObjectName <> "AcDbCircle" Then GoTo SKIP
Set myCircle = objSel
Dim dAngle As Double, dAngleStep As Double, dMaxAngle As Double
dAngle = 0# ' We always start at 0 degrees / radians
dAngleStep = 0.17453293 ' This is 10 degrees in radians
dMaxAngle = 6.28318531 ' This is 360 degrees in radians
' So our polyline will always have 36 vertices
Dim ptCoord() As Double
Dim ptProject As Variant
Dim i As Integer
i = 0
While dAngle < dMaxAngle
ReDim Preserve ptCoord(0 To i + 2) ' Increase size of array to hold next vertex
' Calculate the next coordinate on the edge of the circle
ptProject = ThisDrawing.Utility.PolarPoint(myCircle.center, dAngle, myCircle.Radius)
' Add to the coordinate list
ptCoord(i) = ptProject(0)
ptCoord(i + 1) = ptProject(1)
ptCoord(i + 2) = ptProject(2)
' Increment for next coordinate/angle on the circle edge
dAngle = dAngle + dAngleStep
i = i + 3
Wend
' Create the 3D polyline
Dim oPolyline As Acad3DPolyline
Set oPolyline = ThisDrawing.ModelSpace.Add3DPoly(ptCoord)
oPolyline.Closed = True
oPolyline.Update
SKIP:
End Sub
I am just wondering if there are any alternative methods for managing my dynamic array (ptCoord)? For example, is there any way that I can just add the ptProject into a dynamic list and then just use this list in the Add3dPoly routine?
The thing is, PolarPoint returns a variant. And ptCoord is a array of doubles (which is what Add3dPoly expects). This is why I have done it like this. I have not used variants (except for handling return values).
My code is quite simple and sufficient, but if it can be further simplified I would be interested in knowing (given the context of VBA and AutoCAD environment).
I hope my question is clear. Thank you.
It is feasible to allocate a chunk of memory and write the sequential results of each of your PolarPoint calls to it. You could then copy that memory to your ptCoord array in one call. However, the APIs are very awkward, there'd be a lot of fiddling with pointers (never straightforward in VBA) and most memory coding errors result in a complete Excel crash. For 108 data points it doesn't seem worth the effort.
I'd say your notion of iterating each of the result arrays and writing them individually to ptCoord is as good a way as any.
Your comments
'We always start at 0 degrees / radians, and 'So our polyline will always have 36 vertices
suggest your ptCoord array will have a fixed dimension (ie 36 * 3). If that's the case couldn't you just dimension the array once? Even if you want to vary the number of degrees to draw through, you could still dimension your array at (n * 3) without having to ReDim Preserve on every iteration.
A snippet of your code could therefore become:
Dim alpha As Double
Dim index As Integer
Dim i As Integer
Dim ptCoord(0 To 107) As Double
Dim ptProject() As Double
Dim pt As Variant
...
For i = 0 To 35
ptProject = ThisDrawing.Utility.PolarPoint(myCircle.center, dAngle, myCircle.Radius)
For Each pt In ptProject
ptCoord(index) = pt
index = index + 1
Next
alpha = alpha + 0.174532925199433
Next
Your code appears good to me, I was going to suggest a two dimensional array: -
Dim ptCoord(2,0)
...
ptCoord(0,0) = ptProject(0)
ptCoord(1,0) = ptProject(1)
ptCoord(2,0) = ptProject(2)
ReDim Preserve ptCoord(2,1)
ptCoord(0,1) = ptProject(0)
ptCoord(1,1) = ptProject(1)
ptCoord(2,1) = ptProject(2)
The second dimension in a two dimensional array can be dynamically re-dimensioned. But I'm not sure this will save you anything and it may not work with Add3DPoly.
You could use UBound to save on the i variable.
ReDim Preserve ptCoord(UBound(ptCoord,1)+3)
In the above I haven't declared the lower/base (0 To) as 0 is the default base, I have then used UBound (Upper bound) to get the size of the array and added 3 to that to make it 3 larger.
UBound([Array],[Dimension])
Array being the array you want to check
Dimension being the dimension you want to check the size on, it has a base of 1 not 0 (so the first dimension is 1 not 0, the second is 2 not 1, and so on...)
You can omit Dimension and the first will be assumed.
To access it without i you could use: -
ptCoord(UBound(ptCoord,1)-2) = ptProject(0)
ptCoord(UBound(ptCoord,1)-1) = ptProject(1)
ptCoord(UBound(ptCoord,1)) = ptProject(2)
you can skip arrays dimming altogether by use of AppendVertex() method
Option Explicit
Sub CircleToPolyline()
Dim myCircle As AcadCircle
Dim circleCenter As Variant, circleRadius As Double
Dim dAngle As Double, dAngleStep As Double, dMaxAngle As Double
Dim oPolyline As Acad3DPolyline
'Get the user to select a circle
Set myCircle = GetCircle(circleCenter, circleRadius)
If myCircle Is Nothing Then Exit Sub
dAngle = 0# ' We always start at 0 degrees / radians
dAngleStep = 0.17453293 ' This is 10 degrees in radians
dMaxAngle = 6.28318531 ' This is 360 degrees in radians
Set oPolyline = GetStarting3dPoly(circleCenter, circleRadius, dAngle, dAngleStep) ' Create the 3D polyline with first two points
Do While dAngle + dAngleStep <= dMaxAngle
dAngle = dAngle + dAngleStep ' Increment for next coordinate/angle on the circle edge
oPolyline.AppendVertex ThisDrawing.Utility.PolarPoint(circleCenter, dAngle, circleRadius) 'append a new vertex
Loop
'finish the polyline
oPolyline.Closed = True
oPolyline.Update
End Sub
Function GetStarting3dPoly(circleCenter As Variant, circleRadius As Double, dAngle As Double, dAngleStep As Double) As Acad3DPolyline
Dim ptCoord(0 To 5) As Double
Dim ptCoords As Variant
ptCoords = ThisDrawing.Utility.PolarPoint(circleCenter, dAngle, circleRadius)
ptCoord(0) = ptCoords(0)
ptCoord(1) = ptCoords(1)
ptCoord(2) = ptCoords(2)
dAngle = dAngle + dAngleStep
ptCoords = ThisDrawing.Utility.PolarPoint(circleCenter, dAngle, circleRadius)
ptCoord(3) = ptCoords(0)
ptCoord(4) = ptCoords(1)
ptCoord(5) = ptCoords(2)
Set GetStarting3dPoly = ThisDrawing.ModelSpace.Add3DPoly(ptCoord)
End Function
Function GetCircle(circleCenter As Variant, circleRadius As Double) As AcadCircle
Dim objSel As AcadEntity
Dim pickedPoint As Variant
' Get the user to select a circle
' Eventually we will use a Selection Set with Filtering to pick them all in the drawing
ThisDrawing.Utility.GetEntity objSel, pickedPoint, "Select Circle:"
If objSel.ObjectName = "AcDbCircle" Then
Set GetCircle = objSel
circleCenter = objSel.Center
circleRadius = objSel.Radius
End If
End Function
as you see I also extracted some actions from the main code and confined them into functions, so to improve further enhancing of your code and its functionalities
I am trying to create a macro which loops through series in a chart and only shows the maximum / minimum label dependent on what the max / min value is.
Some of the series will only have negative values and in these cases I wish to only show the minimum datapoint label, and vice versa for series with 0 or greater values.
The code I have so far is:
Sheets("Curve").ChartObjects("Chart 14").Activate
For Each serie In ActiveChart.SeriesCollection
Dim pointCount As Integer
Dim pointValues As Variant
pointCount = serie.Points.Count
pointValues = serie.Values
For pointIndex = 1 To pointCount
If pointValues(pointIndex) < 1000 Then
serie.Points(pointIndex).HasDataLabel = True
End If
Next pointIndex
Next serie
End Sub
Which works fine when I manually enter the threshold, but I want to replace the '1000' with Max(series) value instead, so that each series in the chart has only one label visible.
The following modified routine includes MaxPoint, MaxPointIndex, MinPoint, and MinPointIndex variables which are calculated in the For loop on each serie's points. It then sets the label for the maximum point if the series has only positive value and minimum point otherwise.
Option Explicit
Sub chart()
Dim serie As Variant
Dim Pointindex As Long
Dim MaxPoint As Long
Dim MaxPointIndex As Long
Dim MinPoint As Long
Dim MinPointIndex As Long
Sheets("Curve").ChartObjects("Chart 14").Activate
For Each serie In ActiveChart.SeriesCollection
Dim pointCount As Integer
Dim pointValues As Variant
pointCount = serie.Points.Count
pointValues = serie.Values
MinPoint = 10000 'set to value greater than any point in any serie
MaxPoint = 0
For Pointindex = 1 To pointCount
If pointValues(Pointindex) > MaxPoint Then
MaxPoint = pointValues(Pointindex)
MaxPointIndex = Pointindex
ElseIf pointValues(Pointindex) < MinPoint Then
MinPoint = pointValues(Pointindex)
MinPointIndex = Pointindex
End If
Next Pointindex
If MinPoint >= 0 Then
serie.Points(MaxPointIndex).HasDataLabel = True
Else
serie.Points(MinPointIndex).HasDataLabel = True
End If
Next serie
End Sub
I have an alternative approach, which does not require VBA. It adds an extra series with an invisible data point at the max and this point has a data label. It also changes dynamically if the data changes and a different point is maximum, without having to rerun the VBA procedure.
For each series in the chart you'll need to use a range the same size as the Y values of the series.
Assume the original Y values for a given series is in D2:D10, and we'll use G2:G10 for our extra data. In G2 enter
=IF($D2=MAX($D$2:$D$10),$D2,NA())
and fill this down to G10. Modify this formula for the case where you might instead look for the minimum value if everything is negative.
Copy G2:G10 and hold CTRL while you select the X values for this series. Copy. Select the chart, use Paste Special, and select Add data as new Series, in Columns, Categories in First Column.
Select the added series, which is one point (unless there are two points at the maximum), format to have no lines and no markers. Add your data labels to this series.
Repeat for the other series in the chart.
I want to get the angle of two points on a Line chart.
I know how to calculate an angle, the problem is that I need the x and y of the seriescollection.point and I have no idea how to get it.
Can someone help me with it?
EDIT:
Jean-François Corbett showed me how to get the points, I meant from top and left, and not point on the graph (on X scale and Y scale) though it can work.
I calculate it wrong. how can I calculate the angles in the picture below?
You ask how to get the (x,y) coordinates of points in a chart series. Here is how:
Dim c As Chart
Dim s As Series
Dim x As Variant
Dim y As Variant
Set c = ActiveChart
Set s = c.SeriesCollection.Item(1)
x = s.XValues
y = s.Values
EDIT As far as I can tell from the edited question, OP now wants the pixel coordinates of each point, with origin at the top left of the plot. To do so, you just need to scale by the axis width and span. The x axis is a bit tricky in the case of line plots (which I hate), because there is no min or max scale property; have to use the number of "categories" instead. The following code does this scaling:
Dim c As Chart
Dim s As Series
Dim xa As Axis
Dim ya As Axis
Dim x As Variant
Dim y As Variant
Dim i As Long
Set c = ActiveChart
Set s = c.SeriesCollection.Item(1)
Set xa = c.Axes(xlCategory)
Set ya = c.Axes(xlValue)
x = s.XValues
y = s.Values
For i = LBound(x) To UBound(x)
' Scale x by number of categories, equal to UBound(x) - LBound(x) + 1
x(i) = (i - LBound(x) + 0.5) / (UBound(x) - LBound(x) + 1) * xa.Width
' Scale y by axis span
y(i) = ya.Height - y(i) / (ya.MaximumScale - ya.MinimumScale) * ya.Height
Next i
Note that y increases along the negative y direction on the plot, since you want the origin to be at the top left.
Using this x and y, you can calculate your angle as seen on the screen.
The X and Y values are not directly accessible from the Point object, (as best as I can tell), but they represent actual values passed to the graph. Try accessing them from the worksheet where they are stored.
If that is unavailable, try Series.values, which returns an array of Y-values, and Series.XValues, which returns an array of X-values. (See MSDN Reference)