Add features to layers with VBA

[chris217]

I'm trying to use the Visual Basic API with VBA, through excel, to add features to layers. For simplicity, lets say I want to add all the datum planes to my layer ALL_PLANES.

This is what I have

Dim datumplanelist As IpfcFeatures
Dim addfeature As ipfcmodelitem
Dim pl As Long

'Put datum plane features into a sequence
Set datumplanelist = Solid.ListFeaturesByType(False, EpfcFEATTYPE_DATUM_PLANE)
'run through each of the items from datumplanelist and add to layer ALL_PLANES
For pl = 0 To datumplanelist.Count - 1
Set addfeature = datumplanelist.item(pl)
'**problem HERE \/
Planes.AddItem (addfeature)
Next

It is giving me that the addfeature variable is throwing the compile error "Method or data member not found"
it does the same thing if addfeature is defined as IpfcFeature

Thanks

 

[wamarler]

Planes.AddItem (addfeature)

I might just not be seeing it in your code, but where is "Planes" defined?

 

[chris217]

Sorry, I didn't post the entire code, but I'll try to post anything relevant to the code here

Public Model As IpfcModel

Public Solid As IpfcSolid



Set Model = session.CurrentModel

Set Solid = CType(Model, IpfcSolid)

Dim Planes As IpfcLayer
Set Planes = Model.CreateLayer("ALL_PLANES")

Aside from setting up the async connection and setting up the session, I think those are the only other variables I used.

Thanks for replying.

 

[wamarler]

Got me stumped, I don't see where you're making an error. But it's somewhat difficult to follow the code flow broken up between posts like this. Perhaps if you post the full sample program demonstrating the error (using pfcAsyncConnection.Connect() for simplicity's sake) the solution will become clear?

 

[chris217]

Okay, what it's supposed to do is delete all the current layers in the model unless the user says otherwise, and then add new layers and I'd like to populate the layers with items already in the model, and have it so that all future planes will go into ALL_PLANES, or axes will go in to ALL_AXIS etc.

'created by Chris
'last edited 15 JUL 2010
'The sum of the program is to provide a way to update the layers in Pro/Engineer
Private mLayerCount As Integer
Private mSession As IpfcBaseSession
Private mModel As IpfcModel
Private mMIOwner As IpfcModelItemOwner
Private mSolid As IpfcSolid

Private Sub btnUpdateLayers_click()

Dim Conn As IpfcAsyncConnection
Dim AsynConn As New CCpfcAsyncConnection

lDisplayAlerts = Application.DisplayAlerts
Application.DisplayAlerts = False

'unlock protection on sheet
ActiveSheet.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False

On Error GoTo RunError

'select all cells
Cells.Select
' unlock all the cells
Selection.Locked = False

'connect to Pro/E
Set Conn = AsynConn.Connect("", "", ".", 20)
Set mSession = Conn.session

'retrieve model
Set mModel = session.CurrentModel
Set mSolid = CType(mModel, IpfcSolid)

'=========================================================== ====================

'Clear the Layers column
ActiveSheet.Range("A6:B100").Value = ""

Dim Layers As IpfcModelItems
Dim IndexItem As ipfcmodelitem
Dim ID As Long
Dim Layer As IpfcLayer

Set mMIOwner = mModel

'put all layers in a sequence

Set Layers = mMIOwner.ListItems(EpfcITEM_LAYER)
Sheets("sheet1").Cells(5, 2).Value = Layers.Count

Dim j As Integer
j = 6

'list layers on excel sheet
For ID = 0 To Layers.Count - 1
Set IndexItem = Layers.item(ID)
ActiveSheet.Cells(j, 1).Value = IndexItem.GetName()
ActiveSheet.Cells(j, 1).Select
Selection.Locked = True
j = j + 1
Next

'lock protection on sheet
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False

'set Public value LayerCount to the number of layers in the model
mLayerCount = j - 1

