TheSwamp

Code Red => VB(A) => Topic started by: CmdrDuh on July 17, 2008, 06:09:40 PM

Title: what space am i?
Post by: CmdrDuh on July 17, 2008, 06:09:40 PM
Off the top of my head, I cant remember how to determine if a block is in MS or PS.  Can someone remind me?  I thought it had somethinhg to do with OwnerID, but I can t find any code where I have used that, so Im not sure Im on the right track
Title: Re: what space am i?
Post by: CmdrDuh on July 17, 2008, 06:25:20 PM
nevermind, Bryco did it before and I just couldn't find it

Code: [Select]
Function IsPs(oBref As AcadBlockReference) As Boolean
    Dim oblock As AcadBlock
    Set oblock = ThisDrawing.ObjectIdToObject(oBref.OwnerID)
    If Not oblock.Name = "*Model_Space" Then
        IsPs = True
    End If
End Function
Title: Re: what space am i?
Post by: Glenn R on July 18, 2008, 06:45:08 AM
A more betterer one perhaps? It demonstrates how to compare numbers (ObjectId's) rather than doing string comparisons:
Code: [Select]
Function IsPs(pBlkRef As AcadBlockReference) As Boolean
    IsPs = (pBlkRef.OwnerID <> ThisDrawing.ModelSpace.ObjectID)
End Function

Cheers,
Glenn.
Title: Re: what space am i?
Post by: Glenn R on July 18, 2008, 06:47:30 AM
Actually, that should strictly be:

Code: [Select]
Function IsPs(pBlkRef As AcadBlockReference) As Boolean
    IsPs = (pBlkRef.OwnerID = ThisDrawing.PaperSpace.ObjectID)
End Function
Title: Re: what space am i?
Post by: Jeff_M on July 18, 2008, 12:27:11 PM
Glenn, I would think the first one more correct. "ThisDrawing.Paperspace" only refers to the most recently current Layout, so if the block is in any of the other Layouts the second method would still return False.
Title: Re: what space am i?
Post by: Glenn R on July 18, 2008, 01:04:35 PM
Jeff,

Yeah, that's correct and only if this is being used in conjunction with a selectionset gathered from the user for instance. If you're processing inserts that are nested, all bets are off and neither of these would be correct anyway.

It shows the intent though :)
Title: Re: what space am i?
Post by: CmdrDuh on July 18, 2008, 02:25:03 PM
Thanks Glenn, I like that much better.!
Title: Re: what space am i?
Post by: Glenn R on July 18, 2008, 02:38:17 PM
No probs Duh.
Title: Re: what space am i?
Post by: CmdrDuh on July 18, 2008, 05:19:06 PM
Assuming
     
Code: [Select]
Set objBlkRef = getblock("UES")returns a block named UES, how can I check to see if it was returned?  I tried
Code: [Select]
If Not objBlkRef = Nothingwhich failed badly
Title: Re: what space am i?
Post by: SEANT on July 18, 2008, 06:26:26 PM
Assuming
     
Code: [Select]
Set objBlkRef = getblock("UES")returns a block named UES, how can I check to see if it was returned?  I tried
Code: [Select]
If Not objBlkRef = Nothingwhich failed badly

I believe it should be:
If objBlkRef Is Nothing Then
Title: Re: what space am i?
Post by: Glenn R on July 18, 2008, 06:53:38 PM
Correct.
Title: Re: what space am i?
Post by: Bryco on July 18, 2008, 07:26:34 PM
I found it easier to make the getblock function a boolean.
If not getblock("UES") then goto InsertBlock
set b=thisdrawing.blocks("UES")
Title: Re: what space am i?
Post by: CmdrDuh on July 21, 2008, 03:21:47 PM
OK, I think I know what I need to do, but was wondering if there was a better way.  The code below checks what fonts are in the dwg, including fonts that came from Xrefs.  The quoted text below is in my text file "audit" of the dwg, and you can see the 3D-TTL-B| was consistently found to be wrong.  So I tried using a wildcard *| which also failed (I expected it to, but was hoping).  So I "think" I should use Instr() to check for the "|" character, and use the next char to the end of string for my check.  Is there a better way or am I on the right track?

