×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Contact US

*
*
*
*

Thanks. We have received your request and will respond promptly.

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

need help with attributes retrieval in VBA routine

thread687-1361362

need help with attributes retrieval in VBA routine

need help with attributes retrieval in VBA routine

(OP)
Belows is some code for a calculating routine. The program stops and I get Compile erro: cant find project or library. I have done a repair install Autocad 2002 and this did not help. I have noted where the routine breaks in red. any ideas would be very helpful.
 

CODE

Public acad As Object
Public doc As Object
Public ms As Object
Public ss As Object
Public ssnew As Object
Public Theatts As Variant
Public MsgBoxResp As Integer
'declare global variables


Sub UpdateAttrib(tagnumber As Integer, BTextString As String)
  'This Sub Procedure tests the attribute data to check
  'that is not a null value
  
  If BTextString = "" Then
  'if the attribute is empty
  
    Theatts(tagnumber).TextString = ""
    'put a '-' place holder
    
   Else
   'if it is not empty
   
    Theatts(tagnumber).TextString = BTextString
    'use the attribute value
    
  End If
  
End Sub






Private Sub Label1_Click()

End Sub

Private Sub UserForm_Initialize()
 Dim BlkG(0) As Integer
  Dim TheBlock(0) As Variant
  Dim Pt1(0 To 2) As Double
  Dim Pt2(0 To 2) As Double
  'declare local variables
  

  Set acad = GetObject(, "AutoCAD.Application")
  'set reference to AutoCAD
  
  Set doc = acad.ActiveDocument
  'set reference to the drawing
  
  Set ms = doc.ModelSpace
  'set reference to model space
  Set ssnew = doc.SelectionSets.Add("TBLK")
  'create a selection set
  ssnew.SelectOnScreen
  
  Pt1(0) = 0: Pt1(1) = 0: Pt1(2) = 0
  Pt2(0) = 3: Pt2(1) = 3: Pt2(2) = 0
  'set up the array
  
  BlkG(0) = 2
  'group code 2 for block name
  
  
  
  ssnew.Select 5, Pt1, Pt2, BlkG, TheBlock
  'get the block
  
  If ssnew.Count >= 1 Then
  'if the block is found
  
    Theatts = ssnew.Item(0).GetAttributes
    'get the attributes
    
    UserForm1.txt1.Text = UCase(LTrim(Theatts(0).TextString))
    'get the title attribute
    'clear any leading spaces and
    'convert to uppercase
    
    UserForm1.txt0.Text = UCase(LTrim(Theatts(0).TextString))
    UserForm1.txt1.Text = UCase(LTrim(Theatts(1).TextString))
    UserForm1.txt2.Text = UCase(LTrim(Theatts(6).TextString))
    UserForm1.txt3.Text = UCase(LTrim(Theatts(7).TextString))
    UserForm1.txt4.Text = UCase(LTrim(Theatts(12).TextString))
    UserForm1.txt5.Text = UCase(LTrim(Theatts(13).TextString))
    UserForm1.txt6.Text = UCase(LTrim(Theatts(18).TextString))
    UserForm1.txt7.Text = UCase(LTrim(Theatts(19).TextString))
    UserForm1.txt8.Text = UCase(LTrim(Theatts(24).TextString))
    UserForm1.txt9.Text = UCase(LTrim(Theatts(25).TextString))
    UserForm1.txt14.Text = UCase(LTrim(Theatts(2).TextString))
    UserForm1.txt15.Text = UCase(LTrim(Theatts(3).TextString))
    UserForm1.txt16.Text = UCase(LTrim(Theatts(8).TextString))
    UserForm1.txt17.Text = UCase(LTrim(Theatts(9).TextString))
    UserForm1.txt18.Text = UCase(LTrim(Theatts(14).TextString))
    UserForm1.txt19.Text = UCase(LTrim(Theatts(15).TextString))
    UserForm1.txt20.Text = UCase(LTrim(Theatts(20).TextString))
    UserForm1.txt21.Text = UCase(LTrim(Theatts(21).TextString))
    UserForm1.txt22.Text = UCase(LTrim(Theatts(26).TextString))
    UserForm1.txt23.Text = UCase(LTrim(Theatts(27).TextString))
    UserForm1.txt28.Text = UCase(LTrim(Theatts(4).TextString))
    UserForm1.txt29.Text = UCase(LTrim(Theatts(5).TextString))
    UserForm1.txt30.Text = UCase(LTrim(Theatts(10).TextString))
    UserForm1.txt31.Text = UCase(LTrim(Theatts(11).TextString))
    UserForm1.txt32.Text = UCase(LTrim(Theatts(16).TextString))
    UserForm1.txt33.Text = UCase(LTrim(Theatts(17).TextString))
    UserForm1.txt34.Text = UCase(LTrim(Theatts(22).TextString))
    UserForm1.txt35.Text = UCase(LTrim(Theatts(23).TextString))
    UserForm1.txt36.Text = UCase(LTrim(Theatts(28).TextString))
    UserForm1.txt37.Text = UCase(LTrim(Theatts(29).TextString))
        
    UserForm1.txt1.SetFocus
    UserForm1.txt1.SelStart = 0
    UserForm1.txt1.SelLength = Len(UserForm1.txt1.Text)
    'set the focus to the drawing title and highlight it
    
