Here are a couple of routines I use for creating an array of the points I
want to play with:
Public g_oAeccDoc As AeccDocument
Public Const sAppName = "AeccXUiLand.AeccApplication"
Public AECPOINTS As AeccPoints
Public aecpoint As AeccPoint
Public chaecpoint As AeccPoint
Public PROCEED As Boolean
Public selectedpoints As Variant
Public g_oAeccDb As AeccDatabase
Private Const sSiteName = "SITE 1"
Dim value() As String
Function getCivilObjects() As Boolean
Dim oApp As AcadApplication
Set oApp = ThisDrawing.Application
Set G_OCIVILAPP = oApp.GetInterfaceObject(sAppName)
If G_OCIVILAPP Is Nothing Then
MsgBox "Error creating " & sAppName & ", exit."
getCivilObjects = False
Exit Function
End If
Set g_oAeccDoc = G_OCIVILAPP.ActiveDocument
Set g_oAeccDb = g_oAeccDoc.Database
getCivilObjects = True
End Function
Public Function getSite() As AeccSite
On Error Resume Next
Dim oSites As AeccSites
Set oSites = g_oAeccDb.Sites
Set getSite = oSites.Item(0)
End Function
Public Sub GETALLC3DPOINTS()
getCivilObjects
Set AECPOINTS = g_oAeccDoc.points
Dim i As Long
If AECPOINTS.Count = 0 Then
Exit Sub
Else
ReDim points(AECPOINTS.Count - 1)
For i = 0 To AECPOINTS.Count - 1
Set aecpoint = AECPOINTS.Item(i)
points(i).Number = aecpoint.Number
points(i).code = aecpoint.RawDescription
points(i).east = aecpoint.EASTING
points(i).north = aecpoint.NORTHING
points(i).RL = aecpoint.ELEVATION
Next
End If
Call sort_points
'Set AECPOINTS = Nothing
End Sub
Sub GETSOMEC3DPOINTS()
Dim i As Long, j As Long, numeric As String
Dim pointdesc As String
Dim newdesc As String
On Error Resume Next
getCivilObjects
selectedpoints = g_oAeccDoc.SelectPoints
Set AECPOINTS = g_oAeccDoc.points
ReDim points(0)
Dim numpts As Long
pointnumber = -1
If UBound(selectedpoints) = -1 Then 'the user has pressed the enter key,
indicating they want to select all points
numpts = AECPOINTS.Count - 1
Else
numpts = UBound(selectedpoints)
End If
ReDim points(numpts)
For i = 0 To numpts
If UBound(selectedpoints) = -1 Then
Set aecpoint = AECPOINTS.Item(i)
Else
Set aecpoint = AECPOINTS.Find(selectedpoints(i))
End If
Debug.Print aecpoint.Number
points(i).Number = aecpoint.Number
points(i).code = aecpoint.RawDescription
points(i).east = aecpoint.EASTING
points(i).north = aecpoint.NORTHING
points(i).RL = aecpoint.ELEVATION
Next
Call sort_points
End Sub
wrote in message news:5068878@discussion.autodesk.com...
Question
I need to know how to build a selection set of AECC_COGO_POINTS so that I
may re-
write an application to re-load the Northing/ Easting/ elevation and
description data from our field data collector files.
(1) How do I create a selection set of AECC_COGO_POINT objects (if they are
objects, they 'feel' more like data fields of the Point_Group object)?
Previous code:
(cond
((= :PSELBY "select")(setq :PSS (ssget (list (cons 0 "AECC_POINT")))))
((= :PSELBY "all") (setq :PSS (ssget "x" (list (cons 0 "AECC_POINT")))))
((= :PSELBY "layer")
(setq :PSS (ssget "x" (list (cons 0 "AECC_POINT")
(assoc 8 (entget (car (entsel "\nSelect Layer:"))))))) )
)
In Civ3D points import directly into an AECC_POINT_GROUP and
AECC_COGO_POINTs (Note: NOT AECC_POINTs) are sub-objects (maybe?) to the
group. An individual point
explodes to an anonymous block which in turn explodes to 2 subblocks which
then explode to mtext and lines
(setq :PSS (ssget "x" (list (cons 0 "AECC_POINT_GROUP"))))
Returns the point group
and
(setq :PSS (ssget "x" (list (cons 0 "AECC_COGO_POINT")))) Returns nil
Any suggestions apreiciated.
(2) The following VBA code is what we used to 're-stuff' the descriptior
data into the object. The program goes on from there to insert blocks
(linked to the descriptor code) on specific layers and finally create
linework (also referenced from the descriptor codes) again on specific
layers.
What I need to know is how to reference the object model.
Sub Change_Desc(PtNum As Long, ptdesc As String)
On Error GoTo Error_resume_next
' This gets a CogoPoint given a point number.
Dim cogoPnts As AeccCogoPoints
Dim cogoPnt As AeccCogoPoint
Set cogoPnts = AeccApplication.ActiveProject.CogoPoints
Set cogoPnt = cogoPnts.PointByNumber(PtNum)
cogoPnt.RawDescription = ptdesc
cogoPnt.Save
Error_resume_next:
Resume Next
End Sub
Sub ReadTextFile()
Const ForReading = 1, ForWriting = 2, ForAppending = 3
Dim fs, f, PtTest
Dim PtNum As Long
Dim ptdesc As String
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile("C:\TEMP\Sort.tmp", ForReading, TristateFalse)
PtTest = f.readline
While PtTest <> "**.EOF"
ptdesc = f.readline
PtNum = CLng(PtTest)
Call Change_Desc(PtNum, ptdesc)
PtTest = f.readline
Wend
f.Close
Again, any suggestions apreiciated
Regards - jim Brinkmeyer -- Portland, Oreogn