Code: [Select]
      For Each objFont In ThisDrawing.TextStyles
            Select Case UCase(objFont.Name)
            Case "STANDARD"
            Case "*|STANDARD"  ' eval if xrefed
            Case "TEP"
            Case "TEP-TITLE"
            Case "TEP-TITLE 3-16"
            Case "TEP-TITLE 1-8"
            Case Else
                        MyFile.writeline vbTab & objFont.Name & vbTab & objFont.fontFile
                        KillDaFile = True
            End Select
      Next objFont
Quote
Non Standard Fonts:
   3D-TTL-B|Standard   Romans.shx
   3D-TTL-B|TEP   Romans.shx
   3D-TTL-B|arial   ARIALBD.TTF
   3D-TTL-B|UES   impact.TTF
   3D-TTL-B|TEP-TITLE   verdana.TTF
   3D-TTL-B|arial   ARIALBD.TTF
   3D-TTL-B|UES   impact.TTF


Title: Re: what space am i?
Post by: CmdrDuh on July 21, 2008, 03:22:25 PM
BTW, Seant, you were spot on and it fixed my problem perfectly
Title: Re: what space am i?
Post by: Glenn R on July 21, 2008, 03:30:20 PM
Huh? We've gone from 'what space am I' to an 'audit' scenario....what exactly are you trying to do in the first place Duh?
Title: Re: what space am i?
Post by: CmdrDuh on July 21, 2008, 03:43:54 PM
Sorry Glenn, I was just posting in the same thread to avoid creating a new one.  Maybe I should create a new thread.

Anyway, what space am i in was part of my dwg audit I am trying to put together to make sure consultants put the titleblock in paperspace.
Title: Re: what space am i?
Post by: Bryco on July 21, 2008, 04:13:18 PM
If oTStyle.Name Like "*|*" Then

Don't you have to open the xref to fix the font? (It's read only)
Title: Re: what space am i?
Post by: Glenn R on July 21, 2008, 04:16:22 PM
... to make sure consultants put the titleblock in paperspace.

Do you supply the insultants with a titleblock to use or do they use their own and it must be the same name as yours or something else...?
Title: Re: what space am i?
Post by: Glenn R on July 21, 2008, 04:16:58 PM
Bryco's on the money for dependent symbol name checks as far as VBA goes...
Title: Re: what space am i?
Post by: CmdrDuh on July 21, 2008, 04:21:32 PM
... to make sure consultants put the titleblock in paperspace.

Do you supply the insultants with a titleblock to use or do they use their own and it must be the same name as yours or something else...?
:-D :-D :-D :lmao: :lmao: :lmao:
we supply them the block, but we cant guarentee they put it in PS.  I gave them a template w/ it in PS, and I still got dwgs back where they had wblocked it out and inserted in MS
Title: Re: what space am i?
Post by: Glenn R on July 21, 2008, 04:33:13 PM
This sounds like something the company I'm working for at the moment does and it's called a CAD QA or CADQA as the program is called.

I assume your 'audit' program is checking the insultant's supplied drgs with your company standards as specified by the contract.

If this assumption is correct, can you outline what your 'QA' process is please? I might be able to give you another spin on this...
Title: Re: what space am i?
Post by: Glenn R on July 21, 2008, 04:34:45 PM
ACtually, regardless of my assumption above, give the outline of what your 'QA' program is trying to accomplish...
Title: Re: what space am i?
Post by: CmdrDuh on July 21, 2008, 04:35:06 PM
If oTStyle.Name Like "*|*" Then

Don't you have to open the xref to fix the font? (It's read only)
yes, but that is their problem.  The idea is TEP-Romans.shx is correct, if its in an xref, its still correct.  I needed a way to pick up the xref name and ignore as long as the TEP and Romans part were correct
Title: Re: what space am i?
Post by: CmdrDuh on July 21, 2008, 04:35:55 PM
Glenn, I would greatly appreciate that, as I'm flying blind at the moment.
Title: Re: what space am i?
Post by: CmdrDuh on July 21, 2008, 04:36:36 PM
this is what I have so far
Code: [Select]
Option Explicit

