Author Topic: changing revision blocks to new blocks  (Read 2603 times)

0 Members and 1 Guest are viewing this topic.

TallCoolOne

  • Guest
changing revision blocks to new blocks
« on: October 05, 2006, 10:22:06 AM »
well, I'm trying to change out old revision blocks with new rev blocks, i have the code to change out the old rev blocks with the new ones & and all the attributes from the old blocks. my problem is that the new blocks are .838923 taller than the old rev blocks and i cant figure out how to make the new rev blocks move up that total for each block on the drawing. there are anywhere from 1 to 10 rev blocks on each drawing. the first one inserts fine but the rest do not move up the required distance

Murphy

  • Guest
Re: changing revision blocks to new blocks
« Reply #1 on: October 05, 2006, 12:35:03 PM »
You need to do something like this:

Code: [Select]
For n = 1 to NumberOfRevs
  If Not n = 1 Then
      yinsert = yinsert + ((n - 1) * .838923)
  End If
Next n

TallCoolOne

  • Guest
Re: changing revision blocks to new blocks
« Reply #2 on: October 05, 2006, 02:17:12 PM »
well, I'm trying to change out old revision blocks with new rev blocks, i have the code to change out the old rev blocks with the new ones & and all the attributes from the old blocks. my problem is that the new blocks are .838923 taller than the old rev blocks and i cant figure out how to make the new rev blocks move up that total for each block on the drawing. there are anywhere from 1 to 10 rev blocks on each drawing. the first one inserts fine but the rest do not move up the required distance

Option Explicit
Public objOldBlk As AcadBlockReference
Public NewBlkName As String
Public objOldAttRef As AcadAttributeReference
Public InsertPt(0 To 2) As Double
Public xScale As Double
Public yScale As Double
Public zScale As Double
Public Rot As Double
Public intOldCnt As Integer
Public varOldAtt As Variant
Public arOldBlkNames(0) As String
Public objBlk As AcadBlock
Public BName As Variant
Public att(0 To 15) As String
Public objNewBlk As Variant
Public intCnt As Double

Public Sub revblocks()
Dim intRevCnt As Integer

intRevCnt = ThisDrawing.Utility.GetInteger("Enter Number of Rev's to Change: ")
  intCnt = 0
            While intCnt <= intRevCnt
               
              OldBlk
             
            Wend
 
End Sub

Public Sub OldBlk() 'gets old block and attribute information

Dim objAcadSSet As AcadSelectionSet
Dim intTextCodes(0) As Integer
Dim varCodeValues(0) As Variant
Dim VerBlock As AcadBlock

arOldBlkNames(0) = "REVBLK1"

On Error Resume Next

Call DeleteSelSet    'delete old selection set if existing

Set objAcadSSet = ThisDrawing.SelectionSets.Add("sSet2")
 
intTextCodes(0) = 0 'set code for entities
varCodeValues(0) = "INSERT" 'set entity type to filter
objAcadSSet.SelectOnScreen intTextCodes, varCodeValues      'create set

For Each objOldBlk In objAcadSSet
   BName = UCase(objOldBlk.Name)
      Select Case BName
     
          Case arOldBlkNames(0)     'REVBLK1
              InsertPt(0) = objOldBlk.InsertionPoint(0)
              InsertPt(1) = objOldBlk.InsertionPoint(1)
              InsertPt(2) = objOldBlk.InsertionPoint(2)
              xScale = objOldBlk.XScaleFactor
              yScale = objOldBlk.YScaleFactor
              zScale = objOldBlk.ZScaleFactor
              Rot = objOldBlk.Rotation
           If objOldBlk.HasAttributes Then
              varOldAtt = objOldBlk.GetAttributes     'get block attributes
            End If
          For intOldCnt = LBound(varOldAtt) To UBound(varOldAtt)
            Set objOldAttRef = varOldAtt(intOldCnt)
          Next intOldCnt
            NewBlkName = "revblk3.dwg"
      NewBlk
                 
   End Select
   
   If BName = "REVBLK3" Then
      MsgBox "This Rev Block does not need to be updated. ", vbOKOnly
   End If

Next objOldBlk

End Sub

Public Sub NewBlk() 'replace old block with new block

Dim objNewBlk As AcadBlockReference
Dim objNewAttRef As AcadAttributeReference
Dim intNewCnt As Integer
Dim varNewAtt As Variant
Dim strLength As Long
Dim NewRevArea As String
Dim varTempAtt1 As Variant
Dim varTempAtt2 As Variant
Dim intTotal As Double




intTotal = 0.83892 * intCnt
             
              If InsertPt(1) <= (yScale * 2.6875) Then
                InsertPt(1) = InsertPt(1)
              Else
                InsertPt(1) = InsertPt(1) + ((intTotal) * intCnt)
               
              End If
                  intCnt = intCnt + 1
                 
Select Case BName

