Μεταφορά δεδομένων από το Excel στο Autocad

Αρκετές φορές είναι επιθυμητό να γίνει σχεδίαση στο Autocad με βάση γεωμετρικά δεδομένα που υπάρχουν σε κάποιο φύλλο εργασίας στο Excel . Αυτό είναι βολικό να γίνει με αυτόματο τρόπο και χωρίς κάποια δική μας ιδιαίτερη παρέμβαση .

Το πρώτο που πρέπει να κάνουμε είναι να προετοιμάσουμε τα δεδομένα και να τα οργανώσουμε σε ένα φύλλο εργασίας του Excel.

Στη συνέχεια θα "τρέξουμε" το πρόγραμμα που συνδέει δυναμικά το Excel με το Autocad και με βάση τα περιεχόμενα συγκεκριμένων κελλιών κάνει την σχεδίαση στο περιβάλλον του Autocad αυτόματα.

Το φύλλο εργασίας είναι απλό και περιέχει το όνομα της πλάκας καθώς και τις διαστάσεις της κατά Χ και Υ.

Με τον παρακάτω κώδικα που είναι γραμμένος σε Excel VBA , και εφόσον είναι ανοικτό το Autocad , μόλις τρέξουμε την μακροεντολή , τότε στο περιβάλλον του Excel βλέπουμε ένα σχήμα σαν το παρακάτω  :

Public AcadApp As Object
Public AcadDoc As Object
Public moSpace As Object
Public paSpace As Object
Public TextObj As Object
Public LineObj As Object
Public CircleObj As Object
Public TextStyle As Object
Public LayerObj As Object

Sub AcadConnect()

On Error Resume Next

Set AcadApp = GetObject(, "Autocad.Application")
If Err Then
    Err.Clear
    Set AcadApp = CreateObject("Autocad.Application")
    AcadApp.Visible = True
    If Err Then
        MsgBox Err.Description
        Exit Sub
    End If
End If

End Sub
Sub AcadClose()
    Set AcadApp = Nothing
End Sub

Sub AcadLine(xs As Double, ys As Double, xe As Double, ye As Double, LayerName As String)
    Dim sp(0 To 2) As Double
    Dim ep(0 To 2) As Double
    
    sp(0) = xs
    sp(1) = ys
    sp(2) = 0#
    ep(0) = xe
    ep(1) = ye
    ep(2) = 0#
    
    Set LineObj = AcadApp.ActiveDocument.ModelSpace.AddLine(sp, ep)
    
    LineObj.Layer = LayerName
End Sub

Sub AcadRect(xp As Double, yp As Double, Lx As Double, Ly As Double, LayName As String)

' Draw a rectangle that begins from xp,yp
' and has dimensions Lx and Ly

    AcadLine xp, yp, xp + Lx, yp, LayName
    AcadLine xp + Lx, yp, xp + Lx, yp + Ly, LayName
    AcadLine xp + Lx, yp + Ly, xp, yp + Ly, LayName
    AcadLine xp, yp + Ly, xp, yp, LayName

End Sub
Sub AcadText(xp, yp, h, Angle, LName, txt)
    Dim pp(0 To 2) As Double
    
    pp(0) = xp: pp(1) = yp: pp(2) = 0#
    Set TextObj = AcadApp.ActiveDocument.ModelSpace.AddText(txt, pp, h)
    TextObj.Rotation = Angle
    TextObj.Layer = LName
End Sub
Sub AcadCircle(xc As Double, yc As Double, R As Double, LayerName)
    Dim cp(0 To 2) As Double
    
    cp(0) = xc: cp(1) = yc: cp(2) = 0#
    Radius# = R
    Set CircleObj = AcadApp.ActiveDocument.ModelSpace.AddCircle(cp, Radius#)
    CircleObj.Layer = LayerName
End Sub
Sub AcadNewLayer(LayerName, LayerClr%)
    
        Set LayerObj = AcadApp.ActiveDocument.Layers.Add(LayerName)
        LayerObj.Color = LayerClr%
End Sub
Sub MainRoutine()
    
    Dim dx As Double, dy As Double
    Dim Onoma As String
    
    
    ' Connect with Autocad - Verrsions after 2004 are supported
    
    AcadConnect
    
    AcadNewLayer "Keimeno", 6
    AcadNewLayer "Plakes", 3
    
    ' Data started at 5th line
    
     
         
         Onoma = Cells(5, 2) ' : Name of the plate
         dx = Cells(5, 3) ' Lx Dimension
         dy = Cells(5, 4) ' Ly Dimension
         
         ' Draw the plate at 5,5 (random point of start)
         
         AcadRect 5, 5, dx, dy, "Plakes"
         
         ' Write the name of the plate
         
         AcadText 5, 4.5, 0.2, 0, "Keimeno", Onoma
         
         
     
    
    AcadClose
End Sub

Κατεβάστε το αρχείο Excel με τις μακροεντολές για σύνδεση με το Autocad από εδώ.

Μην ξεχάσετε να ενεργοποιήσετε τις μακροεντολές και να ανοίξετε το Autocad (συμβατότητα με εκδόσεις  νεώτερες από την 2004) πριν ξεκινήσετε τους πειραματισμούς σας.

Στο απλό παράδειγμα που παραθέτω σήμερα , τα δεδομένα διαβάζονται από 3 συγκεκριμένα κελλιά του φύλλου εργασίας. Σε επόμενο παράδειγμα , τα δεδομένα θα μπορούν να διαβάζονται από γραμμές και στήλες και η σχεδίαση θα γίνεται επαναληπτική ώστε να σχεδιάζονται πολλές πλάκες μαζί. Μάλιστα , θα γίνεται και μια απλή διαστασιολόγηση . Πειραματιστείτε προς το παρόν με αυτό και θα υπάρξει και συνέχεια. Αρκεί από μέρους σας να υπάρξει πραγματικό ενδιαφέρον.