VBScript-PC-DMIS Kod Örnekleri > VBScript ve Pc-Dmis Kod Paylaşımları..!

Pc dmiste out of toleransların sayısını otomatik bulma...

<< < (2/4) > >>

# harek #:
içinde elogo dosyasında olması gerekmeyen yazılar olduğu için onu yazdım. Pcdmis programı hata verebilir.

metroloji16:
Ben kullanıyorum bende herhangi bir hata vermiyor aynı sekilde kendi kullandıgım e logoyu kopyaladım ama tabi versiyon farkı veya farklı şeyler oluşurda hata verirmi siz ustalar daha iyi bilirsiniz ..

〽️🌱🌴:

--- Alıntı yapılan: # harek # date=1438166336 ---Sayın metroloji16 dosyanın ne olduğunu anlamadım.
edit window dan kopyalanıp yapıştırılmış gibi

Taner

Edit / Preferences / Edit Window Layout tıkla
Show Header / Footer çentikli olduğuna emin ol.

Burayı çentiklediğinde elogo.dat doyası içindeki bilgiler Edit Window  ve Report Window ekranlarında gözükecektir.

--- Alıntı sonu ---
üstad programda hatalar olmasına rağmen bende "total # of meas=0 # auttol=0 # of hours =00:00:00" diyor. ölçüm bittikten sonra hiç bişeye tıklamazsan değer gösteriyor ama program kapatıp açılınca değerleri sıfırlıyor. Taner her daim görebilmek istiyor sanırım.
Taner 2014'de "Text and CAD  out of tolerance" isminde kırmızı iconlu cad only mode benzeri bir rapor şablonu var. (Bende yapmış olabilirim emin değilim). Sende de varsa o modda sadece hata olanları gösteriyor. Saymak sana kalıyor tabi ki, raporda yapabilirsin. İşini göreceğini düşünmüyorum ama bir bak diyorum.

Birde şu konu var, çözemedim. çözersen de paylaş bizde öğrenelim.

Counting OUTTOL in a program
Kod: Linklere izin verilmiyor. Üye Ol ya da Giriş Yap'--------------------------------------------------------------------
' Count all dimensions out of tolerance
' Set the indicated PCDMIS variable to the number
'
' Usage:
'
'            TILLDELA/OT=0
'CS1        =SKRIPT/FILNAMN= C:\DOCUMENTS AND SETTINGS\ALL USERS\DOKUMENT\WAI\PC-DMIS\2010 MR2\COUNTOUTOFTOL.BAS
'            FUNKTION/CountOutOfTol,VISA=JA,ARG1="OT",,
'            BöRJA_SKRIPT/
'            SLUTA_SKRIPT/
'
'            KOMMENTAR/OPERATöR,NEJ,HELSKÄRM=NEJ,FORTSÄTT AUTOMATISKT=NEJ,
'            Antal utvärderingar utom tolerans
'            OT
'
'--------------------------------------------------------------------

Sub CountOutOfTol(OutTolVar As String)

Dim App As Object
Set App = CreateObject("PCDLRN.Application")
Dim Part As Object
Set Part = App.ActivePartProgram
Dim Cmds As Object
Set Cmds = Part.Commands
Dim Cmd As Object
Dim DCmd As Object
Dim FCFOT As String
Dim I As Integer

Dim OutTolValue As Object
Set OutTolValue = Part.GetVariableValue(OutTolVar)

If Not OutTolValue is Nothing Then

  OutTolValue.LongValue = 0

  For Each Cmd In Cmds

    If Cmd.IsDimension Then
      If Cmd.Type <> DIMENSION_START_LOCATION And _
         Cmd.Type <> DIMENSION_END_LOCATION And _
         Cmd.Type <> DIMENSION_TRUE_START_POSITION And _
         Cmd.Type <> DIMENSION_TRUE_END_POSITION Then
        Set DCmd = Cmd.DimensionCommand
        if (DCmd.OutTol <> 0) then
          OutTolValue.LongValue = OutTolValue.LongValue + 1
        End If
      End If
    ElseIf Cmd.Type = 184 Then ' FCF
      I = 1
      FCFOT = Cmd.GetText (LINE2_OUTTOL, I)
      While (Not OutOfTol) And (FCFOT <> "")
        If Val(FCFOT) <> 0 Then
          OutTolValue.LongValue = OutTolValue.LongValue + 1
        End If
        I = I + 1
        FCFOT = Cmd.GetText (LINE2_OUTTOL, I)
      Wend
    End If
  Next Cmd

  If Not OutTolValue is Nothing Then
    Part.SetVariableValue OutTolVar, OutTolValue
  End If

Else
   MsgBox "Variabeln " + OutTolVar + " saknas i PCDMIS-programmet!"
End If

End Sub

Sub Main
End Sub
--- Kod sonu ---


Linklere izin verilmiyor. Üye Ol ya da Giriş Yap

