Author Topic: Civil3D VBA - Excel Parcels  (Read 14588 times)

0 Members and 1 Guest are viewing this topic.

MSTG007

  • Gator
  • Posts: 2598
  • I can't remeber what I already asked! I need help!
Re: Civil3D VBA - Excel Parcels
« Reply #15 on: March 07, 2014, 11:13:56 AM »
Ok I have done my best to intergrate this together

The parcel I have has that UDF (CN) and we manually input the value.

I am erroring out here:
Code: [Select]
CN = .GetUserDefinedPropertyValue("CN")
Code: [Select]
Sub PickLwPolyAndGetData()

Dim MyCell As Range
Dim ACAD As AcadApplication
Dim LWPoly As AcadLWPolyline
Dim oParcel As AeccParcel
Dim ThisDrawing As AcadDocument
Dim Pt1 As Variant
Dim LWArea As Double, LWZ As Double
Dim CN As Variant


' Autocad Session handling
On Error Resume Next
Set ACAD = GetObject(, "AutoCAD.Application")
On Error GoTo 0
If ACAD Is Nothing Then
Set ACAD = New AcadApplication
ACAD.Visible = True
End If

Set ThisDrawing = ACAD.ActiveDocument


' select LwPolyline
On Error Resume Next
Do
Err.Clear
ThisDrawing.Utility.GetEntity oParcel, Pt1, "Select a Parcel:"
Loop While Err
On Error GoTo 0

   
    'get LWPoly data
'    With LWPoly
'        LWArea = .Area
'        LWZ = .Elevation
'    End With

'get oParcel data
With oParcel
LWArea = .Statistics.Area
LWZ = .Statistics.Perimeter
CN = .GetUserDefinedPropertyValue("CN")
End With


' write LWPoly data on worksheet
Set MyCell = ActiveCell
With MyCell
.Offset(0, 0).Value = "Area:"
.Offset(0, 1).Value = LWArea
.Offset(0, 2).Value = User1
.Offset(1, 0) = "Perimeter:"
.Offset(1, 1) = LWZ
.Offset(1, 2) = CN
End With

Set ThisDrawing = Nothing
Set ACAD = Nothing


End Sub




Civil3D 2020

Jeff_M

  • King Gator
  • Posts: 4087
  • C3D user & customizer
Re: Civil3D VBA - Excel Parcels
« Reply #16 on: March 07, 2014, 11:33:05 AM »
I have found that while you can change the value of UDP's in a parcel's properties, if the Site's Parcels UDP Classification Property is not set then it can't be retrieved.


MSTG007

  • Gator
  • Posts: 2598
  • I can't remeber what I already asked! I need help!
Re: Civil3D VBA - Excel Parcels
« Reply #17 on: March 07, 2014, 11:37:59 AM »
Ok. The (CN) is [Unclassified].

As for the Sites. I have several Sites. (1,2,3) with parcels under each.
Civil3D 2020

MSTG007

  • Gator
  • Posts: 2598
  • I can't remeber what I already asked! I need help!
Re: Civil3D VBA - Excel Parcels
« Reply #18 on: March 07, 2014, 12:08:15 PM »
Just thinking about this alittle more. Is there a way we can hard code the UDP to be (Unclassified) within the script?
That way it show not error out on the objects that it will select. Or am I not quit following?
Civil3D 2020

Jeff_M

  • King Gator
  • Posts: 4087
  • C3D user & customizer
Re: Civil3D VBA - Excel Parcels
« Reply #19 on: March 07, 2014, 12:09:21 PM »
Can you post your drawing? And which version of C3D are you using?

MSTG007

  • Gator
  • Posts: 2598
  • I can't remeber what I already asked! I need help!
Re: Civil3D VBA - Excel Parcels
« Reply #20 on: March 07, 2014, 12:16:06 PM »
Lets try this... its a 2013. That is what I am working with.
Civil3D 2020

Jeff_M

  • King Gator
  • Posts: 4087
  • C3D user & customizer
Re: Civil3D VBA - Excel Parcels
« Reply #21 on: March 07, 2014, 01:07:14 PM »
OK, like I said before.... :-D Neither of these Site's Parcels properties have the UDP Classification set, so it will fail to get any UDP's.



MSTG007

  • Gator
  • Posts: 2598
  • I can't remeber what I already asked! I need help!
Re: Civil3D VBA - Excel Parcels
« Reply #22 on: March 07, 2014, 01:33:11 PM »
Working! I just saw RICVBA revise his script to do multiple parcels at one time. I have tried to intergrate your code into his; but I can not select anything. Everything else seemed to match up.

Code: [Select]
Sub PickLwPolysAndGetData()
   
'for Excel sheet managing purposes
Dim MySht As Worksheet
Dim MyCell As Range

'for Autocad application managing purposes
Dim ACAD As AcadApplication
Dim ThisDrawing As AcadDocument
Dim LWPoly As AcadLWPolyline
Dim oParcel As AeccParcel
'Dim Pt1 As Variant
Dim CN As Variant

