Problem accessing CadModel.CADProjectPoint from Basic Script

Trying to access the my Cad model in the Graphics Display Window using a PC-DMIS basic script. Getting a "Missing parameter(s)" error message. Here's what I have with the error being generated on the last line seen below;

'==================
Sub GetProjectPointData()
'==================
Dim App As Object
Dim Part As Object
Dim Cmds As Object
Dim GWindow As Object
Dim CadWin As Object
Set App = CreateObject("PCDLRN.Application")
Set Part = App.ActivePartProgram
Set Cmds = Part.Commands
Set GWindow = Part.CadWindows
Set CadWin = GWindow.Item(1)
Dim CADMod As CadModel
Set CADMod = Part.CadModel
'
'
Dim RetVal As Boolean
Dim XT, YT, ZT, DIRX, DIRY, DIRZ, PX, PY, PZ, PDIRX, PDIRY, PDIRZ As Double
Dim FeatureName, FID As String
'
CadWin.Visible = True

XT=NetData(7,1)
YT=NetData(7,2)
ZT=NetData(7,3)
CADMod.CADProjectPoint(XT, YT, ZT,7,0,0, PX, PY, PZ, PDIRX, PDIRY, PDIRZ,2)

The Function info in the help menus has 13 parameters, (as do I). Haven't tried accessing the Graphics display window from a script before and not sure if i have everything right here, but it does compile without errors, so...

If anyone that has basic script/Pcdmis knowledge about this topic, it would be much appreciated if you could take a peek at this and steer me in the right direction if there are blaring issues seen at first glance.

Parents

Dennis Paul over 5 years ago

Attribute VB_Name = "OverRideNominals"
'-----------------------
'Global VARIABLE Declarations
'-----------------------
Dim NetData(1 To 400,1 To 11) As String
Dim I As Long
Dim CurrentNetFeature, TotalNetFeatures As Long
Dim FID As String
'
'-----------------------
'INITIALIZATION of Global Variable(s)
'-----------------------
CurrentNetFeatures = 1
TotalNetFeatures = 0
FID = " " 'Feature ID
'
'==================
Sub GetNetData()
'==================
Dim App As Object
Dim Part As Object
Dim Cmds As Object
Set App = CreateObject("PCDLRN.Application")
Set Part = App.ActivePartProgram
Set Cmds = Part.Commands
Dim Cmd As Object
Dim I As Long
'
I = 1
    For Each Cmd In Cmds
        If Cmd.isFeature And Cmd.Feature = F_POINT  Then
            FID = Cmd.ID
            If InStr(1, FID,"NET") <> 0 Then
                NetData(I,1) = Cmd.GetText(THEO_X,0)
                NetData(I,2) = Cmd.GetText(THEO_Y,0)
                NetData(I,3) = Cmd.GetText(THEO_Z,0)
                NetData(I,4) = Cmd.GetText(MEAS_X,0)
                NetData(I,5) = Cmd.GetText(MEAS_Y,0)
                NetData(I,6) = Cmd.GetText(MEAS_Z,0)
                NetData(I,7) = Cmd.GetText(MEAS_I,0)
                NetData(I,8) = Cmd.GetText(MEAS_J,0)
                NetData(I,9) = Cmd.GetText(MEAS_K,0)
                NetData(I,10) = FID
                TotalNetFeatures = I
                I = I + 1
            End If
        End If
    Next Cmd