τǺN€®™:
Linklere izin verilmiyor. Üye Ol ya da Giriş YapEkteki dosyayı masa ustundeki pcdmis logosuna sag tus yapıp özellikler diyip dosya konumu ac dedikten sonra yapıstırırsan buyuk ihtimalle olabilir dene istersen olcu sayısı tolerans dısı olcu olcum suresi parcanın adı filan yazıcak dosya yukleme kabul etmedigi için not defterine cevirdim sen dosyanın uzantısını dat yapıp dedigim klasöre kopyalarsın tabi o klasördeki e logo yedek al hani istedigin gibi olmaz ise eskisini geri yuklersin

--- Alıntı sonu ---
 dediğin şeyi yaptım sonuç veriyor ancak murat'ın dediği gibi programdan çıkıp tekrar açınca sıfırlıyor.
ayrıca örneğin nokta ölçerken hem hatalı olduğu ekseni hemde T değerini sayıyor...
yani tam olarak istediğim değil ama güzel bir şey öğrenmiş oldum teşekkürlr...;)

τǺN€®™:
Linklere izin verilmiyor. Üye Ol ya da Giriş Yapüstad programda hatalar olmasına rağmen bende "total # of meas=0 # auttol=0 # of hours =00:00:00" diyor. ölçüm bittikten sonra hiç bişeye tıklamazsan değer gösteriyor ama program kapatıp açılınca değerleri sıfırlıyor. Taner her daim görebilmek istiyor sanırım.
Taner 2014'de "Text and CAD  out of tolerance" isminde kırmızı iconlu cad only mode benzeri bir rapor şablonu var. (Bende yapmış olabilirim emin değilim). Sende de varsa o modda sadece hata olanları gösteriyor. Saymak sana kalıyor tabi ki, raporda yapabilirsin. İşini göreceğini düşünmüyorum ama bir bak diyorum.

Birde şu konu var, çözemedim. çözersen de paylaş bizde öğrenelim.

Counting OUTTOL in a program
Kod: Linklere izin verilmiyor. Üye Ol ya da Giriş Yap'--------------------------------------------------------------------
' Count all dimensions out of tolerance
' Set the indicated PCDMIS variable to the number
'
' Usage:
'
'            TILLDELA/OT=0
'CS1        =SKRIPT/FILNAMN= C:\DOCUMENTS AND SETTINGS\ALL USERS\DOKUMENT\WAI\PC-DMIS\2010 MR2\COUNTOUTOFTOL.BAS
'            FUNKTION/CountOutOfTol,VISA=JA,ARG1="OT",,
'            BöRJA_SKRIPT/
'            SLUTA_SKRIPT/
'
'            KOMMENTAR/OPERATöR,NEJ,HELSKÄRM=NEJ,FORTSÄTT AUTOMATISKT=NEJ,
'            Antal utvärderingar utom tolerans
'            OT
'
'--------------------------------------------------------------------

Sub CountOutOfTol(OutTolVar As String)

Dim App As Object
Set App = CreateObject("PCDLRN.Application")
Dim Part As Object
Set Part = App.ActivePartProgram
Dim Cmds As Object
Set Cmds = Part.Commands
Dim Cmd As Object
Dim DCmd As Object
Dim FCFOT As String
Dim I As Integer

Dim OutTolValue As Object
Set OutTolValue = Part.GetVariableValue(OutTolVar)

If Not OutTolValue is Nothing Then

  OutTolValue.LongValue = 0

  For Each Cmd In Cmds

    If Cmd.IsDimension Then
      If Cmd.Type <> DIMENSION_START_LOCATION And _
         Cmd.Type <> DIMENSION_END_LOCATION And _
         Cmd.Type <> DIMENSION_TRUE_START_POSITION And _
         Cmd.Type <> DIMENSION_TRUE_END_POSITION Then
        Set DCmd = Cmd.DimensionCommand
        if (DCmd.OutTol <> 0) then
          OutTolValue.LongValue = OutTolValue.LongValue + 1
        End If
      End If
    ElseIf Cmd.Type = 184 Then ' FCF
      I = 1
      FCFOT = Cmd.GetText (LINE2_OUTTOL, I)
      While (Not OutOfTol) And (FCFOT <> "")
        If Val(FCFOT) <> 0 Then
          OutTolValue.LongValue = OutTolValue.LongValue + 1
        End If
        I = I + 1
        FCFOT = Cmd.GetText (LINE2_OUTTOL, I)
      Wend
    End If
  Next Cmd

  If Not OutTolValue is Nothing Then
    Part.SetVariableValue OutTolVar, OutTolValue
  End If

Else
   MsgBox "Variabeln " + OutTolVar + " saknas i PCDMIS-programmet!"
End If

End Sub

Sub Main
End
--- Kod sonu ---
Linklere izin verilmiyor. Üye Ol ya da Giriş Yap
--- Alıntı sonu ---

evet murat bunu bende buldum ama henüz deniyorum ve nasıl kullanacağımı çözdüğümde paylaşacağım...

Navigasyon

[0] Mesajlar

[#] Sonraki Sayfa

[*] Önceki Sayfa