Please Help!!!

[Cad O Cad]

Hi all!, im new to cad tutor and also kind of new to VB. well here is the deal.... I am have a drawing that has a certain piece of text on it i.e. LFT000000025899.. and i need a selection set that basically says look at that number and match it to the file name of the drawing. If the number on the drawing matches the file name then the program continues but if not..then it writes the error to a word doc and user gets tht report after the program runs...CAN ANYONE GIVE ME SOME INSIGHT...IVE SEARCHED EVERY WHERE!!:cry:

[SEANT]

I am too pressed for time this morning to offer much help; perhaps this weekend. One suggestion I would make, though, is to present as many details (VBA-VB6-VB.NET, etc.) and examples (general file that shows if text is DTEXT-MText-Attribute Reference, etc) you can. This will help us offer pertinent information.

 

Also, that increased level of input from your side is more effective at generating the interest of a potential responder.

[Cad O Cad]

ok cool i appreciate it..well here is what i have so far

Function TextCheckerNEWNEW(strErrors)

'**************************************************************

'*

'* Variable Declarations

'*

'**************************************************************

Dim S2 As AcadSelectionSet

Dim bInterimName As Boolean

Dim Ftyp1(6) As Integer

'Dim Ftyp(9) As Integer

Dim k As Long

Dim Fval1(6) As Variant

'Dim Fval(9) As Variant

'**************************************************************

'*

'* Program Begins

'* Makes sure there is a INTERIM NUMBER on the part

'**************************************************************

'strErrors = strErrors & "-----------------------Beginning Annotation check----------------------;"

Ftyp1(0) = -4: Fval1(0) = "

Ftyp1(1) = -4: Fval1(1) = "

Ftyp1(2) = 0: Fval1(2) = "MTEXT"

Ftyp1(3) = 0: Fval1(3) = "TEXT"

'Ftyp1(4) = 1: Fval1(4) = "LFT"

Ftyp1(4) = -4: Fval1(4) = "OR>"

Ftyp1(5) = 67: Fval1(5) = 1

Ftyp1(6) = -4: Fval1(6) = "AND>"

Set S2 = ThisDrawing.SelectionSets.Add("S2")

S2.Select acSelectionSetAll, , , Ftyp1, Fval1

For k = 0 To S2.Count - 1

If Left(S2(k).TextString, 1) = "LFT"

strErrors = strErrors & "Interim Number Found On Document.;"

bInterimName = True

'And InStr(1, S2(k).TextString, "#")

'Else

'If Left(S2(k).TextString, 1) = "LFT" And InStr(1, S2(k).TextString, "#")

'bInterimName = True

'End If

End If

Next k

ThisDrawing.SelectionSets("S2").Delete

If bInterimName True Then

Call ErrorDisplay("Interim Number Does Not Match File Number. Lofter Please Correct and Re-Run QA.", Null, strErrors, False)

End If

[Cad O Cad]

Anyone out there tryin to help me out

[SEANT]

The code sample posted above shows a function designed to run in the middle of a larger block of code – which is a good thing. Any one particular Sub/Function should take on a very specific chore, but structure to be easily chained together with other focused code block to accomplish the desired task.

 

That being said, however, one internal function leaves out a lot of background information.

 

I’ve modified the function a bit (a few assumptions were made regarding parameters): Is this inline with the desired result of the overall task?

 

 

 

Sub tester() 'tester routine to call the TextCheckerNEWNEW function
  If TextCheckerNEWNEW("test") Then
     MsgBox "Text Found."
  Else
     MsgBox "Text not Found.", vbCritical
  End If
End Sub

Function TextCheckerNEWNEW(strErrors As String) As Boolean


'************************************************* *************
'*
'* Variable Declarations
'*
'************************************************* *************
Dim S2 As AcadSelectionSet
Dim bInterimName As Boolean
Dim Ftyp1(6) As Integer
Dim Fval1(6) As Variant
Dim k As Long
Dim entText As AcadText
Dim entMtext As AcadMText
'************************************************* *************