End Sub
'
'==================
Sub LoadLine()
'==================
Dim App As Object
Dim Part As Object
Dim Cmds As Object
Dim LastCmd As Object
'
Set App = CreateObject("PCDLRN.Application")
Set Part = App.ActivePartProgram
Set Cmds = Part.Commands
'
Dim Cmd As Object
Dim RetVal As Boolean
Dim RefId1, Refld2, XT, YT, ZT, DIRX, DIRY, DIRZ As String
Dim FeatureName As String
'
Dim CommandCount As Long
'
    CommandCount = Cmds.count
    XT = NetData(1,4)
    YT = NetData(1,5)
    ZT = NetData(1,6)
    DIRX = NetData(1,7)
    DIRY = NetData(1,8)
    DIRZ = NetData(1,9)
    FeatureName = "LIN1"
    For Each Cmd In Cmds
        If Cmd.isFeature And Cmd.Feature = F_LINE Then
            Cmd.Marked = True
            RetVal = Cmd.SetToggleString(1, COORD_TYPE, 0)
            RetVal = Cmd.PutText(NetData(CurrentNetFeature,4), THEO_SX, 0)
            RetVal = Cmd.PutText(NetData(CurrentNetFeature,5), THEO_SY, 0)
            RetVal = Cmd.PutText(NetData(CurrentNetFeature,6), THEO_SZ, 0)
            RetVal = Cmd.PutText(NetData(CurrentNetFeature,4), THEO_EX, 0)
            RetVal = Cmd.PutText(NetData(CurrentNetFeature,5), THEO_EY, 0)
            RetVal = Cmd.PutText(NetData(CurrentNetFeature,6), THEO_EZ, 0)
            RetVal = Cmd.PutText(NetData(CurrentNetFeature,7), THEO_I, 0)
            RetVal = Cmd.PutText(NetData(CurrentNetFeature,8), THEO_J, 0)
            RetVal = Cmd.PutText(NetData(CurrentNetFeature,9), THEO_K, 0)
            RetVal = Cmd.PutText("0", THEO_LENGTH, 0)
            RetVal = Cmd.PutText("0", SURFVEC_I, 0)
            RetVal = Cmd.PutText("0", SURFVEC_J, 0)
            RetVal = Cmd.PutText("1", SURFVEC_K, 0)

            RetVal = Cmd.PutText(NetData(CurrentNetFeature,4), MEAS_SX, 0)
            RetVal = Cmd.PutText(NetData(CurrentNetFeature,5), MEAS_SY, 0)
            RetVal = Cmd.PutText(NetData(CurrentNetFeature,6), MEAS_SZ, 0)
            RetVal = Cmd.PutText(NetData(CurrentNetFeature,4), MEAS_EX, 0)
            RetVal = Cmd.PutText(NetData(CurrentNetFeature,5), MEAS_EY, 0)
            RetVal = Cmd.PutText(NetData(CurrentNetFeature,6), MEAS_EZ, 0)
            RetVal = Cmd.PutText(NetData(CurrentNetFeature,7), MEAS_I, 0)
            RetVal = Cmd.PutText(NetData(CurrentNetFeature,8), MEAS_J, 0)
            RetVal = Cmd.PutText(NetData(CurrentNetFeature,9), MEAS_K, 0)
            RetVal = Cmd.PutText("0", MEAS_LENGTH, 0)
            RetVal = Cmd.PutText("0", SURFVEC_MEAS_I, 0)
            RetVal = Cmd.PutText("0", SURFVEC_MEAS_J, 0)
            RetVal = Cmd.PutText("1", SURFVEC_MEAS_K, 0)
            RetVal = Cmd.PutText(FeatureName, ID, 0)
        End If
    Next Cmd
'
End Sub
'
'==================
Sub CreateDrop()
'==================
    Dim App As Object
    Dim Part As Object
    Dim Cmds As Object
    Dim DmisCmd As Object
'
    Set App = CreateObject("PCDLRN.Application")
    Set Part = App.ActivePartProgram
    Set Cmds = Part.Commands
'
    Dim RetVal As Boolean
    Dim RefId1, Refld2, XT, YT, ZT As String
    Dim DropFeatureName, FID As String
    Dim CommandCount As Long
'
    CommandCount = Cmds.count
    Set DmisCmd = Cmds.Item(CommandCount)
'
    For Each DmisCmd In Cmds
