Get Coordinates of Polylines from AutoCAD to Excel - Visual Basic , VB.NET

	Find Code:
Home : Code : Forums : Submit : Mailing List : About : Contact

All

VB.NET

ASP.NET

C#

Snippets

Popular

Forums

Articles

Tips

Links

Books

Contest

Get Coordinates of Polylines from AutoCAD to Excel
Author: Sajid Javid
Submitted: 11/15/2014
Version: VB6
Compatibility: VB6
Category: Graphics
Views: 14356
This is Excel VBA Code to get coordinates of Polylines from AutoCAD as you will select Polyline/Polylines .You can get Coordinates of more than one polyline at a time.Program will create empty row between coordinates of polylines in Excel.
Declarations:
Private Sub CommandButton2_Click() Dim rox,coy as Double Dim sname as String rox=2:coy=1 sname="Sheet1" MsgBox "- Select Polyline/Polylines from AutoCAD for And Press Enter - ", vbInformation, "Select Polyline" Call getOtherPolylineCoordinatesFromAutoCAD(rox, coy, sname) End Sub
Code:
Sub getOtherPolylineCoordinatesFromAutoCAD(ByVal cx As Integer, ByVal cy As Integer, ByVal sname As String) Set NewDC = GetObject(, "AutoCAD.Application") Set A2Kdwg = NewDC.ActiveDocument Dim Selection As AcadSelectionSet Dim poly As AcadLWPolyline Dim Obj As AcadEntity Dim Bound As Double Dim x, y As Double Dim rows, i, scount As Integer '---Search Object from SelectionSet and Delete If Found ----'' For i = 0 To A2Kdwg.SelectionSets.count - 1 If A2Kdwg.SelectionSets.Item(i).Name = "AcDbPolyline" Then ''-- Delete Object Name from AutoCAD SelectionSet ---'' A2Kdwg.SelectionSets.Item(i).Delete Exit For End If Next i ''-- Add Object to AutoCad SelectionSet ----'' Set Selection = A2Kdwg.SelectionSets.Add("AcDbPolyline") ''-- Select Object from AutoCad Screen ---''' Selection.SelectOnScreen ''-- Get Coordinates of Object if Object name is ACadPolyline--'' rows = cx For Each Obj In Selection If Obj.ObjectName = "AcDbPolyline" Then ''- Set Obj as Polyline--'' Set poly = Obj On Error Resume Next ''-- Set Size of Coordinates Like array Size--'' Bound = UBound(poly.Coordinates) '' Starting Index of Excel Row to insert Coordinates --'' rows = rows ''-- Display Coordinates one by one to Excel Columns --''' For i = 0 To Bound ''-- Set Coordinates into Variables--''' x = Round(poly.Coordinates(i), 3) y = Round(poly.Coordinates(i + 1), 3) ''-- Set Coordinates into Excel Columns --''' Worksheets(sname).Cells(rows, cy) = Round(x, 3) Worksheets(sname).Cells(rows, cy + 1) = Round(y, 4) ''- Increment variable for Excel Rows ---'' rows = rows + 1 ''--- Increment Counter variable to get Next point of Polyline --''' i = i + 1 Next Else MsgBox "--- This is not a Polyline --- ", vbInformation, "Please Select a Polyline" End If rows = rows + 1 Next Obj End Sub