Case arOldBlkNames(0)         'REVBLK1
   Set objNewBlk = ThisDrawing.ModelSpace.InsertBlock(InsertPt, NewBlkName, xScale, yScale, zScale, Rot) 'insert new RevBlock
     
   varNewAtt = objNewBlk.GetAttributes 'get attributes

   
   For intOldCnt = LBound(varOldAtt) To UBound(varOldAtt)
       For intNewCnt = LBound(varNewAtt) To UBound(varNewAtt)
           
         If varOldAtt(intOldCnt).TagString = "REV" Then
            If varNewAtt(intNewCnt).TagString = "NO." Then
               varNewAtt(intNewCnt).TextString = varOldAtt(intOldCnt).TextString
            End If
         End If
           
         If varOldAtt(intOldCnt).TagString = "DESCRIPTION_LINE_1" Then
            If varNewAtt(intNewCnt).TagString = "DSCR0" Then
               varNewAtt(intNewCnt).TextString = varOldAtt(intOldCnt).TextString
            End If
         End If
         If varOldAtt(intOldCnt).TagString = "DESCRIPTION_LINE_2" Then
            If varNewAtt(intNewCnt).TagString = "DSCR1" Then
               varNewAtt(intNewCnt).TextString = varOldAtt(intOldCnt).TextString
            End If
         End If
         If varOldAtt(intOldCnt).TagString = "TECH" Then
            If varNewAtt(intNewCnt).TagString = "TECH" Then
               varNewAtt(intNewCnt).TextString = varOldAtt(intOldCnt).TextString
            End If
         End If
          If varOldAtt(intOldCnt).TagString = "APPR" Then
            If varNewAtt(intNewCnt).TagString = "APP1" Then
               varNewAtt(intNewCnt).TextString = varOldAtt(intOldCnt).TextString
            End If
         End If
   
         If varOldAtt(intOldCnt).TagString = "DATE" Then
            If varNewAtt(intNewCnt).TagString = "MYR" Then
               varNewAtt(intNewCnt).TextString = varOldAtt(intOldCnt).TextString
            End If
         End If
         
         If varOldAtt(intOldCnt).TagString = "STB1" Then
            If varNewAtt(intNewCnt).TagString = "NO." Then
               varNewAtt(intNewCnt).TextString = varOldAtt(intOldCnt).TextString
            End If
         End If
           
         If varOldAtt(intOldCnt).TagString = "STB3" Then
            If varNewAtt(intNewCnt).TagString = "DSCR0" Then
               varNewAtt(intNewCnt).TextString = varOldAtt(intOldCnt).TextString
            End If
         End If
         If varOldAtt(intOldCnt).TagString = "STB2" Then
            If varNewAtt(intNewCnt).TagString = "DSCR1" Then
               varNewAtt(intNewCnt).TextString = varOldAtt(intOldCnt).TextString
            End If
         End If
         If varOldAtt(intOldCnt).TagString = "STB4" Then
            If varNewAtt(intNewCnt).TagString = "TECH" Then
               varNewAtt(intNewCnt).TextString = varOldAtt(intOldCnt).TextString
            End If
         End If
          If varOldAtt(intOldCnt).TagString = "STB5" Then
            If varNewAtt(intNewCnt).TagString = "APP1" Then
               varNewAtt(intNewCnt).TextString = varOldAtt(intOldCnt).TextString
            End If
         End If
   
         If varOldAtt(intOldCnt).TagString = "STB6" Then
            If varNewAtt(intNewCnt).TagString = "MYR" Then
               varNewAtt(intNewCnt).TextString = varOldAtt(intOldCnt).TextString
            End If
         End If
        Next
     Next
  End Select
objNewBlk.Update
objOldBlk.Delete
'ThisDrawing.Application.ZoomExtents

End Sub



Public Sub DeleteSelSet() 'delete selection set
Dim gobjAcadSelectionSets As AcadSelectionSets
Dim objAcadSSet As AcadSelectionSet
Dim strSelSetName As String
 
Set gobjAcadSelectionSets = ThisDrawing.SelectionSets
 strSelSetName = "sSet2"
 
  For Each objAcadSSet In gobjAcadSelectionSets
    If objAcadSSet.Name = strSelSetName Then
      objAcadSSet.Delete
      Exit Sub
    End If
  Next objAcadSSet
End Sub

   

Bryco

  • Water Moccasin
  • Posts: 1882
Re: changing revision blocks to new blocks
« Reply #3 on: October 05, 2006, 11:53:04 PM »
You may have to post a sample dwg to get help on this one, TallCool.
               intTotal = 0.83892 * intCnt        
              If InsertPt(1) <= (yScale * 2.6875) Then   ''''''''''How is the insertionpt related to the scale
                InsertPt(1) = InsertPt(1)
              Else
                InsertPt(1) = InsertPt(1) + ((intTotal) * intCnt) '''''''''I don't get this looks like intCnt*intcnt                
              End If
                  intCnt = intCnt + 1

Plus private  is usually safer than public dims

TallCoolOne

  • Guest
Re: changing revision blocks to new blocks
« Reply #4 on: October 08, 2006, 04:02:53 PM »
You may have to post a sample dwg to get help on this one, TallCool.
               intTotal = 0.83892 * intCnt        
              If InsertPt(1) <= (yScale * 2.6875) Then   ''''''''''How is the insertionpt related to the scale
                InsertPt(1) = InsertPt(1)
              Else
                InsertPt(1) = InsertPt(1) + ((intTotal) * intCnt) '''''''''I don't get this looks like intCnt*intcnt                
              End If
                  intCnt = intCnt + 1

Plus private  is usually safer than public dims
Hey Bryco,
  thanks for pointing me to the spot that fixed it
Quote
nsertPt(1) = InsertPt(1) + ((intTotal) * intCnt) '''''''''I don't get this looks like

i was mutiplying intCnt to many times .... it works    thanks again

mohnston

  • Bull Frog
  • Posts: 305
  • CAD Programmer
Re: changing revision blocks to new blocks
« Reply #5 on: October 12, 2006, 02:00:15 PM »
It's amazing what you can do when you don't know what you can't do.
CAD Programming Solutions