UserForm1.totala.Text = (Val(UserForm1.txt0.Text) + Val(UserForm1.txt1.Text) + Val(UserForm1.txt2.Text) + Val(UserForm1.txt3.Text) + Val(UserForm1.txt4.Text) + Val(UserForm1.txt5.Text) + Val(UserForm1.txt6.Text) + Val(UserForm1.txt7.Text) + Val(UserForm1.txt8.Text) + Val(UserForm1.txt9.Text)) / 1000
totala.Text = Format((Val(UserForm1.txt0.Text) + Val(UserForm1.txt1.Text) + Val(UserForm1.txt2.Text) + Val(UserForm1.txt3.Text) + Val(UserForm1.txt4.Text) + Val(UserForm1.txt5.Text) + Val(UserForm1.txt6.Text) + Val(UserForm1.txt7.Text) + Val(UserForm1.txt8.Text) + Val(UserForm1.txt9.Text)) / 1000, "###0.0")
UserForm1.totalb.Text = (Val(UserForm1.txt14.Text) + Val(UserForm1.txt15.Text) + Val(UserForm1.txt16.Text) + Val(UserForm1.txt17.Text) + Val(UserForm1.txt18.Text) + Val(UserForm1.txt19.Text) + Val(UserForm1.txt20.Text) + Val(UserForm1.txt21.Text) + Val(UserForm1.txt22.Text) + Val(UserForm1.txt23.Text)) / 1000
totalb.Text = Format((Val(UserForm1.txt14.Text) + Val(UserForm1.txt15.Text) + Val(UserForm1.txt16.Text) + Val(UserForm1.txt17.Text) + Val(UserForm1.txt18.Text) + Val(UserForm1.txt19.Text) + Val(UserForm1.txt20.Text) + Val(UserForm1.txt21.Text) + Val(UserForm1.txt22.Text) + Val(UserForm1.txt23.Text)) / 1000, "###0.0")
UserForm1.totalc.Text = (Val(UserForm1.txt28.Text) + Val(UserForm1.txt29.Text) + Val(UserForm1.txt30.Text) + Val(UserForm1.txt31.Text) + Val(UserForm1.txt32.Text) + Val(UserForm1.txt33.Text) + Val(UserForm1.txt34.Text) + Val(UserForm1.txt35.Text) + Val(UserForm1.txt36.Text) + Val(UserForm1.txt37.Text)) / 1000
totalc.Text = Format((Val(UserForm1.txt28.Text) + Val(UserForm1.txt29.Text) + Val(UserForm1.txt30.Text) + Val(UserForm1.txt31.Text) + Val(UserForm1.txt32.Text) + Val(UserForm1.txt33.Text) + Val(UserForm1.txt34.Text) + Val(UserForm1.txt35.Text) + Val(UserForm1.txt36.Text) + Val(UserForm1.txt37.Text)) / 1000, "###0.0")
UserForm1.totalkw.Text = Val(UserForm1.totala.Text) + Val(UserForm1.totalb.Text) + Val(UserForm1.totalc.Text)
UserForm1.totalamp.Text = Val(UserForm1.totalkw.Text * 1000) / 360
totalamp.Text = Format(Val(UserForm1.totalkw.Text * 1000) / 360, "###0.0")
totalkw.Text = Format(Val(UserForm1.totala.Text) + Val(UserForm1.totalb.Text) + Val(UserForm1.totalc.Text), "###0.0")
'retrieve the calculated attribute values


