Author Topic: what space am i?  (Read 5739 times)

0 Members and 1 Guest are viewing this topic.

CmdrDuh

  • Automatic Duh Generator
  • King Gator
  • Posts: 4039
Re: what space am i?
« Reply #15 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.
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

Bryco

  • Water Moccasin
  • Posts: 1849
Re: what space am i?
« Reply #16 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)

Glenn R

  • Water Moccasin
  • Posts: 1932
  • What idiot child of married cousins wrote this?!
Re: what space am i?
« Reply #17 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...?
Me

Glenn R

  • Water Moccasin
  • Posts: 1932
  • What idiot child of married cousins wrote this?!
Re: what space am i?
« Reply #18 on: July 21, 2008, 04:16:58 PM »
Bryco's on the money for dependent symbol name checks as far as VBA goes...
Me

CmdrDuh

  • Automatic Duh Generator
  • King Gator
  • Posts: 4039
Re: what space am i?
« Reply #19 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
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

Glenn R

  • Water Moccasin
  • Posts: 1932
  • What idiot child of married cousins wrote this?!
Re: what space am i?
« Reply #20 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...
Me

Glenn R

  • Water Moccasin
  • Posts: 1932
  • What idiot child of married cousins wrote this?!
Re: what space am i?
« Reply #21 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...
Me

CmdrDuh

  • Automatic Duh Generator
  • King Gator
  • Posts: 4039
Re: what space am i?
« Reply #22 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
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

CmdrDuh

  • Automatic Duh Generator
  • King Gator
  • Posts: 4039
Re: what space am i?
« Reply #23 on: July 21, 2008, 04:35:55 PM »
Glenn, I would greatly appreciate that, as I'm flying blind at the moment.
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

CmdrDuh

  • Automatic Duh Generator
  • King Gator
  • Posts: 4039
Re: what space am i?
« Reply #24 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
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

Glenn R

  • Water Moccasin
  • Posts: 1932
  • What idiot child of married cousins wrote this?!
Re: what space am i?
« Reply #25 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...
Me

CmdrDuh

  • Automatic Duh Generator
  • King Gator
  • Posts: 4039
Re: what space am i?
« Reply #26 on: July 21, 2008, 04:53:39 PM »
this is what I am trying to accomplish

  • Layers- Names/Color/Linetype
  • Text Styles
  • Titleblock/info block properties-correct layer, insertion point, etc.
  • Image props-correct layer, insertion point, etc
  • Dimension Style settings
  • Use of Mtext vs Dtext, Null text strings
  • XREF props-correct layer, insertion point, relative pathing, etc
  • Everything By Layer
  • Revisions using double digits( 01, not 1)

this is what I have so far
Everyone has a photographic memory, Some just don't have film.
They say money can't buy happiness, but it can buy Bacon and that's a close second

Glenn R

  • Water Moccasin
  • Posts: 1932
  • What idiot child of married cousins wrote this?!
Re: what space am i?
« Reply #27 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?
Me

Glenn R

  • Water Moccasin
  • Posts: 1932
  • What idiot child of married cousins wrote this?!
Re: what space am i?
« Reply #28 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.
Me

Bryco

  • Water Moccasin
  • Posts: 1849
Re: what space am i?
« Reply #29 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#