Vba Pline... Better Way?

Vba Pline... Better Way?

Anonymous
Not applicable
295 Views
2 Replies
Message 1 of 3

Vba Pline... Better Way?

Anonymous
Not applicable
I have manage to create a pline on demand with my vba program written like this :
(but I find it preatty "beginner"...)
There must be a better way???

Public Sub GoforTheLine()
InsBlock.Hide
Dim plineObj As AcadPolyline
Dim returnPnt As Variant
' This example returns a point entered by the user.
Dim newVertex(0 To 2) As Double
Dim basePnt(0 To 2) As Double
Dim endPnt(0 To 2) As Double
Dim returnPntList(0 To 5) As Double
basePnt(0) = MainGlobal.insertionPnt(0): basePnt(1) = MainGlobal.insertionPnt(1): basePnt(2) = MainGlobal.insertionPnt(2)
' Return a point using a prompt
On Error Resume Next
I = 0
While IsNull(returnPnt) = False
returnPnt = ThisDrawing.Utility.GetPoint(basePnt, "Pick the next point: ")
If Err Then GoTo FINEND
If (I > 0) Then
newVertex(0) = returnPnt(0): newVertex(1) = returnPnt(1): newVertex(2) = returnPnt(2)
plineObj.AppendVertex newVertex
Else
returnPntList(0) = basePnt(0)
returnPntList(1) = basePnt(1)
returnPntList(2) = basePnt(2)
returnPntList(3) = returnPnt(0)
returnPntList(4) = returnPnt(1)
returnPntList(5) = returnPnt(2)
Set plineObj = ThisDrawing.ModelSpace.AddPolyline(returnPntList)
If MainGlobal.ajretG = True Then
Call Group.AjoutRetrait 'Ajouter au groupe l'objet précédent
End If
End If
basePnt(0) = returnPnt(0)
basePnt(1) = returnPnt(1)
basePnt(2) = returnPnt(2)
I = I + 1
ThisDrawing.Regen (acActiveViewport)
Wend

FINEND:
'plineObj.SetWidth 0, 1, 1 ''' actually this is not working
End Sub

The goal of the program is to create a ballon type... You know... A circle with attributes with a "pline2 starting from the "insertion" [insertionPnt] point to the pointed object...
0 Likes
296 Views
2 Replies
Replies (2)
Message 2 of 3

Anonymous
Not applicable
Your code looks good.  Here are some changes
that shorten it a little, but when working with PLINE's, you will always have
some lines of (0),(1),(2),... 

 

I put some comments about what I did above the
code. 

 

James

 

<PRE>
' you don't *need* to use newVertex(), you can send returnPt
variant to AppendVertex.
' instead of using counter I, put the first GetPoint
before loop.  You know you're going to do at least one GetPoint...
' use
the previous returnPnt as the input to GetPoint, so you don't need variable
basePnt within the loop
' SetWidth now sets the width of all the
segments
' I removed references to InsBlock, MainGlobal, and Group to
get it to run on my machine

 

Public Sub GoforTheLine()
'InsBlock.Hide
  

   Dim I As Long  'new -- so it would  run on my
machine
   Dim plineObj As AcadPolyline
   Dim
returnPnt As Variant
   ' This example returns a point entered by
the user.
   'Dim newVertex(0 To 2) As Double
   Dim
basePnt(0 To 2) As Double
   Dim endPnt(0 To 2) As
Double
   Dim returnPntList(0 To 5) As Double
  
basePnt(0) = 0: basePnt(1) = 0: basePnt(2) = 0
   ' Return a point
using a prompt
   On Error Resume Next
  

   returnPnt = ThisDrawing.Utility.GetPoint(basePnt, "Pick the
next point: ")
   If Err Then GoTo FINEND
  
returnPntList(0) = basePnt(0)
   returnPntList(1) =
basePnt(1)
   returnPntList(2) = basePnt(2)
  
returnPntList(3) = returnPnt(0)
   returnPntList(4) =
returnPnt(1)
   returnPntList(5) = returnPnt(2)
   Set
plineObj = ThisDrawing.ModelSpace.AddPolyline(returnPntList)
  

While IsNull(returnPnt) = False
   returnPnt =
ThisDrawing.Utility.GetPoint(returnPnt, "Pick the next point: ")
  
If Err Then GoTo FINEND
  
   plineObj.AppendVertex
returnPnt
   ThisDrawing.Regen (acActiveViewport)
Wend

 

FINEND:

 

Select Case plineObj.Type
Case acCubicSplinePoly,
acQuadSplinePoly
   ' .SetWidth would fail on these types of
PLINE's, according to help file
Case Else
   Dim vertexCount As
Long
   vertexCount = (UBound(plineObj.Coordinates) -
LBound(plineObj.Coordinates) + 1) / 3
   MsgBox
vertexCount
   For I = 0 To vertexCount -
2
      plineObj.SetWidth I, 1, 1 'changes I'th
segment
   Next 'i
End Select

 

End Sub

 

</PRE>
0 Likes
Message 3 of 3

Anonymous
Not applicable
I like to declare global constants for X,Y,Z as follows to make the code easier to read.


Const X As Byte = 0, Y As Byte = 1, Z As Byte = 2

' Then you can do things like...

Dim basePnt(X To Z) As Double

' and...

returnPntList(4) = returnPnt(Y)

Regards



Wayne Ivory

IT Analyst Programmer

Wespine Industries Pty Ltd
0 Likes