'clean up
    
    UpdateAttrib 0, UserForm1.txt0.Text
    UpdateAttrib 1, UserForm1.txt1.Text
    UpdateAttrib 6, UserForm1.txt2.Text
    UpdateAttrib 7, UserForm1.txt3.Text
    UpdateAttrib 12, UserForm1.txt4.Text
    UpdateAttrib 13, UserForm1.txt5.Text
    UpdateAttrib 18, UserForm1.txt6.Text
    UpdateAttrib 19, UserForm1.txt7.Text
    UpdateAttrib 24, UserForm1.txt8.Text
    UpdateAttrib 25, UserForm1.txt9.Text
    'UpdateAttrib 30, UserForm1.txt10.Text
    'UpdateAttrib 31, UserForm1.txt11.Text
    'UpdateAttrib 36, UserForm1.txt12.Text
    'UpdateAttrib 37, UserForm1.txt13.Text
    UpdateAttrib 2, UserForm1.txt14.Text
    UpdateAttrib 3, UserForm1.txt15.Text
    UpdateAttrib 8, UserForm1.txt16.Text
    UpdateAttrib 9, UserForm1.txt17.Text
    UpdateAttrib 14, UserForm1.txt18.Text
    UpdateAttrib 15, UserForm1.txt19.Text
    UpdateAttrib 20, UserForm1.txt20.Text
    UpdateAttrib 21, UserForm1.txt21.Text
    UpdateAttrib 26, UserForm1.txt22.Text
    UpdateAttrib 27, UserForm1.txt23.Text
    'UpdateAttrib 32, UserForm1.txt24.Text
    'UpdateAttrib 33, UserForm1.txt25.Text
    'UpdateAttrib 38, UserForm1.txt26.Text
    'UpdateAttrib 39, UserForm1.txt27.Text
    UpdateAttrib 4, UserForm1.txt28.Text
    UpdateAttrib 5, UserForm1.txt29.Text
    UpdateAttrib 10, UserForm1.txt30.Text
    UpdateAttrib 11, UserForm1.txt31.Text
    UpdateAttrib 16, UserForm1.txt32.Text
    UpdateAttrib 17, UserForm1.txt33.Text
    UpdateAttrib 22, UserForm1.txt34.Text
    UpdateAttrib 23, UserForm1.txt35.Text
    UpdateAttrib 28, UserForm1.txt36.Text
    UpdateAttrib 29, UserForm1.txt37.Text
    'UpdateAttrib 34, UserForm1.txt38.Text
    'UpdateAttrib 35, UserForm1.txt39.Text
    'UpdateAttrib 40, UserForm1.txt40.Text
    'UpdateAttrib 41, UserForm1.txt41.Text
    UpdateAttrib 30, UserForm1.totala.Text
    UpdateAttrib 33, UserForm1.totalkw.Text
    UpdateAttrib 34, UserForm1.totalamp.Text
    UpdateAttrib 31, UserForm1.totalb.Text
    UpdateAttrib 32, UserForm1.totalc.Text
    FixAttrib 0, UserForm1.txt0.Text
    FixAttrib 1, UserForm1.txt1.Text
    FixAttrib 6, UserForm1.txt2.Text
    FixAttrib 7, UserForm1.txt3.Text
    FixAttrib 12, UserForm1.txt4.Text
    FixAttrib 13, UserForm1.txt5.Text
    FixAttrib 18, UserForm1.txt6.Text
    FixAttrib 19, UserForm1.txt7.Text
    FixAttrib 24, UserForm1.txt8.Text
    FixAttrib 25, UserForm1.txt9.Text
    'FixAttrib 30, UserForm1.txt10.Text
    'FixAttrib 31, UserForm1.txt11.Text
    'FixAttrib 36, UserForm1.txt12.Text
    'FixAttrib 37, UserForm1.txt13.Text
    FixAttrib 2, UserForm1.txt14.Text
    FixAttrib 3, UserForm1.txt15.Text
    FixAttrib 8, UserForm1.txt16.Text
    FixAttrib 9, UserForm1.txt17.Text
    FixAttrib 14, UserForm1.txt18.Text
    FixAttrib 15, UserForm1.txt19.Text
    FixAttrib 20, UserForm1.txt20.Text
    FixAttrib 21, UserForm1.txt21.Text
    FixAttrib 26, UserForm1.txt22.Text
    FixAttrib 27, UserForm1.txt23.Text
    'FixAttrib 32, UserForm1.txt24.Text
    ''FixAttrib 33, UserForm1.txt25.Text
    'FixAttrib 38, UserForm1.txt26.Text
    'FixAttrib 39, UserForm1.txt27.Text
    FixAttrib 4, UserForm1.txt28.Text
    FixAttrib 5, UserForm1.txt29.Text
    FixAttrib 10, UserForm1.txt30.Text
    FixAttrib 11, UserForm1.txt31.Text
    FixAttrib 16, UserForm1.txt32.Text
    FixAttrib 17, UserForm1.txt33.Text
    FixAttrib 22, UserForm1.txt34.Text
    FixAttrib 23, UserForm1.txt35.Text
    FixAttrib 28, UserForm1.txt36.Text
    FixAttrib 29, UserForm1.txt37.Text
    'FixAttrib 34, UserForm1.txt38.Text
    'FixAttrib 35, UserForm1.txt39.Text
    'FixAttrib 40, UserForm1.txt40.Text
    'FixAttrib 41, UserForm1.txt41.Text
    FixAttrib 30, UserForm1.totala.Text
    FixAttrib 33, UserForm1.totalkw.Text
    FixAttrib 34, UserForm1.totalamp.Text
    FixAttrib 31, UserForm1.totalb.Text
    FixAttrib 32, UserForm1.totalc.Text
    
    'get the attribute values
    
    ssnew.Item(0).Update
    'update the attribute block
    ssnew.Delete
    End
    
  Else
  'if no attribute title block is found
  
   MsgBox "Sorry - Panel A not in drawing....", vbCritical, "Nothing to calculate!"
   'inform the user that there is no attribute title block
   ssnew.Delete
   End
   'end the application
   
 End If
End Sub

Sub FixAttrib(tagnumber As Integer, BTextString As String)
  'This Sub Procedure replace zeros with a "-"
  
  
  If BTextString = "0" Then
  'if the attribute is empty
  
    Theatts(tagnumber).TextString = "-"
    'put a '-' place holder
    
   Else
   'if it is not empty
   
    Theatts(tagnumber).TextString = BTextString
    'use the attribute value
    
  End If

  
  
  End Sub

RE: need help with attributes retrieval in VBA routine

(OP)
I FOUND THE PROBLEM. CRYSTAL REPORTS. FIXED IT NOW.

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members! Already a Member? Login
Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close