Αρκετές φορές είναι επιθυμητή η "μεταφορά" παραμέτρων από τα κελλιά κάποιου φύλλου εργασίας στο Excel , κατευθείαν στο Autocad . Αν έχει γίνει πλήρης εγκατάσταση και των δύο προγραμμάτων , με μια σχετικά απλή διαδικασία , μπορεί να υλοποιηθεί μια "γέφυρα" μεταξύ των δύο προγραμμάτων . Βέβαια , απαιτούνται κάποιες βασικές γνώσεις προγραμματισμού αλλά στα αρχεία βοήθειας του Autocad εξηγείται αναλυτικά η διαδικασία .
1. Σύνδεση Excel με το Autocad
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
2. Βασικές διαδικασίες για την σχεδίαση απλών αντικειμένων
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(orgx As Double, orgy As Double, platos As Double, ypsos As Double, LayerName As String) Dim x(5) As Double, y(5) As Double Dim np As Integer np = 5 x(1) = orgx: y(1) = orgy x(2) = orgx + platos: y(2) = orgy x(3) = orgx + platos: y(3) = orgy - ypsos x(4) = orgx: y(4) = orgy - ypsos x(5) = orgx: y(5) = orgy For i = 1 To 4 AcadLine x(i), y(i), x(i + 1), y(i + 1), LayerName Next 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
Δεν υπάρχουν σχόλια:
Δημοσίευση σχολίου