Copying load definitions to many load sets at once

Valued Contributor
Valued Contributor

Hello to all.
Is it possible to copy load definition into several load sets at once?
Or is there only sequential copying?




Re: Copying load definitions to many load sets at once

Siemens Phenom Siemens Phenom
Siemens Phenom

Here is an API solution for you. It will handle ID checking to avoid overlap and renumber when necessary. Use 'Ctrl' or drag the mouse in the MulitListBox(s) to select more than one item.


(view in My Videos)



*EDIT: Include LoadMesh Object


' === Global Objects === 
    Dim App As femap.model
    Dim dropdownLoadSetArray() As String
    Dim LoadSetArray() As String
    Dim LoadDefArray() As String
    Dim copyLoadDefArray() As Long 'For the chosen Load Def IDs to copy from
    Dim receiveLoadSetArray() As Long 'For the chosen Load Set IDs to copy to

    Dim LSset As femap.Set
    Dim LS As femap.LoadSet
    Dim LD As femap.LoadDefinition
    Dim LM As femap.LoadMesh

    Dim count&
    Dim vID() As Long
    Dim vDOF() As Long
    Dim vValue() As Double
    Dim vFunction() As Long
    Dim LMtype As Long
    Dim LMcolor As Long
    Dim LDdatatype&, LDloadtype&, LDtitle$

Sub Main

    Set App = feFemap()
    Set LSset = App.feSet
    Set LS = App.feLoadSet

    LSset.AddAll( FT_LOAD_DIR ) 'Add all Load Sets
    ReDim dropdownLoadSetArray( LSset.Count-1 )
    i = 0
    While LSset.Next
        LS.Get(LSset.CurrentID )
        dropdownLoadSetArray(i) = Str(LSset.CurrentID) + ".."+LS.title
        i += 1

    Call LoadDefinitionPopulation( LSset.First ) '=== Populate initially with first Load Set

    Begin Dialog UserDialog 790,301,"Copy Multiple Load Definition",.DlgFunc ' %GRID:10,7,1,1
        MultiListBox 20,70,360,182,LoadDefArray(),.from
        MultiListBox 410,70,360,182,LoadSetArray(),.goingTo
        Text 20,10,90,14,"Load Set",.Text1
        OKButton 270,259,110,28
        CancelButton 410,259,110,28
        DropListBox 120,7,350,21,dropdownLoadSetArray(),.PickLS
        Text 20,42,350,14,"Copy Load Definitions...",.Text2
        Text 410,42,350,14,"Receiving Load Definitions...",.Text3
    End Dialog
    Dim dlg As UserDialog
    Dialog dlg
