I have multi shapes.
I want to show all dimensions of each sides(the green lines).
I want to use vba.
I can show dimension a full square or rectangle shape.
for example to show a horizontal dimension I use this function:
Function createDimensionHorizental(x1, y1, x2, y2)
' This example creates an aligned dimension in model space and
' uses the TextHeight property to increase the height of the
' dimension text
Dim dimObj As AcadDimAligned
Dim point1(0 To 2) As Double, point2(0 To 2) As Double
Dim location(0 To 2) As Double
' Define the dimension
point1(0) = x1: point1(1) = y1: point1(2) = 0
point2(0) = x2: point2(1) = y1: point2(2) = 0
location(0) = x1: location(1) = y1 + 10: location(2) = 0
' Create an aligned dimension object in model space
Set dimObj = ThisDrawing.ModelSpace.AddDimAligned(point1, point2, location)
' Read and display current dimension text height
'MsgBox "The dimension text height for this object is currently set to: " & dimObj.TextHeight
' Increase the distance of the dimension gap
'Format the dimension object according to your needs.
With dimObj
.TextHeight = 30
.TextGap = 10 'The distance of the dimension text from the dimension line.
.Arrowhead1Type = 5 'acArrowOblique in early binding
.Arrowhead2Type = 5 'For the standard dimension arrow put 0 here.
.ArrowheadSize = 20
.ExtensionLineExtend = 10 'The amount to extend the extension line beyond the dimension line.
End With
ThisDrawing.Regen acAllViewports
End Function
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 trying to create a Sankey-diagram in Excel, and as a start to this, I am trying to create some "entry arrows" for the left part of the diagram, which will look roughly like this:
I created it by making a chevron arrow, and dragging the rightmost points of it to line up with the tip of the arrow.
Now, to do this for all the arrows I need, I want to do this programmatically, but I can't figure out if there is any way to do much with the nodes (?) of the shape. Trying to record a macro gave me nothing.
This is what I have so far, the macro aborts on the Debug.Print line, probably because the node object doesn't have a Left property :P
Sub energiInn()
Dim r As Range, c As Range
Dim lo As ListObject
Dim topp As Double, høgde As Double
Dim i As Long, farge As Long
Dim nd As Object
Set lo = Tabell.ListObjects("Energi_inn_elektrolyse")
Set r = lo.DataBodyRange
topp = 50
With SankeyDiagram.Shapes
For i = 1 To r.Rows.Count
høgde = Application.WorksheetFunction.Max(10, r.Cells(i, 2) / 50#)
With .AddShape(Type:=msoShapeChevron, Left:=50, top:=topp, Width:=200, Height:=høgde)
.Name = r.Cells(i, 1)
farge = fargekart((i - 1) Mod UBound(fargekart))
.Fill.ForeColor.RGB = RGB(farge Mod 256, (farge \ 256) Mod 256, farge \ 65536)
For Each nd In .Nodes
Debug.Print nd.Left
Next nd
End With
topp = topp + høgde
Next i
End With
Debug.Print r.Address
End Sub
Honestly, I am unsure if this can be done at all, but even if it is impossible, it would be nice to get it confirmed :)
What you're looking for is .Nodes.SetPosition. Because it's relative positioning, this can be a challenge. You need to use the objects position elements to make sure the points are moving in relation to the shape.
With .AddShape(Type:=msoShapeChevron, Left:=50, Top:=topp, Width:=200, Height:=høgde)
.Name = r.Cells(i, 1)
.Nodes.SetPosition 2, .Left + .Width, .Top
.Nodes.SetPosition 4, .Left + .Width, .Top + .Height
First argument is the node index. Next is the x position, which we want all the way to the right of the graphic, so we add the shapes position left to the width of the shape. Last is the y position, first point we want in the topmost corner, so we use the shapes top. Last point, we add the height to the top position to bring to the bottom corner.
I believe it would be more simple drawing this as free form using Shapes.BuildFreeform Method and then converting to shape using FreeformBuilder.ConvertToShape Method.
Example:
Sub drawEntryArrow()
Dim x1 As Single, y1 As Single, w As Single, h As Single
Dim oShape As Shape
x1 = 10
y1 = 10
w = 200
h = 200
With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, x1, y1)
.AddNodes msoSegmentLine, msoEditingAuto, x1 + w, y1
.AddNodes msoSegmentLine, msoEditingAuto, x1 + w, y1 + h
.AddNodes msoSegmentLine, msoEditingAuto, x1, y1 + h
.AddNodes msoSegmentLine, msoEditingAuto, x1 + w / 2, y1 + h / 2
.AddNodes msoSegmentLine, msoEditingAuto, x1, y1
Set oShape = .ConvertToShape
End With
End Sub
If you just want to get rid of the point at the right, you can simply delete the node (nodes of a chevron are counted clockwise starting at the top left):
.Nodes.Delete 3
To get access to all nodes with the nodes-property of a shape, however, as long as you deal with a standard shape type, you can't access the coordinates.
When you use the "edit points", a shape changes its type to msoShapeNotPrimitive - but I couldn't figure out how to do this using VBA.
UPDATE
Played around a bit (because I'm curious) - just as an example if someone wants to change a shape manually:
' First change Shape Type:
' WILL NOT WORK: sh.AutoShapeType = msoShapeNotPrimitive
' Instead, add a node and remove it immediately. This changes the shape type.
.Nodes.Insert c, msoSegmentLine, msoEditingCorner, 100, 100
.Nodes.Delete c + 1
' Now access the x-coordinate of node 2 and the y-coordinate of node 3
' (note that we cannot access the coordinates directly)
Dim pointsArray() As Single, x As Single, y As Single
pointsArray = .Nodes(2).Points
x = pointsArray(1, 1)
pointsArray = .Nodes(3).Points
y = pointsArray(1, 2)
' Now change the x-value of node 3
sh.Nodes.SetPosition 3, x, y
http://s3.dosya.tc/server11/yvuh7e/v7m_Quadrant.zip.html
Attached you can find the table that I need help with. In "M Quadrant" sheet I have a graph and a pivot table. There's also a combobox which switches between some names and changes the pivot table therefore the graphic.
What I need is somehow automate the color of the series. When I change to a new name the series remain with their old color, i would like to have the colors via below criterias
X axis positive, Y axis positive = Green
X axis positive, Y axis negative = Orange
X axis negative, Y axis positive = Blue
X axis negative, Y axis negative = Red
or
this information is also recorded in "M Grafik" sheet, which is the resource of the pivot table, at N Column . Here are some translations :
Yeşil = Green, Kırmızı = Red, Mavi = Blue, Turuncu = Orange
I would like to add the solution below my button and combobox macros. So everytime I change the graphic, colorin should re-run.
Also a screenshot here :
Best Regards
You can use a method like this to get the X- and Y-Values from the Series objects, and then conditionally apply the R/G/B color to each Point's Fill.ForeColor and Fill.BackColor:
Sub foo()
Dim cht As Chart
Dim srs As Series
Dim pt As Excel.Point
Dim x, y
Dim s As Long
Dim p As Long
Set cht = ActiveSheet.ChartObjects(1).Chart '## Modify if needed
'Loop all series in this chart
For s = 1 To cht.SeriesCollection.Count
Set srs = cht.SeriesCollection(s)
'Loop all point in this series
For p = 1 To srs.Points.Count
'Get the x and y value of this point
x = srs.XValues(p)
y = srs.Values(p)
Set pt = srs.Points(p)
pt.Select
'assign color based on x and y value
'## NOTE: YOU NEED TO SPECIFY THE R/G/B PARAMETERS FOR EACH.
Select Case True
Case x >= 0 And y >= 0 'Green
pt.Format.Fill.ForeColor.RGB = RGB(0, 255, 0)
pt.Format.Fill.BackColor.RGB = RGB(0, 255, 0)
Case x >= 0 And y < 0 'Orange
'pt.Format.Fill.ForeColor.RGB = RGB(,,)
'pt.Format.Fill.BackColor.RGB = RGB(,,)
Case x < 0 And y >= 0 'Blue
'pt.Format.Fill.ForeColor.RGB = RGB(0,0,255)
'pt.Format.Fill.BackColor.RGB = RGB(0,0,255)
Case x < 0 And y < 0 'Red
'pt.Format.Fill.ForeColor.RGB = RGB(255,0,0)
'pt.Format.Fill.BackColor.RGB = RGB(255,0,0)
End Select
Next
Next
End Sub
Add four columns to your source data for green, orange, blue, red. Use formulas to pull the data from the original data column, according to the conditions you listed above.
Add the four new columns to the scatter chart as new series. Format each series to its respective marker color. Remove the original data series.
I'm working with a MSchart and I'm trying to figure out how to show the x-axis value based on the mouse's position in the graph. It only shows when the mouse is on a datapoint. The y-axis is scaled linearly and works as it should.
The x-axis however doesn't since it is logarithmic and gives me results this:
(0 = 0, 10 = 1, 100 = 2, 1000 = 3)
Where x = 10, it gives me a returned value of 1, where x = 100, it gives me a returned value of 2, and etc.
dim position = e.Location
dim result = myChart.hitTest(position.x, position.y)
etoolTip.active = true
if(result.ChartElementType = DataVisualization.Charting.ChartElementType.datapoint)
dim x = result.ChartArea.AxisX.PixelPositionToValue(position.x)
dim y = result.chartarea.axisy.pixelPositionToValue(position.y)
etoolTip.SetToolTip(phaseNoiseChart, "X:"&x &"Y:"&y)
else
etoolTip.active = false
End If
How do I get the x-axis's true position based on the mouse's position for an axis that is logarithmic?
since the code belongs to mouse move event
e.X will give you the x co-ordinate
e.Y will give you the y co-ordinate
I clearly didn't understand what those numbers meant until I realized what the answer was telling me. The way I turn it back into actual coordinates is by 10^x.
dim x = result.ChartArea.AxisX.PixelPositionToValue(position.x)
x = 10^x
dim y = result.chartarea.axisy.pixelPositionToValue(position.y)
etoolTip.SetToolTip(phaseNoiseChart, "X:"&x & "Y:"&y)
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)