I am trying to plot a polyline between multiple points in vba into autocad. I have almost finished my code, but the thing is that the points may repeat themselves, as 2 lines can have the same starting point, and the points are nor in a sorted way.
I need to be able to addd all points even if they aren't sorted, cause I have to keep the order of the points I am tryint to plot.
I am getting this error:
Invalid Procedure or argument call
Set acadPol = acadDoc.ModelSpace.AddLightWeightPolyline(Points)
This is my code:
Points(1)=9736.242889: Points(2)=9954.553808
Points(3)=9718.429708: Points(4)=9936.874562
If acadDoc.ActiveSpace = acModelSpace Then
Set acadPol = acadDoc.ModelSpace.AddLightWeightPolyline(Points)
Else
Set acadPol = acadDoc.PaperSpace.AddLightWeightPolyline(Points)
End If
acadPol.Closed = False
acadPol.Update
End If
End If
Your code is incomplete but I notice you have started your coordinates list at index 1.
There are plenty of examples on the internet
Sub Example_AddLightWeightPolyline()
' This example creates a lightweight polyline in model space.
Dim plineObj As AcadLWPolyline
Dim points(0 To 9) As Double
' Define the 2D polyline points
points(0) = 1: points(1) = 1
points(2) = 1: points(3) = 2
points(4) = 2: points(5) = 2
points(6) = 3: points(7) = 2
points(8) = 4: points(9) = 4
' Create a lightweight Polyline object in model space
Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
ZoomAll
End Sub
As you can see, you need to start your coordinates array at index 0 and not 1.
Does this help?
Related
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
Why does the messagebox show "False"?
Dim images(4, 4) As Image
For rows = 0 To 4
For columns = 0 To 4
images(rows, columns) = My.Resources.kaboom
Next
Next
MessageBox.Show(images(3, 3).Equals(My.Resources.kaboom))
If you look at the code behind the kaboom property, you will see it creates a new object every time.
'''<summary>
''' Looks up a localized resource of type System.Drawing.Bitmap.
'''</summary>
Friend ReadOnly Property kaboom() As System.Drawing.Bitmap
Get
Dim obj As Object = ResourceManager.GetObject("kaboom", resourceCulture)
Return CType(obj,System.Drawing.Bitmap)
End Get
End Property
If you keep a reference to one object, it will be equal to true. It might also be faster since it doesn't need to create a new object.
Dim kaboom As Image = My.Resources.kaboom
Dim images(4, 4) As Image
For rows = 0 To 4
For columns = 0 To 4
images(rows, columns) = kaboom
Next
Next
MessageBox.Show(images(3, 3).Equals(kaboom))
Maybe you are already planning on doing this but here is a suggestion. If you are creating some sort of game, separate the display from the game logic. This mean, save the type of tile instead of the image and compare that. Later, you can add a bunch of different properties to a tile.
Const TYPE_KABOOM As Integer = 1
Dim tileType(4, 4) As Integer
For rows = 0 To 4
For columns = 0 To 4
tileType(rows, columns) = TYPE_KABOOM
Next
Next
MessageBox.Show(tileType(3, 3).Equals(TYPE_KABOOM))
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'm attempting to graph lnD and i, where i is the x-axis, and lnD is the y-axis. I have an equation that I'm putting a range of values for i into, and attempting to retrieve values of lnD.
However, I came across an odd issue. First off, here is the code. I should note that it causes my Excel to freeze up for a few seconds, but it doesn't crash or anything.:
Tracker = 0
Alpha = -1.593975
Beta = -334.6942
For i = 0 To 0.1 Step 0.01
Tracker = Tracker + 1
lnD = Beta * i + Alpha
Range("XFB" & Tracker).Value = i
Range("XFC" & Tracker).Value = lnD
Next i
I get the error "Method 'Range' of object '_Global' failed". And when I look at the columns where the data should be, it is just i = 0 and lnD = -1.593975, repeating over and over again. When I look at the value of Tracker, it has increased into the 10 thousands, and since all of the columns are full to the bottom of excel, that means the loop is actually looping. But why is i getting stuck at zero, and not increasing? Why am I getting this error?
EDIT: I should note that if you change the top line to For i = 0 to 10 step 1, it works... So does this have to do with the numbers I'm putting in?
EDIT 2: So, after getting advice that it's an error not present in the code I put here, I looked into my variable declarations. The issue ended up being that I declared i as an integer! That made it round down to zero, causing the loop to get stuck at i = 0, and never making it to a "stopping point". Just a silly mistake!
I'm not going to delete this post, only because I feel like I should put my stupidity on display. Thank you for helping, everyone!
Your code does work on my PC (after changing the columns to "A" and "B" as I'm working in Excel 2010 and my columsn don't run up all the way to where you're writing to). Your comments seem to be indicating that your actually looping over a lot more values for i than you're stating ("Tracker is in the 10,000s while i only goes through 10 steps), can something there cause a problem?
As an aside, writing single cells values to excel is very unlikely to be efficient. A lot quicker will be writing everything into an array and then writing the array to excel.
What works on my excel is (please note that I change the start of the output to "A1", be careful you don't overwrite any data):
Sub test()
' Parameters
Dim Alpha#: Alpha = -1.593975
Dim Beta#: Beta = -334.6942
Dim nmbOfSteps&: nmbOfSteps = 11&
Dim increment#: increment = 0.01
Dim startValue#: startValue = 0#
' Fill in values in an array
Dim result() As Double, cntr&
ReDim result(1 To nmbOfSteps, 1 To 2)
For cntr = 1 To nmbOfSteps
Dim iValue#: iValue = startValue + CDbl(cntr - 1&) * increment
result(cntr, 1) = iValue
result(cntr, 2) = Alpha + Beta * iValue
Next cntr
' Write the entire array in one go
ThisWorkbook.ActiveSheet.Range("A1").Resize(nmbOfSteps, 2).Value2 = result
End Sub
Try the following. Rather than moving the target range, I always find it better to fix on the top of my trget and use offset to populate the cells bwllow and to the right.
Sub testit()
Dim StartCell As Range
tracker = 0
Alpha = -1.593975
Beta = -334.6942
Set StartCell = ActiveSheet.Range("XFB1")
For i = 0 To 0.1 Step 0.01
lnD = Beta * i + Alpha
StartCell.Offset(tracker, 0).Value = i
StartCell.Offset(tracker, 1).Value = lnD
tracker = tracker + 1
Next i
End Sub
I am trying to remove all empty series out of an Excel graph.
Dim isEmptySeries As Boolean
For Series = 1 To .SeriesCollection.count
.SeriesCollection(Series).ApplyDataLabels Type:=xlDataLabelsShowValue, AutoText:=True, LegendKey:=False
isEmptySeries = True
For i = 1 To .SeriesCollection(Series).points.count
If .SeriesCollection(Series).points(i).DataLabel.Text = 0 Then
.SeriesCollection(Series).points(i).HasDataLabel = False
Else
isEmptySeries = False
.SeriesCollection(Series).points(i).DataLabel.Font.Size = 17
End If
Next i
If isEmptySeries Then
.SeriesCollection(Series).Delete
End If
Next Datenreihe
The script fails at the ApplyDatalabels line ("Method SeriesCollection of Object Chart failed").
I believe that Excel shifts the Series indexes when one of the Series is deleted? Is that the case? It's the only explanation that I have for the error.
How else would I loop through the series and remove the ones that are empty?
In these sorts of situations try looping in reverse order
For i = .SeriesCollection(Series).points.count To 1 Step -1
That way the .Delete doesn't effect the item yet to be looped through