'        If DmisCmd.isFeature And DmisCmd.Feature = F_LINE  Then
        If DmisCmd.isFeature And DmisCmd.Feature = 4 Then
            RefId1 = NetData(CurrentNetFeature,10)
            RefId2 = "LIN1"
            DropFeatureName = "CDROP" + NetData(CurrentNetFeature,10)
            Cmds.InsertionPointAfter DmisCmd
            Set DmisCmd= Cmds.Add(CONST_DROP_POINT, True)
            DmisCmd.Marked = True
            RetVal = DmisCmd.PutText(DropFeatureName, ID, 0)
            RetVal = DmisCmd.PutText(RefId1, REF_ID, 1)
            RetVal = DmisCmd.PutText(RefId2, REF_ID, 2)
            RetVal = DmisCmd.SetToggleString(1, COORD_TYPE, 0)
'            XT = DmisCmd.GetText(THEO_X, 0)
            NetData(CurrentNetFeature,1) = DmisCmd.GetText(THEO_X, 0)
'            YT = DmisCmd.GetText(THEO_Y, 0)
            NetData(CurrentNetFeature,2) = DmisCmd.GetText(THEO_Y, 0)
'            ZT = DmisCmd.GetText(THEO_Z, 0)
            NetData(CurrentNetFeature,3) = DmisCmd.GetText(THEO_Z, 0)
        End If
    Next DmisCmd
End Sub
'
'==================
Sub WriteNominals()
'==================
Dim App As Object
Dim Part As Object
Dim Cmds As Object
Dim LastCmd As Object
'
Set App = CreateObject("PCDLRN.Application")
Set Part = App.ActivePartProgram
Set Cmds = Part.Commands
'
Dim PrgLineCmd As Object
Dim RetVal As Boolean
Dim RefId1, Refld2, XT, YT, ZT, DIRX, DIRY, DIRZ As String
Dim FeatureName As String
'
    For Each PrgLineCmd In Cmds
        If PrgLineCmd.isFeature Then
            FID = PrgLineCmd.ID
            If FID = NetData(CurrentNetFeature,10) Then
                PrgLineCmd.Marked = True
                RetVal = PrgLineCmd.PutText(NetData(CurrentNetFeature,1), THEO_X, 0)
                RetVal = PrgLineCmd.PutText(NetData(CurrentNetFeature,2), THEO_Y, 0)
                RetVal = PrgLineCmd.PutText(NetData(CurrentNetFeature,3), THEO_Z, 0)
            End If
        End If
    Next PrgLineCmd
End Sub
'
'==================
Sub GetProjectPointData()
'==================
Dim App As Object
Dim Part As Object
Dim Cmds As Object
'
Set App = CreateObject("PCDLRN.Application")
Set Part = App.ActivePartProgram
Set Cmds = Part.Commands
'
Dim GWindow As Object
Dim CadWin As Object
Set GWindow = Part.CadWindows
Set CadWin = GWindow.Item(1)
CadWin.Visible = True
'
Dim CADMod As CadModel
Set CADMod = Part.CadModel
Dim XM, YM, ZM, DIRX, DIRY, DIRZ, PX, PY, PZ, PDIRX, PDIRY, PDIRZ As Double
Dim FeatureName As String
Dim RetVal As Boolean
RetVal = CadWin.Visible
'
XM=NetData(6,1)
YM=NetData(6,2)
ZM=NetData(6,3)
Dim CH As Integer
Dim CadResult As Integer
'
' 7 All Cad Features
' 4 Cad Surfaces Only
'
      CadResult = CADMod.CADProjectPoint(XT, YT, ZT,4,0,0, PX, PY, PZ, PDIRX, PDIRY, PDIRZ, CH)