End Sub
'See DialogFunc help topic for more information.
Public Function DlgFunc(DlgItem$, Action%, SuppValue?) As Boolean
    Select Case Action%
    Case 1 ' Dialog box initialization
    Case 2 ' Value changing or button pressed
        Select Case DlgItem$
            Case "OK"
                Call GetSelectedLD()
                Call GetSelectedLS()
                Call PerformCopy()

            Case "Cancel","Esc"
            Case "PickLS"
                choice = DlgValue("PickLS")
                choice = dropdownLoadSetArray(choice)
                For i = 1 To Len(choice)
                    s = Left(choice, i )
                    If Right(s, 1) = "." Then
                        s = Replace(s,".","")
                        Exit For
                    End If
                Call LoadDefinitionPopulation(Val(s))
                DlgListBoxArray "goingTo", LoadSetArray$()
                DlgListBoxArray "from", LoadDefArray$()
            Case Else
                DlgFunc = False
        End Select
    Case 3 ' TextBox or ComboBox text changed
    Case 4 ' Focus changed
        Debug.Print "DlgFocus="""; DlgFocus(); """"
        DlgFunc = True

    Case 5 ' Idle
    Case 6 ' Function key
    End Select
End Function
Sub GetSelectedLD()
    selectedDefs = DlgValue("from")
    ReDim copyLoadDefArray( UBound( selectedDefs)  )

    For i = 0 To UBound( selectedDefs)
        sLD = LoadDefArray( selectedDefs(i ) )
        For j = 1 To Len( sLD ) 'Processing, get the Load Definition ID from the string
            s = Left( sLD, j )
            If Right( s, 1) = "." Then
                sLD = Replace(s,".","")
                Exit For
            End If

        'Store Load Def IDs we want to copy
        If Val( sLD ) > 0 Then
        copyLoadDefArray(i) = Val(sLD)
            App.feAppMessage(0, "Error Grabbing Load Def ID: " + sLD)
        End If


End Sub
Sub GetSelectedLS()
    selectedLoadSets = DlgValue("goingTo")
    ReDim receiveLoadSetArray( UBound( selectedLoadSets)  )

    For i = 0 To UBound( selectedLoadSets)
        sLS = LoadSetArray( selectedLoadSets(i ) )
        For j = 1 To Len( sLS ) 'Processing, get the Load Definition ID from the string
            s = Left( sLS, j )
            If Right( s, 1) = "." Then
                sLS = Replace(s,".","")
                Exit For
            End If

        'Store Load Def IDs we want to copy
        If Val( sLS ) > 0 Then
            receiveLoadSetArray(i) = Val(sLS)
            App.feAppMessage(0, "Error Grabbing Load Def ID: "+sLS)
        End If


End Sub
Sub PerformCopy()
    s = DlgValue("PickLS")
    s = dropdownLoadSetArray( s )
    For i = 1 To Len( s )
        fromLoadSetID = Left( s, i )
        If Right( fromLoadSetID, 1 ) = "." Then
            fromLoadSetID = Replace( fromLoadSetID, ".", "")
            Exit For
        End If

    App.feAppMessage(0, "Copying from LoadSet ID:"+fromLoadSetID)

    Set LD = App.feLoadDefinition

    ' =============== PERFORM COPY ===============

    For j = 0 To UBound( receiveLoadSetArray )
        For k = 0 To UBound( copyLoadDefArray )

            LD.setID = Val( fromLoadSETid )
            LD.Get( copyLoadDefArray( k ) )
            LDdatatype = LD.dataType
            LDloadtype = LD.loadType
            LDtitle = LD.title

            If LD.dataType <> FT_SURF_LOAD Then
                App.feAppMessage(0, "Load Definition: "+Format(LD.ID)+" Alternate Load Data Type detected. ["+Format(LDdatatype)+"]")
                App.feAppMessage(0,"    This API only currently supports FEA entities [nodes, elements]")
                App.feAppMessage(0,"    Investigate Help Section 5.37.1 LoadDefinition Object Properties and 3.3.6 Entity Types  ")
                GoTo skip
            End If
            'Copy individual Load Mesh (nodes, elems) out of orignial first and store in arrays
            Call GetLoadMeshArrays()

            'Check if this Load Definition Exists already, renumber if so
            LD.setID = receiveLoadSetArray(j)
            If LD.Exist( LD.ID ) Then
                LDID = LD.NextEmptyID
                wasRenumbered = " [Renumbered:" + Str( LDID ) + "] "
                LDID = LD.ID
                wasRenumbered = " "
            End If

            'Put the new Load Definition
            rc = LD.PutAll( LDID, LDdatatype, LDloadtype, LDtitle)

      'Put the Load Mesh in the new Load Definition
        Set LM = App.feLoadMesh
        LM.Get( LM.ID )
        LM.setID = LD.setID
        LM.LoadDefinitionID = LDID
        LM.type = LMtype
        LM.color = LMcolor

        'With our stored arrays, make one call to copy 
        rc = LM.AddArray( count, True, True, True, vID,vDOF, vValue, vFunction )
        LM.XOn = True
        LM.YOn = True
        LM.ZOn = True

        If rc = FE_OK Then
            msg = "Load Definition:" + Str(copyLoadDefArray( k )) _
            + wasRenumbered _
             +"'"+LD.title+ "' -->Copied To Load Set: "+ Str( receiveLoadSetArray ( j ) )
            App.feAppMessage(0, msg )
        End If

        Next k
    Next j

    App.feAppUpdatePanes( True ) 'Reload Model Info Tree

End Sub

Sub GetLoadMeshArrays()
    count = LD.CountLoads
    ReDim vID(count-1)
    ReDim vDOF( (3*count) -1 )
    ReDim vValue((5*count)-1 )
    ReDim vFunction( (5*count) - 1)

    While LD.NextLoad( LM ) 'Print Load Mesh 
        'App.feAppMessage(0,"Load On Node "+Str$(LM.meshID) )

        LMtype = LM.type
        LMcolor = LM.color

        'Entity ID
        vID( q ) = LM.meshID
        q += 1

        For i = 0 To 4
            vValue(v) = LM.vload( i )
            v += 1

        For i = 0 To 2
            vDOF(d) = 1 'Check on X,Y, Z loads
            d += 1

        For i = 0 To 4
            vFunction(f) =0
            f += 1

    q = 0 : v = 0 : d = 0 : f = 0 :   j = 0

End Sub

Sub LoadDefinitionPopulation( LoadSetID As Long)
    'hightlightedSend = DlgValue("PickLS")

    ' === Get Load Definitions in Chosen Load Set ===
    rc = LS.Get( LoadSetID )
    rc = LS.ResetNextLoadDef( True, 0, True, 0 ) 'True True: All Load Definition Types

    test = LS.CountSet()

    i = 0
        While LS.NextLoadDef( LD )
            currentLD = Str(LD.ID) + ".."+LD.title
            'App.feAppMessage(0, currentLD)
            ReDim Preserve LoadDefArray(i)
            LoadDefArray(i) = currentLD
            i += 1

     ' === Populate Load Set Receiving MultiListBox items === 
    i = 0
    LSset.AddAll( FT_LOAD_DIR )
    ReDim LoadSetArray(LSset.Count-2) 'Minus 2 here because we always eliminate the active drop-down load
    While LSset.Next
        LS.Get( LSset.CurrentID )
        If LSset.CurrentID <> LoadSetID Then 'Do not include the active drop-down load Set (Cannot copy to same Load Set)
            LoadSetArray(i) = CStr( LSset.CurrentID ) + ".." + LS.title
            i += 1
        End If

End Sub

Re: Copying load definitions to many load sets at once

Valued Contributor
Valued Contributor

Thanks for the macro, but I can’t get the desired result. After copying, the name of the load appears in the desired set, but the load itself is not in it.


(view in My Videos)

Re: Copying load definitions to many load sets at once

Siemens Phenom Siemens Phenom
Siemens Phenom

Looks like I neglected the LoadMesh object. I've edited my script above to make those changes. This works currently with Loads on Nodes and Elements. A warning will print out if other load data types are detected.