'prompt user to check layers
MsgBox "Place an 'X' in the column next to the layers you wish to keep." & vbCrLf + _
"Press Continue when done.", vbInformation, "Select Layers to Keep"
'Enable the continue button, and disable the update layers button
Continue.Enabled = True
UpdateLayers.Enabled = False

RunError:
If Err.Number <> 0 Then
MsgBox "Process Failed : Unknown error occured." + Chr(13) + _
"Error No: " + CStr(Err.Number) + Chr(13) + _
"Error: " + Err.Description, vbCritical, "Error"

If Not Conn Is Nothing Then
If Conn.IsRunning Then
Conn.Disconnect (2)
Set Conn = Nothing
Set mSession = Nothing
Set AsynConn = Nothing
End If
End If
End If

'disconnect
Conn.Disconnect (2)
'cleanup
Set AsynConn = Nothing
Set Conn = Nothing



End Sub

'The rest of the code is automated
Private Sub btnContinue_click()

Dim Conn As IpfcAsyncConnection
Dim AsynConn As New CCpfcAsyncConnection

'connect to Pro/E
Set Conn = AsynConn.Connect("", "", ".", 20)

'=========================================================== ===========================================================

'Disable the Continue button
Continue.Enabled = False

'delete layers
Dim D As Integer
Dim Keep As String
Dim Layer As IpfcLayer

Set mMIOwner = mModel

For D = 6 To LayerCount
If Not ActiveSheet.Cells(D, 1).Value = "" Then
Keep = ActiveSheet.Cells(D, 2).Value
If UCase(Keep) <> "X" Then
Set Layer = mMIOwner.GetItemByName(EpfcITEM_LAYER, ActiveSheet.Cells(D, 1))
Layer.Delete
End If
End If
Next

'disable protection of the cells
ActiveSheet.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False


'create new layers
Dim Annotations As IpfcLayer
Dim Axis As IpfcLayer
Dim Cosmetics As IpfcLayer
Dim Csys As IpfcLayer
Dim Curves As IpfcLayer
Dim Planes As IpfcLayer
Dim Points As IpfcLayer
Dim Surfaces As IpfcLayer
Dim Xsec As IpfcLayer

On Error Resume Next
Set Annotations = mModel.CreateLayer("ALL_ANNOTATIONS")
Set Axis = mModel.CreateLayer("ALL_AXIS")
Set Cosmetics = mModel.CreateLayer("ALL_COSMETICS")
Set Csys = mModel.CreateLayer("ALL_CSYS")
Set Curves = mModel.CreateLayer("ALL_CURVES")
Set Planes = mModel.CreateLayer("ALL_PLANES")
Set Points = mModel.CreateLayer("ALL_POINTS")
Set Surfaces = mModel.CreateLayer("ALL_SURFACES")
Set Xsec = mModel.CreateLayer("XSEC_DATUMS")
If Err.Number <> 0 Then
MsgBox "One or more layers already present."
End If

'add items to layers
Dim DatumPlaneList As IpfcFeatures
Dim AddFeature As ipfcmodelitem
Dim Pl As Long

'Put datum plane features into a sequence
Set DatumPlaneList = mSolid.ListFeaturesByType(False, EpfcFEATTYPE_DATUM_PLANE)
'run through each of the items from datumplanelist and add to layer ALL_PLANES (looping them)
For Pl = 0 To DatumPlaneList.Count - 1
Set AddFeature = DatumPlaneList.item(Pl)
'*********problem HERE \/
Planes.AddItem (AddFeature)
Next

UpdateLayers.Enabled = True

'Regenerate the model***
'haven't figured this one out yet either

'put message in pro/e message area to tell user that update layers completed

MsgBox "Update Layers Completed"


'disconnect
Conn.Disconnect (2)
'cleanup
Set AsynConn = Nothing
Set Conn = Nothing
Set mSession = Nothing

End Sub

 

[wamarler]

Hey, a clarifying question:

In the subject you say "add features to layers with VBA." There is a difference between VBA and VB.NET -- "VBA" means "VB scripting in Excel or Word or other Office programs." VBA is not able to handle certain object-oriented operations correctly. For example, "Set Solid = CType(Model, IpfcSolid)" is not valid for VBA scripting, it is only valid in VB.NET.

Please confirm whether you're running from within a VBA environment or the VB.NET environment.

 

[chris217]

I'm running VBA, with excel. If "Set Solid = CType(Model, IpfcSolid)" does not work, is there a different way to get that same result? Thanks.

 

[wamarler]

I'm running VBA, with excel. If "Set Solid =
CType(Model, IpfcSolid)" does not work, is there a different way to get
that same result? Thanks.

So first, read up on object-oriented limitations in VBA. I *think* I'm
right, but I recall "CType" throwing a compile-time error.



The way I thought you had to cast-type in VBA was to explicitly create
variables of the correct type, and assign other variables of other
(otherwise-castable) types to them.



For example:
Dim my_model As IpfcModel
Dim my_solid As IpfcSolid
Set my_solid = my_model

VBA/VB.NET is not my preferred language and I am a bit rusty... IIRC this is a common limitation though, and should be findable on Google.

 

[chris217]

You are correct about the type casting, it is not available in VBA. I wasn't getting a compile error when running the code, but I've changed it to what you suggested. However, I am still getting the same error. When I try to run my btnContinue, it says compile error, method or data not found and highlights the "AddFeature" part of the line "Planes.AddItem (AddFeature)"

 

[wamarler]

Oh, how about this:

IfpcListFeaturesByType() [from your code, Set DatumPlaneList = mSolid.ListFeaturesByType(False,
EpfcFEATTYPE_DATUM_PLANE)] will return an "IpfcFeatures" sequence, the method ".Item()" of which will return an "IpfcFeature" object type.

Meanwhile IpfcLayer.AddItem() requires an input argument of "IpfcModelitem"

According to the API, "IpfcFeature" is a subclass of "IpfcModelitem." I would expect in a *normal* object-oriented environment (ie, VB.NET), passing an IpfcFeature in place of an IpfcModelitem would be fine, but perhaps you have to throw another manual typecast in there, and convert your AddFeature variable into an IpfcModelitem.

that's GOT to be it!

 

[chris217]

Wanted to let you know that I'm still getting the same error after trying to set the feature to a modelitem. I will be gone over the weekend, but thank you for helping so far.

What I found weird is that I put into a message box AddModelItem.getname and it returned my first datum plane, so something is getting in there, but it still does not seem to want to work.

 

[chris217]

Turns out something didn't like that there were 2 variables with the type ipfcmodelitem. When I tried using just the one (replacing addmodelitem with indexitem that I used above) the code ran just fine.

 

[wamarler]

Awesome!

Do you still have to typecast manually? Or was that not even relevant?

 

[chris217]

It will still give the error if it isn't manually typecast as an IpfcModelItem. Thanks for the help!

 

[chris217]

Is there a way to add Geometric Tolerances to layers using the API? They don't add when I add the rest of the annotations.

 

[wamarler]

Functionality regarding GTOL
objects is not written into in J-Link or the VB API. You'll need
Pro/TOOLKIT for that.

 

[chris217]

Ok, thanks for the quick response

 

[wamarler]

I'm on your nets, trolling your forums...

 

[chrisadam2]

I'm trying to emulate the create features functionality in
my own VBA form. I have a button on the form that I want a
user to click to create new features. I understand how to
find the layer and start editing, but am stuck at creating
the edit sketch and polygon.

_____________________________________

Want to get-on Google's first page and loads of traffic to
our website? Hire a SEO Specialist from ocean
Groups seo pecialist

 

[chris217]

I've never made new features, so this is over my head. Might try starting a new topic as you'll probably be more likely to get responses from new people. What I was doing was taking features that were already there and adding them to layers I created.