Το Excel , με σχετικά απλό τρόπο , επικοινωνεί με προγράμματα σαν το Autocad , το GStarCad, το BricsCad το zwCad και λοιπά αντίστοιχα προγράμματα . Αυτό συμβαίνει γιατί υποστηρίζουν ίδιου ή αντίστοιχου τύπου αντικείμενα τα οποία το Excel τα "βλέπει" με τον ίδιο τρόπο.
Ουσιαστικά , αρκεί μια ενασχόληση και μικρή εμπειρία σε προγραμματισμό σε Visual Basic - VBA for Excel προκειμένου να μπορέσουμε να "μιλήσουμε" με προγράμματα τύπου Cad προκειμένου να σχεδιάσουν αυτόματα αντικείμενα στο περιβάλλον του Cad χωρίς να μας ενδιαφέρει το πρόγραμμα Cad στο οποίο αναφερόμαστε . Βέβαια , για να μιλάμε επί συγκεκριμένης βάσης , το παράδειγμα που θα δούμε θα αφορά το GStarCad αλλά θα δούμε το σημείο που θα πρέπει να επέμβει κάποιος για να μπορεί να αξιοποιήσει και άλλα Cad προγράμματα .
1. Η σύνδεση Excel με το GStarCad
Αρχικά δηλώνουμε μεταβλητές που θα είναι ορατές σε όλο το πρόγραμμα και υλοποιούμε την σύνδεση .
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 PLineObj As Object Public CircleObj As Object Public LayerObj As Object Sub AcadConnect(id As Integer) On Error Resume Next id = 0 Set AcadApp = GetObject(, "GStarCad.Application") If Err Then MsgBox "Activate GStarCad before you run this program", , "ERROR !!!" id = -100 Exit Sub End If End Sub
Η διαδικασία της διασύνδεσης είναι απλή και εκείνο που μένει είναι να δημιουργήσουμε υποπρογράμματα - υπορουτίνες ώστε να "στείλουμε" στο Cad γραμμές , κύκλους , κείμενο κλπ . Ακολουθεί απλή υπορουτίνα για "αποστολή" μιας απλής γραμμής δύο διαστάσεων .
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 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 AcadText(xp, yp, h, Angle, LayerName, 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 = LayerName End Sub
Η σύνθεση όλων αυτών με βάση τιμές που διαβάζονται από συγκεκριμένα κελλιά του φύλλου εργασίας , σε συνδυασμό με τις κατάλληλες υπορουτίνες , παράγουν απλά και σύνθετα σχέδια , με πληροφορίες οργανωμένες σε επίπεδα (layers) , διαστάσεις κ.λ.π.
Στο πρώτο μέρος αυτού του αφιερώματος , μπορείτε να μελετήσετε τα μικρά αποσπάσματα προγράμματος που παρατέθηκαν .
Στο αμέσως επόμενο θα αναλυθούν συνθετότερες υπορουτίνες και θα υπάρχει η δυνατότητα να "κατεβάσετε" ένα πιο ολοκληρωμένο παράδειγμα για να πειραματιστείτε .
Δεν υπάρχουν σχόλια:
Δημοσίευση σχολίου