'* Program Begins
'* Makes sure there is a INTERIM NUMBER on the part
'************************************************* *************
'strErrors = strErrors & "-----------------------Beginning Annotation check----------------------;"
Ftyp1(0) = -4: Fval1(0) = "<AND"
Ftyp1(1) = -4: Fval1(1) = "<OR"
Ftyp1(2) = 0: Fval1(2) = "MTEXT"
Ftyp1(3) = 0: Fval1(3) = "TEXT"
Ftyp1(4) = -4: Fval1(4) = "OR>"
Ftyp1(5) = 67: Fval1(5) = 1
Ftyp1(6) = -4: Fval1(6) = "AND>"

  On Error Resume Next
     ThisDrawing.SelectionSets.Item("S2").Delete 'to help during debugging
  On Error GoTo 0

  Set S2 = ThisDrawing.SelectionSets.Add("S2")
  S2.Select acSelectionSetAll, , , Ftyp1, Fval1
  For k = 0 To S2.count - 1
  
     Select Case S2(k).ObjectName
     Case Is = "AcDbText"
        Set entText = S2(k)
        If entText.TextString = strErrors Then
           TextCheckerNEWNEW = True
           ThisDrawing.SelectionSets("S2").Delete
           Exit Function
        End If
        
     Case Is = "AcDbMText"
        Set entMtext = S2(k)
        If entMtext.TextString = strErrors Then
           TextCheckerNEWNEW = True
           ThisDrawing.SelectionSets("S2").Delete
           Exit Function
        End If
     End Select
  
  Next k

End Function

[Cad O Cad]

Well yes...but i already have the Function called out in a previuos Sub.. But also i want it to do sumthing along these lines..if those two do not match (the LFT00004587 and the file name i.e. LFT00004587.dwg) then it records the error to a word doc and say sumthin like "LFT Number and File Name do not Match! Please Correct and Re-Run"

[SEANT]

The code I posted was not meant to be a solution to the task; it was more so I could understand what the function was meant to do. Bear in mind that I don’t know how the “previous Sub” acquired the info passed in (strErrors) or what the sub expects back (your function example does not have a return type).

 

Presumably there is some other Sub set up to open all the drawings in a directory. Does the drawing name (strErrors?) still have the .DWG extension?

[Cad O Cad]

yes it does still have the dwg.ext..basically this is wat happens...the user clicks a button and a series of checks run to basically checka drawing....this is a check to make sure the drawing number matches the file name... and then the program keeps on running...if there are errors on the drawing that these checks caught then the report out to word document file and tell the user what to do.

[SEANT]

This attachment still uses a simple testing routine. Any preliminary Checking/Calling sub could call this modified TextCheckerNEWNEW function and respond in a manner similar to my tester sub.

 

Make sure Microsoft Word is checked in Tools - References.

 

 

Sub tester()

'Tester routine to Test TextCheckerNEWNEW and CreateDwgList
'Actual routine would probably search through numerous drawings in a directory
Dim arrNameString() As String
Dim i As Long
Dim strTest As String
  strTest = "test.dwg"
  i = 0
  If TextCheckerNEWNEW(strTest) Then
     'do something if everything is okay
  Else
     ReDim Preserve arrNameString(i)
     arrNameString(i) = strTest
     i = i + 1
  End If
  If i > 0 Then CreateDwgList (arrNameString)
End Sub


Function TextCheckerNEWNEW(ByVal strErrors As String) As Boolean

'************************************************* *************
'*
'* Variable Declarations
'*
'************************************************* *************
Dim S2 As AcadSelectionSet
Dim bInterimName As Boolean
Dim Ftyp1(6) As Integer
Dim Fval1(6) As Variant
Dim k As Long
Dim entText As AcadText
Dim entMtext As AcadMText
Dim strText As String
'************************************************* *************