'
' -1  Invalid Object handle, Or operation Not enabled; no value returned.
'  0  No value returned; geometry doesn't make sense, failed geometry (i.e. parallel lines), Or Not yet implemented.
'  2  Logic produced a hit, value returned (all is well).
'  1  Logic produced a miss, closest point returned Or ambiguous point returned.
'
End Sub
'
'==================
Sub Main()
'==================
Dim App As Object
Dim Part As Object
Dim Cmds As Objec
'
Set App = CreateObject("PCDLRN.Application")
Set Part = App.ActivePartProgram
Set Cmds = Part.Commands
'
Dim RepWin As Object
Set RepWin = Part.ReportWindow
Dim EditWin As Object
Set EditWin = Part.EditWindow
EditWin.Visible = True
'
    GetNetData
    For CurrentNetFeature = 1 To TotalNetFeatures
        LoadLine
        CreateDrop
        WriteNominals
    Next CurrentNetFeature
    GetProjectPointData
'
Part.Activate
EditWin.Visible = True
End Sub

Reply

Dennis Paul over 5 years ago

Attribute VB_Name = "OverRideNominals"
'-----------------------
'Global VARIABLE Declarations
'-----------------------
Dim NetData(1 To 400,1 To 11) As String
Dim I As Long
Dim CurrentNetFeature, TotalNetFeatures As Long
Dim FID As String
'
'-----------------------
'INITIALIZATION of Global Variable(s)
'-----------------------
CurrentNetFeatures = 1
TotalNetFeatures = 0
FID = " " 'Feature ID
'
'==================
Sub GetNetData()
'==================
Dim App As Object
Dim Part As Object
Dim Cmds As Object
Set App = CreateObject("PCDLRN.Application")
Set Part = App.ActivePartProgram
Set Cmds = Part.Commands
Dim Cmd As Object
Dim I As Long
'
I = 1
    For Each Cmd In Cmds
        If Cmd.isFeature And Cmd.Feature = F_POINT  Then
            FID = Cmd.ID
            If InStr(1, FID,"NET") <> 0 Then
                NetData(I,1) = Cmd.GetText(THEO_X,0)
                NetData(I,2) = Cmd.GetText(THEO_Y,0)
                NetData(I,3) = Cmd.GetText(THEO_Z,0)
                NetData(I,4) = Cmd.GetText(MEAS_X,0)
                NetData(I,5) = Cmd.GetText(MEAS_Y,0)
                NetData(I,6) = Cmd.GetText(MEAS_Z,0)
                NetData(I,7) = Cmd.GetText(MEAS_I,0)
                NetData(I,8) = Cmd.GetText(MEAS_J,0)
                NetData(I,9) = Cmd.GetText(MEAS_K,0)
                NetData(I,10) = FID
                TotalNetFeatures = I
                I = I + 1
            End If
        End If
    Next Cmd
