Jump to content
quangducnguyen

Get coordinate of polyline by VBA

Recommended Posts

quangducnguyen

Hi,

I've just started learning VBA in CAD.I wanna select polyline onscreen and then get its coordinate(of every vertex).But I don't know how to do it.

Thanks for any help.

Bye

Share this post


Link to post
Share on other sites
Steven Bastiaanse

Something like this?

 

Sub Example_Coordinates()

Dim Selection As AcadSelectionSet
Dim Poly As AcadLWPolyline
Dim Obj As AcadEntity
Dim Bound As Double

'Makes a selectionset.
'On Error Resume Next
   Set Selection = ThisDrawing.SelectionSets.Item("Select polyline.")
If Err Then
   Set Selection = ThisDrawing.SelectionSets.Add("Select polyline.")
   Err.Clear
Else
   Selection.Clear
End If

'Select the polyline.
Selection.SelectOnScreen

For Each Obj In Selection

   If Obj.ObjectName = "AcDbPolyline" Then
       
           Set Poly = Obj
           On Error Resume Next
           
           Bound = UBound(Poly.Coordinates)
           
           x = 0
           y = 1
           
           For i = 0 To Bound / 2
               
               MsgBox "X= " & Poly.Coordinates(x) & "  Y= " & Poly.Coordinates(y)
               If Err Then Err.Clear
               
               x = x + 2
               y = y + 2
               
           Next
         
   End If

Next Obj

End Sub

 

I hope this helps you!

 

Greetings

Share this post


Link to post
Share on other sites
vitaminm

Hello, someone please,

 

Sub Example_Coordinates()

without the sub xx()

 

how to run this code?

Share this post


Link to post
Share on other sites
ketxu

Try to change ( by ( and ) by ) in code

Share this post


Link to post
Share on other sites
fixo
Hello, someone please,

 

Sub Example_Coordinates()

without the sub xx()

 

how to run this code?

 

Try another one instead,type vbarun in the command line,

select "demo" sub

 

 
Option Explicit
Function PolyCoords(oEnt As AcadEntity) As Variant
    Dim cnt As Integer
    Dim i As Integer
    Dim j As Integer
    Dim iStep As Integer
    Dim varPt As Variant
    Dim dblCoords() As Double
    Dim dblVert() As Double

    If TypeOf oEnt Is AcadLWPolyline Then
         iStep = 2
    ElseIf TypeOf oEnt Is Acad3DPolyline Or _
           TypeOf oEnt Is AcadPolyline Then
         iStep = 3
    End If
    dblCoords = oEnt.Coordinates

    ReDim ptsArr(0 To (UBound(dblCoords) + 1) \ iStep - 1, 0 To iStep - 1) As Double
    For i = 0 To (UBound(dblCoords) + 1) \ iStep - 1
         For j = 0 To iStep - 1
              ptsArr(i, j) = dblCoords(cnt)
              Debug.Print ptsArr(i, j)
              cnt = cnt + 1
         Next
    Next
    PolyCoords = ptsArr
End Function

Sub demo()
    Dim pts As Variant
    Dim varPt As Variant
    Dim oEnt As AcadEntity
    ThisDrawing.Utility.GetEntity oEnt, varPt, vbCr & "Select polyline"
    If Not TypeOf oEnt Is AcadLWPolyline And _
       Not TypeOf oEnt Is Acad3DPolyline And _
       Not TypeOf oEnt Is AcadPolyline Then
         MsgBox "Method is not applicable for this entity type"
         Exit Sub
    End If
    pts = PolyCoords(oEnt)
End Sub

 

Next tyme post your question on VBA branch, please:

http://www.cadtutor.net/forum/forumdisplay.php?69-.NET-ObjectARX-amp-VBA

 

~'J'~

Edited by fixo

Share this post


Link to post
Share on other sites
vitaminm
Try to change ( by ( and ) by ) in code

 

Ya, tq, it woks now!

Share this post


Link to post
Share on other sites
Karma

I’m a bit discouraged, I started to learn acad-vba since a few days too & I wanted to understand Steven Bastiaanse’s example which seems simple.

Why #40 & #41 , what does it mean.

Set Selection = ThisDrawing.SelectionSets.Item (”Select polyline” & #41; ???

(ThisDrawing.selectionsets) expected object or method isn’t it?

Thanks for helping me

Share this post


Link to post
Share on other sites
imagination_s

Hello Sir

Please hlep me with this

I need to add a polyline based of part of coodonates of first polyline

So i need to copy vertex example from 0 to 5 of first polyline.

Thnakyou

Share this post


Link to post
Share on other sites
BIGAL

Here is a VL example you will end up with a variable co-ordsxy which contains all the pts for a 2d pline as 2 values (x1 y1 x2 y2 x3 y3..... you can then get each pair from the list using nth x & nth (+ x 1)

 

; pline co-ords example
; By Alan H
(defun getcoords (ent)
 (vlax-safearray->list
   (vlax-variant-value
     (vlax-get-property
   (vlax-ename->vla-object ent)
   "Coordinates"
     )
   )
 )
)

(defun co-ords2xy ()
; convert now to a list of xy as co-ords are x y x y x y if 3d x y z x y z
(setq len (length co-ords))
(setq numb (/ len 2)) ; even and odd check required
(setq I 0)
(repeat numb
(setq xy (list (nth i co-ords)(nth (+ I 1) co-ords) ))
; odd (setq xy (list (nth i co-ords)(nth (+ I 1) co-ords)(nth (+ I 2) co-ords) ))
(setq co-ordsxy (cons xy co-ordsxy))
(setq I (+ I 2))
)
)
; program starts here
(setq co-ords (getcoords (car (entsel "\nplease pick pline"))))
(co-ords2xy) ; list of 2d points making pline

Share this post


Link to post
Share on other sites
imagination_s

Please do not get upset for me asking.

Is there a way to do this in vba macro for autocad not lisp?

Thankyou very much.

Share this post


Link to post
Share on other sites
BIGAL

Fixo's code above Debug.Print ptsArr(i, j) will contain the points. So something like x= ptsArr(i) y=ptsArr(j) I am sure Fixo will confirm.

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×