'* Program Begins
'* Makes sure there is a INTERIM NUMBER on the part
'************************************************* *************
'strErrors = strErrors & "-----------------------Beginning Annotation check----------------------;"
Ftyp1(0) = -4: Fval1(0) = "<AND"
Ftyp1(1) = -4: Fval1(1) = "<OR"
Ftyp1(2) = 0: Fval1(2) = "MTEXT"
Ftyp1(3) = 0: Fval1(3) = "TEXT"
Ftyp1(4) = -4: Fval1(4) = "OR>"
Ftyp1(5) = 67: Fval1(5) = 1
Ftyp1(6) = -4: Fval1(6) = "AND>"

  On Error Resume Next
     ThisDrawing.SelectionSets.Item("S2").Delete 'to help during debugging
  On Error GoTo 0

  Set S2 = ThisDrawing.SelectionSets.Add("S2")
  S2.Select acSelectionSetAll, , , Ftyp1, Fval1
  strErrors = UCase(strErrors)
  For k = 0 To S2.count - 1
  
     Select Case S2(k).ObjectName
     Case Is = "AcDbText"
        Set entText = S2(k)
        strText = UCase(entText.TextString)
        
        

     Case Is = "AcDbMText"
        Set entMtext = S2(k)
        strText = UCase(entMtext.TextString)
     End Select
     
     If InStr(strText, ".DWG") = 0 Then strText = strText & ".DWG"
     
     If strText = strErrors Then
        TextCheckerNEWNEW = True
        ThisDrawing.SelectionSets("S2").Delete
        Exit Function
     End If
  
  Next k

End Function



Sub CreateDwgList(arrTitle As Variant)
' add a reference to the Word-library
  Dim intTitleCount As Integer
   Dim wrdApp As Word.Application
   Dim wrdDoc As Word.Document
   Dim wrdTable As Word.Table
   Dim wrdRange As Word.Range
   Dim xText
   Dim i As Long
   intTitleCount = UBound(arrTitle) + 1
   Set wrdApp = GetObject(, "Word.Application")
   Set wrdDoc = wrdApp.ActiveDocument
   Set wrdRange = wrdDoc.Range
   wrdApp.Visible = True
   
   wrdRange.InsertAfter Text:="Drawings Improperly Designated" & vbCr
   wrdDoc.Paragraphs(1).NoLineNumber = True

   
   With wrdDoc.PageSetup.LineNumbering
     .Active = True
     .StartingNumber = 1
     .CountBy = 1
     .RestartMode = wdRestartContinuous
  End With

  For i = 1 To intTitleCount
           wrdRange.InsertAfter Text:=arrTitle(i - 1) & vbCr

     Next

   Set wrdDoc = Nothing
   Set wrdApp = Nothing
End Sub

[Cad O Cad]

Ok...i will try this and see wat happens...i dont know why this is so confusing for me

[Cad O Cad]

Ok here is a sample of my code that i have for another checker in this routine...i basically want it in the same format....

Function CheckColorOfLayout(strErrors)

Dim S3 As AcadSelectionSet

Dim Ftyp(5) As Integer

Dim errCount As Long

'Dim strErrors As String

Dim Fval(5) As Variant

Dim dEnd As Variant

'**************************************************************

'*

'* Program Begins

'* Looks for anything in paperspace not colored white

'**************************************************************

'strErrors = strErrors & "-----------------------Beginning Entity Checker------------------------;"

Ftyp(0) = -4: Fval(0) = "

Ftyp(1) = 67: Fval(1) = 1

Ftyp(2) = -4: Fval(2) = "

Ftyp(3) = 62: Fval(3) = 7

Ftyp(4) = -4: Fval(4) = "NOT>"

Ftyp(5) = -4: Fval(5) = "AND>"

 

'ThisDrawing.SelectionSets("S3").Delete

Set S3 = ThisDrawing.SelectionSets.Add("S3")

S3.Select acSelectionSetAll, , , Ftyp, Fval

If S3.Count > 0 Then

For errCount = 0 To S3.Count - 1

S3(errCount).color = acWhite

Next errCount

strErrors = strErrors & "Layout entities color changed to White, no action required by Lofter.;"

End If

ThisDrawing.SelectionSets("S3").Delete

End Function