Results 1 to 1 of 1

Thread: vba only works if Autocad LDD 2009 is also installed.

  1. #1
    Member
    Join Date
    2015-11
    Posts
    7
    Login to Give a bone
    0

    Question vba only works if Autocad LDD 2009 is also installed.

    I have a vba routine that creates an mtext with a line's bearing and distance and a curve with its data (we prefer dumb mtext annotation to styles and labels), the routine works fine in C3D 2012 & C3D 2015 as long as we also have Autocad LDD 2009 installed. We're getting to the point where we won't be able to do that, but we also need the annotation routine to work as we move forward.

    Here's a portion of the vba code (the entire code is pretty long):

    Code:
    Function PadNumber(NumIn As Variant, NumOfChars As Integer) As String
        PadNumber = NumIn
        While Len(PadNumber) < NumOfChars
            PadNumber = "0" & PadNumber
        Wend
    End Function
    
    
    Function GiveDMS(NumberIn As Double) As String
        Dim Ds As String
        Dim Ms As String
        Dim Ss As String
        Dim DegreesRemaining As Double
        Degrees = Fix(NumberIn)
        Ds = PadNumber(Degrees, 2)
        DegreesRemaining = NumberIn - Degrees
        Minutes = Fix(DegreesRemaining * 60)
        Ms = PadNumber(Minutes, 2)
        DegreesRemaining = DegreesRemaining - Minutes / 60
        Seconds = Round(DegreesRemaining * 3600, 0)
        Ss = PadNumber(Seconds, 2)
            Select Case Ss
                Case "60"
                    Ms = PadNumber((Minutes + 1), 2)
                    Ss = "00"
            End Select
            Select Case Ms
                Case "60"
                    Ds = PadNumber((Degrees + 1), 2)
                    Ms = "00"
            End Select
        GiveDMS = Ds & Chr(176) & Ms & "'" & Ss & """"
    End Function
    
    
    
    Sub BDinline()
        On Error GoTo errhnd
        Dim mytext As AcadText
        Dim mymtext As AcadMText
        Dim MyLine As AcadLine 'selected line to annotate
        Dim SelPt As Variant
        Dim StPt As Variant
        Dim EnPt As Variant
        Dim Degrees As Double
        Dim Minutes As Double
        Dim Seconds As Double
        Dim inspt As Variant
        Dim Basebearing As Double 'bearing without quadrant
        Dim Finalbearing As String 'bearing with quadrant
        Dim Length As Double
        Dim FinalLength As Double
        Dim Pt1 As Variant 'startpoint
        Dim Pt2 As Variant 'endpoint
        Dim anglefortext As Double
        Dim BaseBearingStr As String
        Dim GotBearing As Boolean
        Dim textboxwidth As Double
        Dim Txtsize As Double
        Dim CurSc As Double
        Dim textstyle As String
        Dim Gotfont As Boolean
        Dim Txtboxwidth As Variant
        
        CurSc = ThisDrawing.GetVariable("DIMSCALE")
        textstyle = ThisDrawing.GetVariable("TEXTSTYLE")
        If textstyle = "L80" Then
        Txtsize = ThisDrawing.GetVariable("DIMSCALE") * 0.08
        Gotfont = True
        End If
        If textstyle = "L100" And Gotfont = False Then
        Txtsize = ThisDrawing.GetVariable("DIMSCALE") * 0.1
        End If
        If textstyle <> "L100" And textstyle <> "L80" And Gotfont = False Then
        MsgBox "Set Style to L80 or L100 and try again."
        GoTo errhnd
        End If
            
        ThisDrawing.Utility.GetEntity MyLine, SelPt, "Select a line."
        MyLine.Highlight True
        Pt1 = MyLine.StartPoint
        Pt2 = MyLine.EndPoint
        If Pt2(0) = Pt1(0) Then
        Finalbearing = "NORTH  "
        GotBearing = True
        End If
        If Pt2(1) = Pt1(1) And GotBearing = False Then
        Finalbearing = "WEST  "
        GotBearing = True
        End If
        If GotBearing = False Then
            Basebearing = RTD(Atn(Abs(Pt2(0) - Pt1(0)) / Abs(Pt2(1) - Pt1(1))))
            BaseBearingStr = GiveDMS(Basebearing)
        End If
        
        Length = FormatNumber(Sqr(((Pt2(0) - Pt1(0)) ^ 2 + (Pt2(1) - Pt1(1)) ^ 2)), 5)
        FinalLength = RoundIt(Length)
        
        If (Pt2(0) > Pt1(0)) And (Pt2(1) > Pt1(1) And GotBearing = False) _
        Or (Pt2(0) < Pt1(0)) And (Pt2(1) < Pt1(1) And GotBearing = False) Then
        Finalbearing = "N" & BaseBearingStr & "E  "
        GotBearing = True
        End If
        
        If (Pt2(0) < Pt1(0)) And (Pt2(1) > Pt1(1) And GotBearing = False) _
        Or (Pt2(0) > Pt1(0)) And (Pt2(1) < Pt1(1) And GotBearing = False) Then
        Finalbearing = "N" & BaseBearingStr & "W  "
        GotBearing = True
        End If
        
            
        ThisDrawing.ActiveTextStyle.ObliqueAngle = DTR(15)
        ThisDrawing.SetVariable "TEXTSIZE", Txtsize
        inspt = ThisDrawing.Utility.GetPoint(, "Select insertion point:")
        OMode = ThisDrawing.GetVariable("OSMODE")
        ThisDrawing.SetVariable "OSMODE", 512
        anglefortext = ThisDrawing.Utility.GetAngle(, "Select insertion angle:")
        ThisDrawing.SetVariable "OSMODE", 0
        MyLine.Highlight False
        Txtboxwidth = Len(Finalbearing & FormatNumber(Length, 2) & "'") * (Txtsize)
        Set mymtext = ThisDrawing.ModelSpace.AddMText(inspt, (Txtboxwidth), Finalbearing & FormatNumber(FinalLength, 2) & "'")
        mymtext.AttachmentPoint = acAttachmentPointBottomCenter
        mymtext.InsertionPoint = inspt
        mymtext.Rotate inspt, anglefortext
        mymtext.Update
        
        
        Select Case Finalbearing
            Case "WEST  "
                If MsgBox("Keep at WEST?", vbYesNo) = vbNo Then
                    mymtext.TextString = Replace(mymtext.TextString, "WEST  ", "EAST  ")
                End If
        End Select
        
    errhnd:
        Select Case Err.number
            Case -2147352567
                On Error Resume Next
                Err.Clear
                'ThisDrawing.Regen (acAllViewports)
            Case 13
                MsgBox "OBJECT IS NOT A LINE!"
                Err.Clear
                'ThisDrawing.Regen (acAllViewports)
            Case Else
                'MsgBox "ERROR " & Err.number
                Err.Clear
                'ThisDrawing.Regen (acAllViewports)
        End Select
        End Sub
    Two questions; 1, is it possible to edit the code so that it works without Autocad LDD 2009? And/or is it easily ported over to .net? I did not write the code, and the guy that did is no longer in our office, so I'm grateful for any help.
    Last edited by Ed Jobe; 2015-02-24 at 11:25 PM. Reason: Added Code Tags

Similar Threads

  1. Replies: 0
    Last Post: 2012-04-17, 10:04 PM
  2. AutoCAD 2009 VBA Package not installed?
    By mikeosborne in forum VBA/COM Interop
    Replies: 3
    Last Post: 2010-01-21, 04:32 PM
  3. Running 2010 with 2009 Installed
    By Matt_Drainage in forum AutoCAD Civil 3D - General
    Replies: 8
    Last Post: 2009-04-27, 08:55 PM
  4. Autocad MEP to Navis works manage 2009
    By sg555.109869 in forum NavisWorks - General
    Replies: 23
    Last Post: 2009-02-19, 09:46 AM
  5. Navis Works 2009 & Windows SP3
    By charlielgolden in forum NavisWorks - General
    Replies: 3
    Last Post: 2008-08-21, 05:37 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •