While i was running my code, i found that the number of groups present in the selection rectangle in mechanical drawings, are shown below in autocad drafting. But when i try to find using VBA, i couldn't because of unavailability of API.
Option Explicit
Sub Group()
'Declaration
Dim acApp As AcadDocument
Dim acSeSet As AcadSelectionSet
Set acApp = ThisDrawing.Application.ActiveDocument
'Selection Set Creation
Set acSeSet = acApp.SelectionSets.Add("ShelSde4htd1")
acSeSet.SelectOnScreen
When i am running this part of code it goes to screen, and ask me to select the part on the screen. I am able to get entities from this selection but not the groups. I know group is also a collection, but can i then get the group selection from the selection on the screen?
Dim acEnt As AcadEntity
Dim entity_handle() As String
Dim i As Integer
i = 0
Dim entity_count As Integer
entity_count = acSeSet.Count() 'Selection Set Count
ReDim entity_handle(entity_count) 'Resizing the entity handle array
For Each acEnt In acSeSet 'Iterating through selected entities and storing in one array, the handles
entity_handle(i) = acEnt.Handle
i = i + 1
Next
Here i can get the entities, but apart from it i also want to get the groups selected in that region.
VBA's SelectionSet object can only select graphic elements
and groups are not graphic elements, they're (named) selectionset themselves!
to get possibly selected groups you must iterate through each element of the selectionset and check whether it belongs to a Group. then, if you need to make sure the whole group is selected you must check whether all elements of that group belongs to selectionset.
it's quite a bunch of multiple iterations: if your drawing has many groups and/or many elements in groups then you'd better investigate the best suitable searching technique (arrays to store groups elements?)
Related
I am trying to create a data structure in which a dictionary stores collections assigned to a key as a double. Each collection contains further array variants also. I am looping through rows in worksheet and adding certain values in each row to its associated collection for further manipulation later.
When I am adding data from a row to a collection, whether it belongs in a new collection--ergo a new key value pair in the dictionary--or simply just added to an existing collection, the data in the format of an array variant is being added to every key in the dictionary. Is somebody able to identify my problem?
For Each row In Selection.Rows 'Loop through each row in chunks of 5000
Dim NewInv(0 To 1) As Variant
If MasterDict.Exists(row.Cells(3).Value) Then
NewInv(0) = row.Cells(15).Value
NewInv(1) = row.Cells(15).EntireRow.Address
MasterDict.Item(row.Cells(3).Value).Add (NewInv)
'for some reason the line above is adding the array variant to every collection assigned to every key, not just the specified key.
Else
Dim NewAcct As New Collection
NewInv(0) = row.Cells(15).Value
NewInv(1) = row.Cells(15).EntireRow.Address
NewAcct.Add (NewInv)
MasterDict.Add Key:=row.Cells(3).Value, Item:=NewAcct
End If
Next
In the code above MasterDict is the dictionary in question.
Thank you for your response.
You are making a fundamental error. You only have one NewInv array. Even though you change the values of the individual items this does not make it a new array thus during the loop the reference is to NewInv only and consequently only the last values assigned to NewInv will be visible in each item. To do what I think you intended you need to revise your code as follows
For Each Row In Selection.Rows 'Loop through each row in chunks of 5000
If Not MasterDict.Exists(Row.Cells(3).Value) Then
MasterDict.Add Key:=Row.Cells(3).Value, Item:=New Collection
End If
MasterDict.Item(Row.Cells(3).Value).Add Array(Row.Cells(15).Value, Row.Cells(15).EntireRow.Address)
Next
How do you look up the index of a contact item that was set using the items.find method? After finding the item, I want to be able to move to the next item, but my code sends me to the first item in the collection. A condensed version of my plan is below...
dim ColItms as items
dim CI as contactItem
Dim CIindex as integer
set CI= ColItms.find("[CompanyName] = ""IBM""")
CIindex = CI.???? ''''' This shows what I'm wanting to do, but don't know how
' now advance to next item in collection
set ci = ColItms.item(CIindex +1) ' i think this would work if I could find CIindex
set ci = ColItms.GetNext ' this fails as it returns the 1st item in the collection
Right now all that seems to work is to loop through each item in the collection to see if it matches the found contact,
Items have no intrinsic index, only an entry id.
To find the next match, use Items.FindNext.
I have a CATIA macro in VBA, that draws points by coordinates (from arrays).
It works on my computer (Catia V5-R2014 and on my neigbours - two versions V5-R2014 and R21).
But it doesn't work for colleges in a different city (they have version R21).
Basically, my macro reads input data from file, calculates coordinates, writes them in out-file, and then draws these points.
All steps except the last one work on either computer/version.
But at the last step "their" Catia just doesn't plot anything, w/o any errors.
So the Subruotine for the last step is:
Sub PlotGeometry()
' Nmlp - number of points
Dim i As Integer
Dim oPartDocument As Document
Dim ohSPointCoord() As HybridShapePointCoord
Dim ohSPoints As HybridShapePointCoord
Dim bodies1 As Bodies
Dim body1 As Body
ReDim ohSPointCoord(0 To Nmlp)
Set oPartDocument = CATIA.Documents.Add("Part")
Set oPart = oPartDocument.Part
Set oPartBody = oPart.MainBody
Set oPlaneYZ = oPart.CreateReferenceFromGeometry(oPart.OriginElements.PlaneYZ)
' -- Draw Points
Dim ohSFactory As HybridShapeFactory
Set ohSFactory = oPart.HybridShapeFactory
For i = 0 To Nmlp
Set ohSPointCoord(i) = ohSFactory.AddNewPointCoord(XM(i), YM(i), ZM(i))
oPartBody.InsertHybridShape ohSPointCoord(i)
Next i
oPart.Update
End Sub
What can it be?
Perhaps at your site you have Hybrid Design enabled, and at the other site they do not.
With Hybrid Design enabled, you would be able to add points to a Body. Not so if it is not enabled and you would get no error from your code.
The setting is under Tools->Options->Infrastructure->Part Infrastructure->Part Document Tab->Enable hybrid design inside part bodies and bodies.
For unexplained reasons, hybrid design being enabled is the default. However I do not recommend using it.
If you just want to make your code work in both places then use a Geometrical Set to aggregate your points instead of the main body.
Dim pointsBody as HybridBody
Set pointsBody = oPart.HybridBodies.Add
pointsBody.Name = "Points_Body"
...
For i = 0 To Nmlp
Set ohSPointCoord(i) = ohSFactory.AddNewPointCoord(XM(i), YM(i), ZM(i))
pointsBody.AppendHybridShape ohSPointCoord(i)
Next i
Just a random guess:
Go to VBE>Tools>References
and compare the values from both computers. They should be identical.
Compare these checkboxes:
If they are different, make sure to make them identical to the PC that works.
I have to move a probe like sphere between two parts such that the probe is in contact with both the parts. And I have to find the point of contact of the parts, measure their distance and make a fillet on the parts based on this distance. I have achieved in moving the sphere between the parts but the sphere is moving through the parts. So trying to move with respect to constraints
I am trying to automate the manipulate tool in Catia Product.
Is there any command or method exist to move a part with respect to contraints in Catia using vba ?
Or
Is there any way to find the clash between two parts using vba ?
Looking Forward for a solution.
Thank you!!!
Here is a link where you can find a solution for clash.
OK, I got the idea, you want to see the code here :-)
To compute clash in a CATScript:
Sub CATMain()
' get root product of document
Dim RootProd As Product
Set RootProd = CATIA.ActiveDocument.Product
' retrieve selection object of active document
Dim objSelection As Selection
Set objSelection = CATIA.ActiveDocument.Selection
' get two selected objects
If (objSelection.Count2 <> 2) Then
MsgBox "Before running the script you must select two products to compute clash for", vbOKOnly, "No products selected"
Exit Sub
End If
Dim FirstProd As Product
Dim SecondProd As Product
Set FirstProd = objSelection.Item2(1).Value
Set SecondProd = objSelection.Item2(2).Value
' create groups for clash computation
Dim objGroups As Groups
Set objGroups = RootProd.GetTechnologicalObject("Groups")
Dim grpFirst As Group
Dim grpSecond As Group
Set grpFirst = objGroups.Add()
Set grpSecond = objGroups.Add()
' add selected products to groups
grpFirst.AddExplicit FirstProd
grpSecond.AddExplicit SecondProd
' get access to Clashes collection
Dim objClashes As Clashes
Set objClashes = RootProd.GetTechnologicalObject("Clashes")
' create new clash
Dim newClash As Clash
Set newClash = objClashes.Add()
' set new clash to be computed between two groups (two selected products)
newClash.FirstGroup = grpFirst
newClash.SecondGroup = grpSecond
newClash.ComputationType = catClashComputationTypeBetweenTwo
' compute clash
newClash.Compute
End Sub
I'm writing an application in VB in which I need to show the user some information which will be copy and pasted into another application however limitations of the other application mean that the string needs to be split into chunks no larger than 55 characters (it's just written notes). I thought the neatest way to do this was to have several textboxes each with a 'copy to clipboard' button to make it convenient for the user.
The code I have is:
Dim invdesc As List(Of String) = Split(splitstring, 55)
txtinvDesc1.Text = invdesc(0)
txtinvDesc2.Text = invdesc(1)
txtinvDesc3.Text = invdesc(2)
...
Split uses a regular expression to return a list of several lines without breaking up words and most of the time this will return a maximum of seven results but occasionally six (my original string max length is 330) and often fewer so my original idea to fill out any strings shorter than 330 with trailing spaces won't work as it's still possible I will either miss text or call a result that isn't there.
Ideally I would just do some kind of loop that only inputs to txtinvDesc(x) while there is data available and ignores the rest (or hides them) but I don't know any way to refer to a textbox other than explicitly or how to put them in any kind of list/array.
So it's a bit of an open question in "how best can I handle this requirement?"
You can create a collection (e.g., Array or List) of TextBox like with any other type/class (as you are doing with String in your code). Sample:
Dim allTextBoxes As New List(Of TextBox)
allTextBoxes.Add(txtinvDesc1)
allTextBoxes.Add(txtinvDesc2)
allTextBoxes.Add(txtinvDesc3)
Alternatively, you might iterate through all the controls in the main form by checking its type (a textbox or not). In that case you would have to set a relationship between the given name of the textbox and the data list index, via other collection for example:
Dim mappingList As New List(Of String)
mappingList.Add("txtinvDesc1")
mappingList.Add("txtinvDesc2")
mappingList.Add("txtinvDesc3")
For Each ctr As Control In Me.Controls
If (TypeOf ctr Is TextBox AndAlso mappingList.Contains(ctr.Name)) Then
ctr.Text = invdesc(mappingList.IndexOf(ctr.Name))
End If
Next
--- CLARIFICATION (not as evident as I thought)
The proposed for each loop relies on a mapping approach, that is, it relates each element in invdesc with the corresponding TextBox name. By definition, both arrays HAVE TO have the same number of elements (otherwise the mapping system wouldn't have made any sense). This is the most efficient and overall-applicable alternative; if the names of the textboxes and invdesc have elements in common (e.g., the numbers), you might just compare the names. BUT WHEN MAPPING YOU HAVE TO ACCOUNT FOR ALL THE ELEMENTS (if there is no associated TextBox to a given item, let the value blank; but all the items have to be accounted).
If you want to index the tbs:
Private TBs as New List (of TextBox)
Early on (after FormLoad) maybe in a FormSetup:
TBs.Add(txtinvDesc1)
TBs.Add(txtinvDesc2)
TBs.Add(txtinvDesc3)
...
Then:
Dim invdesc As List(Of String) = Split(splitstring, 55)
For n As Integer = 0 To invdesc.Count-1
TBs(n).Text = invdesc(n)
Next
' handle the varying 7th TB:
For n As Integer = invdesc.Count-1 To TBs.Count - 1
TBs(n).Enabled = False
TBs(n).Text =""
Next
Or a For/Each:
Dim ndx As Integer = 0
For Each tb As TextBox In TBs
tb.Text = invdesc(ndx)
ndx += 1 ' thanks varo!
Next
Then hide/disable or at least clear the text from any empty ones.
If it turns out there are always 6 you really only need an if statement:
txtinvDesc1.Text = invdesc(0)
txtinvDesc2.Text = invdesc(1)
txtinvDesc3.Text = invdesc(2)
...
If incDesc.Count-1 = 6 Then
txtinvDesc7.Text = invdesc(6)
Else
txtinvDesc7.Enabled= False
txtinvDesc7.Text = ""
End If
I would change the TB names to start at txtinvDesc0.Text to avoid getting confused (as I may have)
Use multiline textbox and in OnKeyPress event force 55 chars per line. You can find subclassed TextBox with that feature in this SO answer :
https://stackoverflow.com/a/17082189/351383