' for selection set purposes
Dim ssetObj As AcadSelectionSet
Dim gpCode(0) As Integer
Dim dataValue(0) As Variant

'for general variables managing purposes
Dim iRow As Long
Dim LWArea As Double, LWZ As Double


' Autocad Session handling
    On Error Resume Next
    Set ACAD = GetObject(, "AutoCAD.Application")
    On Error GoTo 0
    If ACAD Is Nothing Then
        Set ACAD = New AcadApplication
        ACAD.Visible = True
    End If
    Set ThisDrawing = ACAD.ActiveDocument
     

' selecting LwPolylines on screen by selelection set filtering method
    ' managing potential selection set exsistence
    On Error Resume Next
    'Set ssetObj = ThisDrawing.SelectionSets.Item("LWPolySSET")
    Set ssetObj = ThisDrawing.SelectionSets.Item("oParcelSSET")
   
    'ThisDrawing.Utility.GetEntity oParcel, Pt1, "Select a Parcel:" <------- This is from the Code you did
   
    'If Err Then Set ssetObj = ThisDrawing.SelectionSets.Add("LWPolySSET")
    If Err Then Set ssetObj = ThisDrawing.SelectionSets.Add("oParcelSSET")
    On Error GoTo 0
    ssetObj.Clear
   
    'setting filtering critera
    gpCode(0) = 0
    dataValue(0) = "Parcel"
   
    'selecting LWPolylines
    ssetObj.SelectOnScreen gpCode, dataValue

' processing LWPolylines

    If ssetObj.Count > 0 Then
   
        ' writing sheet headings
        Set MySht = ActiveSheet
        Set MyCell = MySht.Cells(3, 2) 'Where to Start the Excel Cell Input X, Y
        With MyCell
            '.Offset(0, 0).Value = "LWPoly nr"
            .Offset(0, 1).Value = "Area"
            .Offset(0, 0) = "Z"
        End With
       
        'clearing previous written data
        iRow = MySht.Cells(MySht.Rows.Count, 1).End(xlUp).Row
        If iRow > 1 Then MyCell.Offset(1, 0).Resize(iRow - 1, 3).Clear
       
        'retrieving LWPolys data and writing them on worksheet
        iRow = 1
        For Each oParcel In ssetObj
            'retrieving LWPoly data
            With oParcel
                LWArea = .Statistics.Area
                'LWZ = .Statistics.Perimeter
                CN = .GetUserDefinedPropertyValue("CN")
            End With
           
            ' writing LWPoly data
            With MyCell
                '.Offset(iRow, 0).Value = "LWPoly nr." & iRow
                .Offset(iRow, 1).Value = LWArea
                .Offset(iRow, 0) = LWZ
            End With
            iRow = iRow + 1
        Next oParcel
       
    End If

' cleaning up before ending
    ssetObj.Delete
    Set ssetObj = Nothing
    Set ThisDrawing = Nothing
    Set ACAD = Nothing

End Sub


Civil3D 2020

Jeff_M

  • King Gator
  • Posts: 4087
  • C3D user & customizer
Re: Civil3D VBA - Excel Parcels
« Reply #23 on: March 07, 2014, 02:05:27 PM »
In C3D select a Parcel (one with just a few sides, as it lists all the segments) and LIST it. The name to be used for dataValue will be shown.

Hint: AECC_PARCEL

MSTG007

  • Gator
  • Posts: 2598
  • I can't remeber what I already asked! I need help!
Re: Civil3D VBA - Excel Parcels
« Reply #24 on: March 07, 2014, 02:35:09 PM »
Got it. Got to love all this stuff. So with the revised code, I can select things but it seems the T.C. value will not filter thru on the drawing you have. I can populate the name but not the tc for some reason.

Code: [Select]
Sub PickLwPolysAndGetData()
   
'for Excel sheet managing purposes
Dim MySht As Worksheet
Dim MyCell As Range

'for Autocad application managing purposes
Dim ACAD As AcadApplication
Dim ThisDrawing As AcadDocument
Dim LWPoly As AcadLWPolyline
Dim oParcel As AeccParcel
'Dim Pt1 As Variant
Dim CN As Variant
Dim TC As Variant
Dim Name As Variant

' for selection set purposes
Dim ssetObj As AcadSelectionSet
Dim gpCode(0) As Integer
Dim dataValue(0) As Variant

'for general variables managing purposes
Dim iRow As Long
Dim LWArea As Double, LWZ As Double


' Autocad Session handling
    On Error Resume Next
    Set ACAD = GetObject(, "AutoCAD.Application")
    On Error GoTo 0
    If ACAD Is Nothing Then
        Set ACAD = New AcadApplication
        ACAD.Visible = True
    End If
    Set ThisDrawing = ACAD.ActiveDocument
     