End Sub
'
'==================
Sub LoadLine()
'==================
Dim App As Object
Dim Part As Object
Dim Cmds As Object
Dim LastCmd As Object
'
Set App = CreateObject("PCDLRN.Application")
Set Part = App.ActivePartProgram
Set Cmds = Part.Commands
'
Dim Cmd As Object
Dim RetVal As Boolean
Dim RefId1, Refld2, XT, YT, ZT, DIRX, DIRY, DIRZ As String
Dim FeatureName As String
'
Dim CommandCount As Long
'
    CommandCount = Cmds.count
    XT = NetData(1,4)
    YT = NetData(1,5)
    ZT = NetData(1,6)
    DIRX = NetData(1,7)
    DIRY = NetData(1,8)
    DIRZ = NetData(1,9)
    FeatureName = "LIN1"
    For Each Cmd In Cmds
        If Cmd.isFeature And Cmd.Feature = F_LINE Then
            Cmd.Marked = True
            RetVal = Cmd.SetToggleString(1, COORD_TYPE, 0)
            RetVal = Cmd.PutText(NetData(CurrentNetFeature,4), THEO_SX, 0)
            RetVal = Cmd.PutText(NetData(CurrentNetFeature,5), THEO_SY, 0)
            RetVal = Cmd.PutText(NetData(CurrentNetFeature,6), THEO_SZ, 0)
            RetVal = Cmd.PutText(NetData(CurrentNetFeature,4), THEO_EX, 0)
            RetVal = Cmd.PutText(NetData(CurrentNetFeature,5), THEO_EY, 0)
            RetVal = Cmd.PutText(NetData(CurrentNetFeature,6), THEO_EZ, 0)
            RetVal = Cmd.PutText(NetData(CurrentNetFeature,7), THEO_I, 0)
            RetVal = Cmd.PutText(NetData(CurrentNetFeature,8), THEO_J, 0)
            RetVal = Cmd.PutText(NetData(CurrentNetFeature,9), THEO_K, 0)
            RetVal = Cmd.PutText("0", THEO_LENGTH, 0)
            RetVal = Cmd.PutText("0", SURFVEC_I, 0)
            RetVal = Cmd.PutText("0", SURFVEC_J, 0)
            RetVal = Cmd.PutText("1", SURFVEC_K, 0)

            RetVal = Cmd.PutText(NetData(CurrentNetFeature,4), MEAS_SX, 0)
            RetVal = Cmd.PutText(NetData(CurrentNetFeature,5), MEAS_SY, 0)
            RetVal = Cmd.PutText(NetData(CurrentNetFeature,6), MEAS_SZ, 0)
            RetVal = Cmd.PutText(NetData(CurrentNetFeature,4), MEAS_EX, 0)
            RetVal = Cmd.PutText(NetData(CurrentNetFeature,5), MEAS_EY, 0)
            RetVal = Cmd.PutText(NetData(CurrentNetFeature,6), MEAS_EZ, 0)
            RetVal = Cmd.PutText(NetData(CurrentNetFeature,7), MEAS_I, 0)
            RetVal = Cmd.PutText(NetData(CurrentNetFeature,8), MEAS_J, 0)
            RetVal = Cmd.PutText(NetData(CurrentNetFeature,9), MEAS_K, 0)
            RetVal = Cmd.PutText("0", MEAS_LENGTH, 0)
            RetVal = Cmd.PutText("0", SURFVEC_MEAS_I, 0)
            RetVal = Cmd.PutText("0", SURFVEC_MEAS_J, 0)
            RetVal = Cmd.PutText("1", SURFVEC_MEAS_K, 0)
            RetVal = Cmd.PutText(FeatureName, ID, 0)
        End If
    Next Cmd
'
End Sub
'
'==================
Sub CreateDrop()
'==================
    Dim App As Object
    Dim Part As Object
    Dim Cmds As Object
    Dim DmisCmd As Object
'
    Set App = CreateObject("PCDLRN.Application")
    Set Part = App.ActivePartProgram
    Set Cmds = Part.Commands
'
    Dim RetVal As Boolean
    Dim RefId1, Refld2, XT, YT, ZT As String
    Dim DropFeatureName, FID As String
    Dim CommandCount As Long
'
    CommandCount = Cmds.count
    Set DmisCmd = Cmds.Item(CommandCount)
'
    For Each DmisCmd In Cmds
'        If DmisCmd.isFeature And DmisCmd.Feature = F_LINE  Then
        If DmisCmd.isFeature And DmisCmd.Feature = 4 Then
            RefId1 = NetData(CurrentNetFeature,10)
            RefId2 = "LIN1"
            DropFeatureName = "CDROP" + NetData(CurrentNetFeature,10)
            Cmds.InsertionPointAfter DmisCmd
            Set DmisCmd= Cmds.Add(CONST_DROP_POINT, True)
            DmisCmd.Marked = True
            RetVal = DmisCmd.PutText(DropFeatureName, ID, 0)
            RetVal = DmisCmd.PutText(RefId1, REF_ID, 1)
            RetVal = DmisCmd.PutText(RefId2, REF_ID, 2)
            RetVal = DmisCmd.SetToggleString(1, COORD_TYPE, 0)
