ACAD Block Z-Height

From scripting
Jump to: navigation, search
Sub CCCmain()

Dim AttrText As String
AttrText = ZcoordForm.AttributeText.Value

Dim RemoveP As Boolean
RemoveP = ZcoordForm.RemoveParenthesesBox.Value



For objcounter = 1 To AutoCAD.ActiveDocument.Blocks.Item(AutoCAD.ActiveDocument.Blocks.Count - 1).Count '236

    Dim objUnitTag
    Set objUnitTag = AutoCAD.ActiveDocument.Blocks.Item(AutoCAD.ActiveDocument.Blocks.Count -  1).Item(objcounter)
    On Error GoTo JJJJJJ
    Dim varAttributes As Variant
    Dim objtest 'As Boolean
    'Set objtest = objUnitTag.HasAttributes 

 
    If objUnitTag.HasAttributes Then
    
        varAttributes = objUnitTag.GetAttributes
        'Loop through attributes
        For i = LBound(varAttributes) To UBound(varAttributes)
            If varAttributes(i).TagString = AttrText Then
                'Set new attribute
                
                If RemoveP = True Then
                    strfieldstring = Mid(varAttributes(i).TextString, 2, 5)
                Else
                    strfieldstring = varAttributes(i).TextString
                End If
                
                Dim Zexisting() As Double
                ReDim Zexisting(2)
                Dim ZEValue As Double
                Zexisting = objUnitTag.InsertionPoint
                ZEValue = Zexisting(2)
                Dim varTo() As Double
                ReDim varTo(2)
                Dim varFrom() As Double
                ReDim varFrom(2) 

                If strfieldstring <> "" Then
                    If strfieldstring < 100000000 Then
                        If strfieldstring > 100 Then
                            AutoMove ZEValue, strfieldstring, objUnitTag
                        End If
                    Else
                        strfieldstring = Mid(strfieldstring, 1, 4)
                        If strfieldstring < 100000000 Then  

                            AutoMove ZEValue, strfieldstring, objUnitTag
                        End If
                    End If
                End If 

            
            End If
        Next
    End If
JJJJJJ:
Next objcounter



End Sub

Sub AutoMove(ZHtExisting As Variant, ZProjected As Variant, UnitElement As Variant)

                    Dim varTo() As Double
                    ReDim varTo(2)
                    Dim varFrom() As Double
                    ReDim varFrom(2)
                    varFrom(0) = 0: varFrom(1) = 0: varFrom(2) = ZHtExisting
                    varTo(0) = 0: varTo(1) = 0: varTo(2) = CDbl(ZProjected)
                    
                    UnitElement.Move varFrom, varTo
                     

End Sub