Public Sub CheckDrawingStandards()
'      On Error GoTo Err_Control
      Dim objBlkRef As AcadBlockReference
      Dim FSO, MyFile As Variant
      Dim objLayer As AcadLayer, objFont As AcadTextStyle
      Dim strDwgName As String
      Dim strLayername As String, strLayerLinetype As String, strLayerColor As String
      Dim KillDaFile As Boolean
      ThisDrawing.PurgeAll
      ThisDrawing.PurgeAll
      ThisDrawing.PurgeAll
      ThisDrawing.Save

      Set FSO = CreateObject("Scripting.FileSystemObject")
      strDwgName = UCase(Left$(ThisDrawing.GetVariable("Dwgname"), Len(ThisDrawing.GetVariable("Dwgname")) - 4))
      Set MyFile = FSO.CreateTextFile("H:\DWGAudit\" & strDwgName & ".TXT", True)
      MyFile.writeline "Drawing: " & strDwgName & ", located at: " & ThisDrawing.Path & "\"


CheckLayers:
      MyFile.writeline " "
      MyFile.writeline "Non Standard Layers: "
      For Each objLayer In ThisDrawing.Layers
            strLayername = objLayer.Name
            strLayerLinetype = objLayer.Linetype
            strLayerColor = objLayer.color
            If CheckName(strLayername) = 1 Then
                  MyFile.writeline vbTab & strLayername & vbTab & strLayerLinetype & vbTab & strLayerColor
                  KillDaFile = True
            End If
      Next objLayer
     
CheckFonts:
      MyFile.writeline " "
      MyFile.writeline "Non Standard Fonts:"
     
      Set objFont = ThisDrawing.TextStyles.Item("Standard")
      objFont.fontFile = "romans.shx"
      objFont.Width = 0.85
      objFont.Height = 0#
     
      For Each objFont In ThisDrawing.TextStyles
            Select Case UCase(objFont.Name)
            Case "STANDARD"
            Case "*|STANDARD"  ' eval if xrefed
            Case "TEP"
            Case "TEP-TITLE"
            Case "TEP-TITLE 3-16"
            Case "TEP-TITLE 1-8"
            Case Else
                        MyFile.writeline vbTab & objFont.Name & vbTab & objFont.fontFile
                        KillDaFile = True
            End Select
      Next objFont

      For Each objFont In ThisDrawing.TextStyles
            Select Case UCase(objFont.fontFile)
            Case "ROMANS.SHX"
            Case "VERDANA.TTF"
            Case Else
                  MyFile.writeline vbTab & objFont.Name & vbTab & objFont.fontFile
                  KillDaFile = True
            End Select
      Next objFont

CheckDimStyles:
      MyFile.writeline " "
      MyFile.writeline "Non Standard Dimension Styles:"
      Dim objDimStyle As AcadDimStyle
      For Each objDimStyle In ThisDrawing.DimStyles
            Select Case UCase(objDimStyle.Name)
            Case "STANDARD"
            Case "TEP"
            Case Else
                  MyFile.writeline vbTab & objDimStyle.Name
                  KillDaFile = True
            End Select
      Next objDimStyle

CheckTitleBlocks:
      MyFile.writeline " "
      MyFile.writeline "Titleblock and Info block:"
      Set objBlkRef = getblock("TEP")
      If Not objBlkRef Is Nothing Then
            If CheckBlockSpace(objBlkRef) = False Then
                  MyFile.writeline vbTab & "Titleblock not inserted in PaperSpace"
                  KillDaFile = True
            End If
           
            If CheckBlockProps(objBlkRef) = False Then
                  MyFile.writeline vbTab & "Titleblock on wrong layer, it should be on ANNO-TITL"
                  KillDaFile = True
            End If
           
            If CheckBlockLocation(objBlkRef) = False Then
                  MyFile.writeline vbTab & "Titleblock not inserted at 0,0"
                  KillDaFile = True
            End If
      End If
     
      Set objBlkRef = getblock("UES")
      If Not objBlkRef Is Nothing Then
            If CheckBlockSpace(objBlkRef) = False Then
            MyFile.writeline vbTab & "Titleblock not inserted in PaperSpace"
            KillDaFile = True
            End If
           
            If CheckBlockProps(objBlkRef) = False Then
            MyFile.writeline vbTab & "Titleblock on wrong layer, it should be on ANNO-TITL"
            KillDaFile = True
            End If
           
            If CheckBlockLocation(objBlkRef) = False Then
            MyFile.writeline vbTab & "Titleblock not inserted at 0,0"
            KillDaFile = True
            End If
      End If
     
      Set objBlkRef = getblock("TITLINFO")
      If Not objBlkRef Is Nothing Then
            If CheckBlockSpace(objBlkRef) = False Then
            MyFile.writeline vbTab & "InfoBlock not inserted in PaperSpace"
            KillDaFile = True
            End If
           
            If CheckBlockProps(objBlkRef) = False Then
            MyFile.writeline vbTab & "InfoBlock on wrong layer, it should be on ANNO-TITL"
            KillDaFile = True
            End If
           
            If CheckBlockLocation(objBlkRef) = False Then
            MyFile.writeline vbTab & "InfoBlock not inserted at 0,0"
            KillDaFile = True
            End If
      End If
     
      Set objBlkRef = getblock("VTITLINFO")
      If Not objBlkRef Is Nothing Then
            If CheckBlockSpace(objBlkRef) = False Then
                  MyFile.writeline vbTab & "InfoBlock not inserted in PaperSpace"
                  KillDaFile = True
            End If
           
            If CheckBlockProps(objBlkRef) = False Then
                  MyFile.writeline vbTab & "InfoBlock on wrong layer, it should be on ANNO-TITL"
                  KillDaFile = True
            End If
           
            If CheckBlockLocation(objBlkRef) = False Then
                  MyFile.writeline vbTab & "InfoBlock not inserted at 0,0"
                  KillDaFile = True
            End If
      End If
      Set objBlkRef = getblock("E-ANNO-STKR")
      If Not objBlkRef Is Nothing Then
      If CheckBlockSpace(objBlkRef) = False Then
            MyFile.writeline vbTab & "Project Sticker not inserted in PaperSpace"
            KillDaFile = True
      End If
      If CheckBlockProps(objBlkRef) = False Then
            MyFile.writeline vbTab & "Project Sticker on wrong layer, it should be on ANNO-TITL"
            KillDaFile = True
      End If
End If

  MyFile.Close
If KillDaFile = False Then
Kill "H:\DWGAudit\" & strDwgName & ".TXT"
End If
Exit Sub
End Sub
Private Function getblock(strName As String) As AcadBlockReference
Dim vardata(1) As Variant
            Dim intType(1) As Integer, objBlkRef As AcadBlockReference
            Dim strblockname As String, objSelset As AcadSelectionSet, ABR As AcadBlockReference
            ACADSelSet objSelset, "vbdblkrefset"
            intType(0) = 0
            vardata(0) = "INSERT"
            intType(1) = 2
            vardata(1) = UCase(strName)
            objSelset.Select Mode:=acSelectionSetAll, FilterType:=intType, FilterData:=vardata
            For Each ABR In objSelset
            Set getblock = ABR
            Exit Function
            Next
End Function
Public Function ACADSelSet(funcObjSelSet As AcadSelectionSet, funcSelectionSetName As String)
      Dim objSelCol As AcadSelectionSets

      On Error GoTo Err_Control

      Set objSelCol = ThisDrawing.SelectionSets
      For Each funcObjSelSet In objSelCol
            If funcObjSelSet.Name = funcSelectionSetName Then
                  funcObjSelSet.Clear
                  funcObjSelSet.Delete
                  Exit For
            End If
      Next

      Set funcObjSelSet = objSelCol.Add(funcSelectionSetName)

Exit_Here:
      Exit Function
Err_Control:
      Select Case Err.Number
      Case -2145386300
            MsgBox "ACAD_Functions.ACADSelSet" & vbCrLf & Err.Number & " - " & Err.Description
      Case Else
            MsgBox "ACAD_Functions.ACADSelSet" & vbCrLf & Err.Number & " - " & Err.Description
      'ACADBugReportFiller "ACAD_Functions.ACADSelSet", Err.Number, Err.Description
      End Select

End Function
Private Function CheckBlockLocation(pBlkRef As AcadBlockReference) As Boolean
'      Dim objSelset As AcadSelectionSet
'      Dim objBlkRef As AcadBlockReference
'            Dim vardata(1) As Variant
'      Dim intType(1) As Integer
'            ACADSelSet objSelset, "vbdblkrefset"
'      intType(0) = 0
'      vardata(0) = "INSERT"
'      intType(1) = 2
'      vardata(1) = UCase(strblockname)
'      objSelset.Select Mode:=acSelectionSetAll, FilterType:=intType, FilterData:=vardata
'            For Each objBlkRef In objSelset
                  If Not pBlkRef.InsertionPoint(0) = 0 Or Not pBlkRef.InsertionPoint(1) = 0 Then
                  CheckBlockLocation = False
                  Exit Function
                  End If
'      Next objBlkRef
Exit_Here:
      Exit Function
End Function
Private Function CheckBlockSpace(pBlkRef As AcadBlockReference) As Boolean
    CheckBlockSpace = (pBlkRef.OwnerID = ThisDrawing.PaperSpace.ObjectID)
End Function
Private Function CheckBlockProps(pBlkRef As AcadBlockReference) As Boolean
    If pBlkRef.Layer = "ANNO-TITL" Then
    CheckBlockProps = True
    End If
End Function
Private Function CheckName(Layername As String) As Integer
      Dim strLayername As String
      Open "H:\DWGAudit\layer.txt" For Input As #1
      While Not EOF(1)
            Line Input #1, strLayername
            If UCase(Layername) = UCase(strLayername) Then
                  Close #1
                  GoTo Good
            End If
      Wend
      Close #1
      CheckName = 1
      Exit Function
Good:
      CheckName = 0
      Exit Function
End Function
Title: Re: what space am i?
Post by: Glenn R on July 21, 2008, 04:38:31 PM
Duh, can you give me an outline, in your words, as to what you're trying to achieve not the code please...
Title: Re: what space am i?
Post by: CmdrDuh on July 21, 2008, 04:53:39 PM
this (http://www.theswamp.org/index.php?topic=23994.0 this) is what I am trying to accomplish


this is what I have so far
Title: Re: what space am i?
Post by: Glenn R on July 21, 2008, 05:09:05 PM
Ok, after reading that other thread you linked (which I missed as I don't venture into the VBA forum much anymore) I suggest this become a project and it moves to .NET as I know you've been experimenting there, with C# if memory serves.

I forsee that I'm going to have a need of this type of thing in future as well and I have some ideas about how to accomplish this (possibly using a plugin for the cad stds checker) or a totally standalone command. Thoughts anyone?
Title: Re: what space am i?
Post by: Glenn R on July 21, 2008, 05:09:41 PM
BTW, your last post is what I expected you were wanting to check and you're definately not alone on this one.
Title: Re: what space am i?
Post by: Bryco on July 21, 2008, 05:14:49 PM
I hope it goes to C# as changing unwanted textstyles is something I couldn't do 100% in vba, it's on the list to do in c#
Title: Re: what space am i?
Post by: CmdrDuh on July 21, 2008, 06:10:03 PM
I would love to make this a C# project.  How soon can everyone start?  :lmao:  I think I will be the slow one in the group as you are correct, I am trying to move to .Net, its just been a whole lot of baby steps making small progress
Title: Re: what space am i?
Post by: CmdrDuh on July 21, 2008, 06:11:17 PM
I guess what I'm trying to say is I can help, and if you guys steer me in the right direction, I can try to do as much as possible, just be patient with me
Title: Re: what space am i?
Post by: CmdrDuh on July 21, 2008, 06:14:16 PM
Do you guys "fix" it or flag it for the insultant to fix (that is still cracking me up)
Title: Re: what space am i?
Post by: Glenn R on July 21, 2008, 06:15:14 PM
Ok, post a new thread in the .NET group and we'll see if we can make this a semi-professional project...coding standards and everything...I'm quite sure there will be some interest other than me....Dan, Bryco, Kerry etc.
Title: Re: what space am i?
Post by: CmdrDuh on July 21, 2008, 06:15:37 PM
I am asking b/c it has been stated here that anything that doesn't pass the cad qa/qc is sent back to the insultant to fix on their own nickel
Title: Re: what space am i?
Post by: Glenn R on July 21, 2008, 06:19:45 PM
Where I am currently at, we 'advise' as to the pass or failure of the 'QA' to the relevant project mismanager and then he can make the call as to whether to fix in-house or throw the digital rubbish back in the insultant's digital lap.

Personally, if the insultant's contract says 'thou shalt produce drgs to this, our standard' then the insultant must comply...