' selecting LwPolylines on screen by selelection set filtering method
    ' managing potential selection set exsistence
    On Error Resume Next
    'Set ssetObj = ThisDrawing.SelectionSets.Item("LWPolySSET")
    Set ssetObj = ThisDrawing.SelectionSets.Item("oParcelSSET")
    'Set ssetObj = ThisDrawing.SelectionSets.Item("AECC_PARCEL")
   
    'ThisDrawing.Utility.GetEntity oParcel, Pt1, "Select a Parcel:"
   
    'If Err Then Set ssetObj = ThisDrawing.SelectionSets.Add("LWPolySSET")
    If Err Then Set ssetObj = ThisDrawing.SelectionSets.Add("oParcelSSET")
    'If Err Then Set ssetObj = ThisDrawing.SelectionSets.Add("AECC_PARCEL")
    On Error GoTo 0
    ssetObj.Clear
   
    'setting filtering critera
    gpCode(0) = 0
    dataValue(0) = "AECC_PARCEL"
   
    'selecting LWPolylines
    ssetObj.SelectOnScreen gpCode, dataValue

' processing LWPolylines

    If ssetObj.Count > 0 Then
   
        ' writing sheet headings
        Set MySht = ActiveSheet
        Set MyCell = MySht.Cells(3, 2) 'Where to Start the Excel Cell Input X, Y
        With MyCell
            '.Offset(0, 0).Value = "LWPoly nr"
            .Offset(0, 1).Value = "Area"
            .Offset(0, 0) = "Perimeter"
            .Offset(0, 2) = "CN"
            .Offset(0, 3) = "TC"
            .Offset(0, 4) = "Name"
        End With
       
        'clearing previous written data
        iRow = MySht.Cells(MySht.Rows.Count, 1).End(xlUp).Row
        If iRow > 1 Then MyCell.Offset(1, 0).Resize(iRow - 1, 3).Clear
       
        'retrieving LWPolys data and writing them on worksheet
        iRow = 1
        For Each oParcel In ssetObj
            'retrieving LWPoly data
            With oParcel
                LWArea = .Statistics.Area
                Perimeter = .Statistics.Perimeter
                CN = .GetUserDefinedPropertyValue("CN")
                TC = .GetUserDefinedPropertyValue("T.C.")
                Name = .DisplayName
            End With
           
            ' writing LWPoly data
            With MyCell
                '.Offset(iRow, 0).Value = "LWPoly nr." & iRow
                .Offset(iRow, 1).Value = LWArea
                .Offset(iRow, 0) = Perimeter
                .Offset(iRow, 2) = CN
                .Offset(iRow, 3) = TC
                .Offset(iRow, 3) = Name
            End With
            iRow = iRow + 1
        Next oParcel
       
    End If

' cleaning up before ending
    ssetObj.Delete
    Set ssetObj = Nothing
    Set ThisDrawing = Nothing
    Set ACAD = Nothing

End Sub


Civil3D 2020

Jeff_M

  • King Gator
  • Posts: 4087
  • C3D user & customizer
Re: Civil3D VBA - Excel Parcels
« Reply #25 on: March 07, 2014, 03:20:48 PM »
You are overwriting the TC in the cell with the name:

                .Offset(iRow, 3) = TC
                .Offset(iRow, 3) = Name

MSTG007

  • Gator
  • Posts: 2598
  • I can't remeber what I already asked! I need help!
Re: Civil3D VBA - Excel Parcels
« Reply #26 on: March 07, 2014, 03:24:49 PM »
ok. Guess what. I am done! Thank you so so much! I learned a lot today from you. Thank you for taking the time to go thru this with me as well.
Civil3D 2020

MSTG007

  • Gator
  • Posts: 2598
  • I can't remeber what I already asked! I need help!
Re: Civil3D VBA - Excel Parcels
« Reply #27 on: June 11, 2014, 12:31:52 PM »
Sorry to Bother this post again. I gotta ask; if I can set the VBA to send information to the parcels in Civil3d from the Excel Spreadsheet. So, basically reverse what we wrote. Is that hard to do?
thx
Civil3D 2020

Jeff_M

  • King Gator
  • Posts: 4087
  • C3D user & customizer
Re: Civil3D VBA - Excel Parcels
« Reply #28 on: June 11, 2014, 07:33:16 PM »
Yes, you can write back to the UDP's with oParcel.SetUserDefinedPropertyValue(propname, value). But getting the Parcel to write to will be difficult unless you include the Parcel's Handle when you write the data to Excel.

MSTG007

  • Gator
  • Posts: 2598
  • I can't remeber what I already asked! I need help!
Re: Civil3D VBA - Excel Parcels
« Reply #29 on: June 12, 2014, 07:38:09 AM »
So I would guess you would have to originally import the parcels (UDP) into excel w/ it pulling the handle? Then to export from excel to civil I would need it to match the handle and transfer the requested fields over. Geesh.
Civil3D 2020