Jump to content

Coordinates of a polyline


bhargav1987

Recommended Posts

Is there any possibility to find all the coordinates of the polyline...on which the polyline is drawn..........

 

Help with this guys...i am in need of this one for completing one program...

 

 

Expecting reply asap

Link to comment
Share on other sites

  • Replies 20
  • Created
  • Last Reply

Top Posters In This Topic

  • fixo

    8

  • bhargav1987

    7

  • Lee Mac

    2

  • MSasu

    2

Popular Days

Top Posters In This Topic

Posted Images

You didn't mention which is the customization solution you are looking for. Here is the AutoLISP approach:

 

(defun ListPLineVertexes( / thePLine PlineVertexes )
(if (setq thePLine (ssget ":S" '((0 . "LWPOLYLINE"))))
 (progn
  (setq thePLine (entget (ssname thePLine 0)))
  (foreach SubList thePLine
   (if (= (car SubList) '10)
    (setq PlineVertexes (append PlineVertexes
                                (list (cdr SubList))))
   )
  )
 )
)
PlineVertexes
)

 

Regards,

Link to comment
Share on other sites

For VBA please check this thread.

 

Regards,

Tanx for the reply ...

 

But i dont want only starting and ending coordinates....i want all the coordinates of the polyline...using VBA

 

If not possible,jst tell me if i want a point on a polyline at 1/4 of the distance how to do it using VBA...

 

Sorry for the trouble and expecting reply sir

Link to comment
Share on other sites

Tanx for the reply ...

 

i want a point on a polyline at 1/4 of the distance how to do it using VBA...

 

You need to search for Curve.cs and Vlax.cs classes

to work with polylines using ActiveX library

Attached is a quick example mostly borrowed from

Jeff Mishler which is included these classes

[Tested on A2008/A2009 earlier]

 

If you have other Acad version you need to change

the references and / or numeric extension in

the following line of code in the Vlax.cs class:

 

Set VL = ThisDrawing.Application.GetInterfaceObject("VL.Application.1")

for versions higher 2005 you need change it on this one

Set VL = ThisDrawing.Application.GetInterfaceObject("VL.Application.16")

 

 

~'J'~

UsingCurve.zip

Link to comment
Share on other sites

i want all the coordinates of the polyline...using VBA

 

 

Here is another example this will alow you to

get coordinates and then fill the acad table

 

Option Explicit
Option Base 0
Sub CoordsToTable()
Dim pickPt As Variant
Dim oEnt As AcadEntity
Dim oPline As AcadLWPolyline
Dim oTable As AcadTable
Dim col As New AcadAcCmColor
Dim coords As Variant
Dim varCoords() As Double
Dim i As Integer
Dim cnt As Integer
Dim hgt As Double
On Error GoTo Err_Control
hgt = 2#
ThisDrawing.Utility.GetEntity oEnt, pickPt, "Select a polyline"
If Err Then
Err.Clear
MsgBox "nothing selected"
Exit Sub
End If
If TypeOf oEnt Is AcadLWPolyline Then
Set oPline = oEnt
coords = oPline.Coordinates
ReDim varCoords(0 To (UBound(coords) + 1) / 2 - 1, 0 To 1) As Double
For i = 0 To UBound(coords) Step 2
varCoords(cnt, 0) = coords(i): varCoords(cnt, 1) = coords(i + 1)
Debug.Print CStr(coords(i)) & " == " & CStr(coords(i + 1))
cnt = cnt + 1
Next i
pickPt = ThisDrawing.Utility.GetPoint(, vbCr & "Pick insertion point of table: ")
Set oTable = ThisDrawing.ActiveLayout.Block.AddTable(pickPt, UBound(varCoords) + 3, 3, hgt * 2, hgt * 20)
oTable.RegenerateTableSuppressed = True
col.SetRGB 0, 56, 224
oTable.SetContentColor AcRowType.acTitleRow + _
     AcRowType.acHeaderRow + AcRowType.acDataRow, col
col.SetRGB 112, 28, 0
oTable.SetGridColor AcGridLineType.acHorzBottom + AcGridLineType.acHorzTop + _
AcGridLineType.acVertLeft + AcGridLineType.acVertRight + _
AcGridLineType.acHorzInside + AcGridLineType.acVertInside, _
AcRowType.acTitleRow + AcRowType.acHeaderRow + AcRowType.acDataRow, col
oTable.SetText 0, 0, "Coordinates"
oTable.SetText 1, 0, "Point No."
oTable.SetText 1, 1, "Easting"
oTable.SetText 1, 2, "Northing"
cnt = 1
For i = 0 To UBound(varCoords, 1)
oTable.SetText i + 2, 0, CStr(cnt)
oTable.SetCellAlignment i + 2, 0, acMiddleCenter
oTable.SetCellValue i + 2, 1, varCoords(i, 0)
oTable.SetCellDataType i + 2, 1, acDouble, acUnitless
oTable.SetCellFormat i + 2, 1, "%lu2%pr2" '<---precision 2 decimals
oTable.SetCellAlignment i + 2, 1, acMiddleLeft
oTable.SetCellState i + 2, 1, AcCellState.acCellStateContentLocked
oTable.SetCellDataType i + 2, 2, acDouble, acUnitless
oTable.SetCellValue i + 2, 2, varCoords(i, 1)
oTable.SetCellAlignment i + 2, 2, acMiddleLeft
oTable.SetCellFormat i + 2, 2, "%lu2%pr4" '<--precision 4 decimals
oTable.SetCellState i + 2, 2, AcCellState.acCellStateContentLocked
cnt = cnt + 1
Next
oTable.RegenerateTableSuppressed = False
Else
MsgBox "selected is not a lwpolyline"
GoTo Exit_Here:
End If
Exit_Here:
Set col = Nothing
Exit Sub
Err_Control:
If Err.Number <> 0 Then
Err.Clear
MsgBox Err.Description
End If
Resume Exit_Here
End Sub

 

~'J'~

Link to comment
Share on other sites

Here is another example this will alow you to

get coordinates and then fill the acad table

 

Option Explicit
Option Base 0
Sub CoordsToTable()
Dim pickPt As Variant
Dim oEnt As AcadEntity
Dim oPline As AcadLWPolyline
Dim oTable As AcadTable
Dim col As New AcadAcCmColor
Dim coords As Variant
Dim varCoords() As Double
Dim i As Integer
Dim cnt As Integer
Dim hgt As Double
On Error GoTo Err_Control
hgt = 2#
ThisDrawing.Utility.GetEntity oEnt, pickPt, "Select a polyline"
If Err Then
Err.Clear
MsgBox "nothing selected"
Exit Sub
End If
If TypeOf oEnt Is AcadLWPolyline Then
Set oPline = oEnt
coords = oPline.Coordinates
ReDim varCoords(0 To (UBound(coords) + 1) / 2 - 1, 0 To 1) As Double
For i = 0 To UBound(coords) Step 2
varCoords(cnt, 0) = coords(i): varCoords(cnt, 1) = coords(i + 1)
Debug.Print CStr(coords(i)) & " == " & CStr(coords(i + 1))
cnt = cnt + 1
Next i
pickPt = ThisDrawing.Utility.GetPoint(, vbCr & "Pick insertion point of table: ")
Set oTable = ThisDrawing.ActiveLayout.Block.AddTable(pickPt, UBound(varCoords) + 3, 3, hgt * 2, hgt * 20)
oTable.RegenerateTableSuppressed = True
col.SetRGB 0, 56, 224
oTable.SetContentColor AcRowType.acTitleRow + _
     AcRowType.acHeaderRow + AcRowType.acDataRow, col
col.SetRGB 112, 28, 0
oTable.SetGridColor AcGridLineType.acHorzBottom + AcGridLineType.acHorzTop + _
AcGridLineType.acVertLeft + AcGridLineType.acVertRight + _
AcGridLineType.acHorzInside + AcGridLineType.acVertInside, _
AcRowType.acTitleRow + AcRowType.acHeaderRow + AcRowType.acDataRow, col
oTable.SetText 0, 0, "Coordinates"
oTable.SetText 1, 0, "Point No."
oTable.SetText 1, 1, "Easting"
oTable.SetText 1, 2, "Northing"
cnt = 1
For i = 0 To UBound(varCoords, 1)
oTable.SetText i + 2, 0, CStr(cnt)
oTable.SetCellAlignment i + 2, 0, acMiddleCenter
oTable.SetCellValue i + 2, 1, varCoords(i, 0)
oTable.SetCellDataType i + 2, 1, acDouble, acUnitless
oTable.SetCellFormat i + 2, 1, "%lu2%pr2" '<---precision 2 decimals
oTable.SetCellAlignment i + 2, 1, acMiddleLeft
oTable.SetCellState i + 2, 1, AcCellState.acCellStateContentLocked
oTable.SetCellDataType i + 2, 2, acDouble, acUnitless
oTable.SetCellValue i + 2, 2, varCoords(i, 1)
oTable.SetCellAlignment i + 2, 2, acMiddleLeft
oTable.SetCellFormat i + 2, 2, "%lu2%pr4" '<--precision 4 decimals
oTable.SetCellState i + 2, 2, AcCellState.acCellStateContentLocked
cnt = cnt + 1
Next
oTable.RegenerateTableSuppressed = False
Else
MsgBox "selected is not a lwpolyline"
GoTo Exit_Here:
End If
Exit_Here:
Set col = Nothing
Exit Sub
Err_Control:
If Err.Number <> 0 Then
Err.Clear
MsgBox Err.Description
End If
Resume Exit_Here
End Sub

 

~'J'~

Tanx for the reply Fixo...but is giving only two coordinates starting nd ending of the polyline....

 

Or Else

 

Help me with this

 

Is there any way to find a point on a polyline at a distance 1/4 of the length of the polyline using VBA????

Link to comment
Share on other sites

Tanx for the reply Fixo...but is giving only two coordinates starting nd ending of the polyline....

 

Or Else

 

Help me with this

 

Is there any way to find a point on a polyline at a distance 1/4 of the length of the polyline using VBA????

 

First of try attached project from post#5

 

Secondly I guess your polyline have 2 coordinates only

 

~'J'~

Link to comment
Share on other sites

First of try attached project from post#5

 

Secondly I guess your polyline have 2 coordinates only

 

~'J'~

I have tried tat project..it is showing an error....

 

"type vla-load-com in command before running the program"

 

Atleast can u answer to my next question Plz??

 

Is there any way to find a point on a polyline at a distance 1/4 of the length of the polyline using VBA????

Link to comment
Share on other sites

I have tried tat project..it is showing an error....

 

"type vla-load-com in command before running the program"

 

Atleast can u answer to my next question Plz??

 

Is there any way to find a point on a polyline at a distance 1/4 of the length of the polyline using VBA????

Ugrrr...

Just type in the AutocAD window commanline

(vl-load-com)

with brackets

then run the project again

 

~'J'~

Link to comment
Share on other sites

Ugrrr...

Just type in the AutocAD window commanline

(vl-load-com)

with brackets

then run the project again

 

~'J'~

Tanx,It is working now....

 

Can i ask u for one more help?

 

Is there any way to find a point on a polyline at a distance 1/4 of the length of the polyline using VBA????

 

It it will be very helpful 4 me..IF u help me with this one

Link to comment
Share on other sites

Tanx,It is working now....

 

Can i ask u for one more help?

 

Is there any way to find a point on a polyline at a distance 1/4 of the length of the polyline using VBA????

 

It it will be very helpful 4 me..IF u help me with this one

 

This project already find a point on a polyline at a distance 1/4 of the length of the polyline and insert the circle wityh radius = 10 at this point just to show you how it works :)

 

~'J'~

Link to comment
Share on other sites

You're welcome

 

~'J'~

 

Fixo..Can u help me with this one more most important problem of me.....:)

 

I have attached a picture with it..in it u can see a polyline above which values are present...i want a program so tat i will automatically place an arrow on the polyline depending on the value above the polyline....

 

Only hitch i found while doing this is .....the arrow rotation ....depending on the polyline angle/..:cry:

 

If polyline is drawn from point x ot point y it is giving one angle or if the polyline is drawn from point y to point x it is giving a different angle....which is affecting the arrow rotation ....:(

 

Please help with this....arrow placing on a polyline with the value present above the polyline....using VBA...

 

Expecting reply nd sorry for bothering u

Picture1.jpg

Link to comment
Share on other sites

Fixo..Can u help me with this one more most important problem of me.....:)

 

I have attached a picture with it..in it u can see a polyline above which values are present...i want a program so tat i will automatically place an arrow on the polyline depending on the value above the polyline....

 

Only hitch i found while doing this is .....the arrow rotation ....depending on the polyline angle/..:cry:

 

If polyline is drawn from point x ot point y it is giving one angle or if the polyline is drawn from point y to point x it is giving a different angle....which is affecting the arrow rotation ....:(

 

Please help with this....arrow placing on a polyline with the value present above the polyline....using VBA...

 

Expecting reply nd sorry for bothering u

 

Sorry. I can't

Perhaps somebody else could be able to solve this task

 

~'J'~

Link to comment
Share on other sites

Such is forum life. :lol:

 

Thanks Alan & Lee

You so have make me fun, guys, that I have fallen from an chair:lol:

 

In fact I would be able to doing what bhargav need but

 

I have a lot of my very own problems here...

 

Regards,

 

Oleg

 

~'J'~

Link to comment
Share on other sites

In fact I would be able to doing what bhargav need but

 

I'm positive that you could - but let us not forget that we are not here to serve others...

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...