'            XT = DmisCmd.GetText(THEO_X, 0)
            NetData(CurrentNetFeature,1) = DmisCmd.GetText(THEO_X, 0)
'            YT = DmisCmd.GetText(THEO_Y, 0)
            NetData(CurrentNetFeature,2) = DmisCmd.GetText(THEO_Y, 0)
'            ZT = DmisCmd.GetText(THEO_Z, 0)
            NetData(CurrentNetFeature,3) = DmisCmd.GetText(THEO_Z, 0)
        End If
    Next DmisCmd
End Sub
'
'==================
Sub WriteNominals()
'==================
Dim App As Object
Dim Part As Object
Dim Cmds As Object
Dim LastCmd As Object
'
Set App = CreateObject("PCDLRN.Application")
Set Part = App.ActivePartProgram
Set Cmds = Part.Commands
'
Dim PrgLineCmd As Object
Dim RetVal As Boolean
Dim RefId1, Refld2, XT, YT, ZT, DIRX, DIRY, DIRZ As String
Dim FeatureName As String
'
    For Each PrgLineCmd In Cmds
        If PrgLineCmd.isFeature Then
            FID = PrgLineCmd.ID
            If FID = NetData(CurrentNetFeature,10) Then
                PrgLineCmd.Marked = True
                RetVal = PrgLineCmd.PutText(NetData(CurrentNetFeature,1), THEO_X, 0)
                RetVal = PrgLineCmd.PutText(NetData(CurrentNetFeature,2), THEO_Y, 0)
                RetVal = PrgLineCmd.PutText(NetData(CurrentNetFeature,3), THEO_Z, 0)
            End If
        End If
    Next PrgLineCmd
End Sub
'
'==================
Sub GetProjectPointData()
'==================
Dim App As Object
Dim Part As Object
Dim Cmds As Object
'
Set App = CreateObject("PCDLRN.Application")
Set Part = App.ActivePartProgram
Set Cmds = Part.Commands
'
Dim GWindow As Object
Dim CadWin As Object
Set GWindow = Part.CadWindows
Set CadWin = GWindow.Item(1)
CadWin.Visible = True
'
Dim CADMod As CadModel
Set CADMod = Part.CadModel
Dim XM, YM, ZM, DIRX, DIRY, DIRZ, PX, PY, PZ, PDIRX, PDIRY, PDIRZ As Double
Dim FeatureName As String
Dim RetVal As Boolean
RetVal = CadWin.Visible
'
XM=NetData(6,1)
YM=NetData(6,2)
ZM=NetData(6,3)
Dim CH As Integer
Dim CadResult As Integer
'
' 7 All Cad Features
' 4 Cad Surfaces Only
'
      CadResult = CADMod.CADProjectPoint(XT, YT, ZT,4,0,0, PX, PY, PZ, PDIRX, PDIRY, PDIRZ, CH)
'
' -1  Invalid Object handle, Or operation Not enabled; no value returned.
'  0  No value returned; geometry doesn't make sense, failed geometry (i.e. parallel lines), Or Not yet implemented.
'  2  Logic produced a hit, value returned (all is well).
'  1  Logic produced a miss, closest point returned Or ambiguous point returned.
'
End Sub
'
'==================
Sub Main()
'==================
Dim App As Object
Dim Part As Object
Dim Cmds As Objec
'
Set App = CreateObject("PCDLRN.Application")
Set Part = App.ActivePartProgram
Set Cmds = Part.Commands
'
Dim RepWin As Object
Set RepWin = Part.ReportWindow
Dim EditWin As Object
Set EditWin = Part.EditWindow
EditWin.Visible = True
'
    GetNetData
    For CurrentNetFeature = 1 To TotalNetFeatures
        LoadLine
        CreateDrop
        WriteNominals
    Next CurrentNetFeature
    GetProjectPointData
'
Part.Activate
EditWin.Visible = True
End Sub

Children

No Data