Koppeling Excel - AutoCad

[Jacobusje]

Goedenavond,

Ik ben al een poosje aan het stoeien met onderstaand "probleem".
Heel lang geleden heb met VBA een koppeling gemaakt die met de kolommen 1 tm 4 lijnen zet in AutoCad, daarnaast ook maatlijnen met weer andere kolommen.

Nu wil ik met de kolommen 13 tm 17 tekst plaatsen in AutoCAD.
De waarden worden dan gegenereerd met Excel.
13 : X-coördinaat
14 : Y-coördinaat
15 : Hoogte tekst
16 : Rotatie
17 : "tekst"

De 2 stukjes code zijn als volgt:

Sub tekst(x, y, h, rotatie, txtregel)

    commando = "[TEXT " & x & "," & _
                           y & " " & _
                           h & " " & _
                           rotatie & " " & Chr(13) & _
                           txtregel & Chr(13) & _
                           "]"
   Application.DDEExecute KanaalNr, commando
End Sub 'Einde tekst

en

Call verbinden
i = 1
 Do
  Call tekst(xVeld(i, 13), xVeld(i, 14), xVeld(i, 15), xVeld(i, 16), xVeld(i, 17))
 i = i + 1
 Loop Until xVeld(i, 1) = ""
 Call verbreken

Kolom 13, 14 en 15 werken goed.
16 eigenlijk ook, wat hij neemt die waarde wel mee naar AutoCAD.
Maar in AutoCAD blijft de tekst cursor knipperen en vraagt hij onderin hoeveel graden de tekst gedraaid moet worden.
Daar moet ik dan een "Enter" op geven en dan stopt de code. En dus geen teksten.

Ik heb de code van roteren en kolom 16 op allerlei manieren aangepast en ook uit de code verwijderd, maar hij vraag steeds weer om een rotatie op te geven.
Weet iemand hier een oplossing voor?

 

[snb]

Met welke waarde geef je in Autocad een rotatie van 45° aan ?
Wat staat er in in cell(2,16) ?

Waarom laat je ons zoveel gissen/raden vanwege ontbrekende informatie ?

Waarom maak je geen gebruik van currentregion en een Array ?

Sub M_snb()
  sn=sheet1.cells(1).currentregion.resize(,17)

  for j=2 to ubound(sn)
     Application.DDEExecute KanaalNr, join(array("[Text",sn(j,13),sn(j,14),sn(j,15),sn(j,16),sn(j,17),"]"))
  next
End sub

 

[Jacobusje]

Sorry dat ik misschien niet volledig ben geweest, maar welke informatie ontbreekt er?

Wat ik doe:
Ik zet met de eerste set kolommen lijnen waarvan de coördinaten door Excel berekend worden
Met de tweede set plaats ik maatlijnen
En met de derde set wil ik graag teksten plaatsen, de posities en textinhoud zijn weer afhankelijk van de invoer op een ander tabblad.

In de kolom in Excel geef je alleen een waarde zonder toevoeging, dat doe je ook in AutoCAD bij het opgeven van een rotatiewaarde.
Dat kan overigens ook negatief zijn.

Het vervelende van dit geval is dat ik de rotatie eigenlijk niet wil/niet nodig heb, die zat al in die code.

Currentregion zegt mij niets....
Of Array werkt weet ik niet, in de kolom 17 staat elke keer een andere tekst.

Wat de code betreft is het voor mij een soort hobby, maar ben zeker geen expert
Indien gewenst kan ik vanavond een voorbeeld posten.

 

[snb]

Heb je de voorgestelde code getest ?
Een voorbeeld is altijd het beste.

 

[AHulpje]

Heel lang geleden (april 1999) maakte ik onderstaande macro, ik heb geen Autocad meer maar ben benieuwd of deze code nog werkt.
Voorwaarde: referentie naar Autocad Object Library

 

[Jacobusje]

Ik probeer vanavond om er naar te kijken, ben laat thuis.
Anders wordt het morgen.

 

[alphamax]

Gebruik VBA en niet een methode om toetsaanslagen in de commandline te simuleren.
Code werkt vanuit autocad en niet vanuit excel.
Moet het vanuit excel dan roep je vanuit excel, autocad aan, en dan krijg je vergelijkbare code als van AHulpje.
Maar je kan ook vanuit autocad een excel bestand aanroepen.
Maar dan moet ik in mijn geheugen duiken, want het is lang geleden dat ik als engineer iets heb gedaan met excel, autocad en VBA.

Sub CreateText()
Dim XLnCADText As AcadText
Dim InsPoint(0 To 2) As Double
Dim Height As Double
Dim Content As String
InsPoint(0) = 300#: InsPoint(1) = 450#: InsPoint(2) = 0
Height = 10
Content = "XL n CAD"
Set XLnCADText = ThisDrawing.ModelSpace.AddText(Content, InsPoint, Height)
XLnCADText.Rotation = (25 * 3.14) / 180
ZoomAll
End Sub

bron: https://xlncad.com/macros-autocad/macro-to-create-text-in-autocad-drawing/

 

[Jacobusje]

Allen bedankt voor de reacties!

Ahulpje,
Ik kom niet door de beveiliging van office heen, maar aan de opbouw van het tabblad lijkt het op hetgeen ik gebruik voor de lijnen uittekenen.

Bij de codes van Snb en Alphamax krijg verschillende foutmeldingen.

In de bijlage het bestand met mijn codes, hij staat nu ingesteld voor AutoCAD 2019 en 2020
Ook de codes van Snb en Alphamax heb ik er bij gezet.

 

[Jacobusje]

Op mijn werk heb ik de code van Ahulpje kunnen bekijken.
En inderdaad mis ik de Autocad Object Library.

Mijn wens is toch om bij mijn eigen code te blijven, die werkt zonder de Autocad Object Library.
Alleen de de tekst loopt vast bij de rotatie.

Heeft iemand hier nog een idee voor?

 

[AHulpje]

Microsoft VBA Module for AutoCAD

Download hier de Microsoft VBA Module voor AutoCAD:
https://www.autodesk.com/support/technical/article/caas/tsarticles/ts/3kxk0RyvfWTfSfAIrcmsLQ.html

 

[Jacobusje]

Het wil niet lukken.

Volgens je gestuurde link heb ik die voor 2020 geïnstalleerd.

Daarbij moet ik opmerken dat het AutoCAD Architecture is.
En ik denk ook nog de OEM-versie, omdat wij dit gebruiken samen met een ander 3D-pakket.

Bij het klikken op de knop "Draw" geeft hij de melding "Kan het project of de bibliotheek niet vinden".
En vervolgens verschijnt het scherm zoals in de bijlage.
Ik vermoed dat dit door mijn versie komt.

 

[alphamax]

Daarbij moet ik opmerken dat het AutoCAD Architecture is.

Autocad architecture is een uitgebreidere functie van autocad, dat zou dus geen probleem moeten zijn.

Bij het klikken op de knop "Draw" geeft hij de melding "Kan het project of de bibliotheek niet vinden".

Het klinkt tegenstrijdig, maar klik het vinkje voor ONTBREEKT uit.

Heb je mijn code uit bericht#7 laten lopen binnen autocad? zie http://what-when-how.com/autocad-vb...ironment-developing-a-simple-vba-application/ om de VBA IDE integrated development environment te openen.
Als mozes niet naar de berg komt, komt de berg naar mozes.

 

[alphamax]

Dit zou een variant van je eigen code moeten zijn die werkt.
Wel zelf uitzoeken welk variabele/getal wat betekend.

x1 = 0
y1 = 0
pnam1 = "p1"
DDEExecute [COLOR=#ff0000]KanaalNr[/COLOR], "[text " & x1 & "," & y1 & " 15 0 " & pnam1 & Chr(13) & Chr(13) & "]"

bron: http://akon.sakura.ne.jp/it/cgi/DDE.html

 

[alphamax]

Dit is een combinatie van bericht #5 en bericht#7 en is zo min mogelijk afhankelijk van wat al ingesteld is (dus zou overal moeten werken).

In Excel VBA Sheet1/Blad1

Option Explicit

Public Sub ExcelToAcadText()

    Dim acadApp As Object
    Dim acadDoc As Object
    Dim acadMod As Object
    Dim acadText As Object
    Dim InsPoint(0 To 2) As Double
    Dim Height As Double
    Dim Content As String
    Dim i As Integer

    On Error Resume Next
    Set acadApp = GetObject(, "AutoCad.Application")
    If Err.Number > 0 Then
        Set acadApp = CreateObject("AutoCad.Application")
    End If
    On Error GoTo 0
    Set acadDoc = acadApp.ActiveDocument
    Set acadMod = acadDoc.ModelSpace

    With Worksheets("Sheet1")    'Worksheets("Bald1")
        i = 1
        Do
            InsPoint(0) = .Cells(i, 13): InsPoint(1) = .Cells(i, 14): InsPoint(2) = 0
            Height = .Cells(i, 15)
            Content = .Cells(i, 17)
            Set acadText = acadMod.AddText(Content, InsPoint, Height)
            acadText.Rotation = (.Cells(i, 16) * 3.14) / 180
            i = i + 1
        Loop Until .Cells(i, 1) = ""
    End With

    acadApp.Visible = True
    acadDoc.ActiveViewport.ZoomExtents

    Set acadApp = Nothing
    Set acadDoc = Nothing
    Set acadMod = Nothing
    Set acadText = Nothing

End Sub

Helaas heb ik geen werkende versie van autocad meer, maar in het verleden heb ik soortgelijke code geschreven.

 

[Jacobusje]

Alphamax,

Bedankt!

Er gebeurt wel wat.
Hij plaatst tekst, hij roteert onder de juiste hoek.
Tekst grootte is volgens kolom 15

Maar ik krijg op regel "Set acadText = acadMod.AddText(Content, InsPoint, Height)" de foutmelding "Invalid input"
Als ik op "Beëindigen of op foutopsporing klik wordt de tekst toch wel geplaatst.
De kolom 17 in Excel heeft de eigenschap "Tekst"
Waar kan die foutmelding vandaan komen?

Ander dingetje is dat de tekst niet op de waarden komen uit de kolom maar de eerste op x 31948.3589 en Y 19155.5
Hoe ik de waarde in de kolom 13 en 14 ook aanpas, hij komt steeds op dezelfde coördinaten te staan
Overigens; hij schuif voor de 2e tekst wel de waarde van het verschil van de 2 regels verder.
Doe ik nog iets fout of hoe komt hij aan die positie?

 

[alphamax]

Plaats je bestand met de code waarin je bovenstaande ziet.

 

[Jacobusje]

Bijgaand het bestand.

De code van de tekst toevoegen heb ik er los in staan en ook bij de andere code ingevoegd.
Bij beide krijg ik dezelfde uitkomsten.

 

[alphamax]

In

Public Sub ExcelToAcadText()

vervang

Loop Until .Cells(i, 1) = ""

door

Loop Until .Cells(i, 13) = ""

in kolom 1 staan veel meer regels dan in kolom 13, hierdoor laadt de code de waarde 0 in, en een teksthoogte van 0 mag niet.

Sub Rollaag()

Deze code niet meer gebruiken
Hier worden 2 manieren om autocad aan te sturen door elkaar gebruikt (Application.DDEExecute en GetObject(, "AutoCad.Application"))
Ik vind het niet gek dat het hier mis gaat.

Zorg eerst dat

Public Sub ExcelToAcadText()

goed werkt voordat je er andere toeters en bellen aan gaat hangen.
Want het is nu een grote knip en plak partij waar niemand vrolijk van wordt.

 

[alphamax]

Kon het niet laten en heb mijn oude pc eens afgestoft.
Dit werkt bij mij.
Windows7, Excel2007, AutoCAD2004.
Screenshots in het bestand.
In ActiveX Developer's Guide (ActiveX/VBA) kan je alles nazoeken, zie https://help.autodesk.com/view/OARX/2023/ENU/?guid=GUID-36BF58F3-537D-4B59-BEFE-2D0FEF5A4443
Kijk de code maar eens goed na, verander hier en daar een waarde en kijk wat gebeurt, zo heb ik het ook geleerd.

Option Explicit

Public Sub Rollaag()

    Dim acadApp As Object
    Dim acadDoc As Object
    Dim acadMod As Object
    Dim acadText As Object
    Dim dimObj As Object
    Dim endPoint(0 To 2) As Double
    Dim height As Double
    Dim i As Integer
    Dim insertionpoint(0 To 2) As Double
    Dim lineObj As Object
    Dim location(0 To 2) As Double
    Dim point1(0 To 2) As Double
    Dim point2(0 To 2) As Double
    Dim startPoint(0 To 2) As Double
    Dim textString As String

    On Error Resume Next
    Set acadApp = GetObject(, "AutoCad.Application")
    If Err.Number > 0 Then
        Set acadApp = CreateObject("AutoCad.Application")
    End If
    On Error GoTo 0
    Set acadDoc = acadApp.ActiveDocument
    Set acadMod = acadDoc.ModelSpace

    With Worksheets("Uittekenen")
        i = 1
        Do
            startPoint(0) = .Cells(i, 1): startPoint(1) = .Cells(i, 2): startPoint(2) = 0#
            endPoint(0) = .Cells(i, 3): endPoint(1) = .Cells(i, 4): endPoint(2) = 0#
            Set lineObj = acadMod.AddLine(startPoint, endPoint)
            i = i + 1
        Loop Until .Cells(i, 1) = ""

        i = 1
        Do
            point1(0) = .Cells(i, 6): point1(1) = .Cells(i, 7): point1(2) = 0#
            point2(0) = .Cells(i, 8): point2(1) = .Cells(i, 9): point2(2) = 0#
            location(0) = .Cells(i, 10): location(1) = .Cells(i, 11): location(2) = 0#
            Set dimObj = acadMod.AddDimAligned(point1, point2, location)
            dimObj.textheight = 200
            i = i + 1
        Loop Until .Cells(i, 6) = ""

        i = 1
        Do
            insertionpoint(0) = .Cells(i, 13): insertionpoint(1) = .Cells(i, 14): insertionpoint(2) = 0
            height = .Cells(i, 15)
            textString = .Cells(i, 17)
            Set acadText = acadMod.AddText(textString, insertionpoint, height)
            acadText.Rotation = (.Cells(i, 16) * 3.14) / 180
            i = i + 1
        Loop Until .Cells(i, 13) = ""
    End With

    acadApp.Visible = True
    acadApp.ZoomExtents

    Set acadApp = Nothing
    Set acadDoc = Nothing
    Set acadMod = Nothing
    Set acadText = Nothing

End Sub

 

[Jacobusje]

Beste Alphamax,

Na een uurtje stoeien ben ik er uit :thumb:.

Dat hij niet op het juiste nul-punt zat komt door mijn bestand van AutoCAD, daar zat denk wat vervuiling in.
In een leeg bestand pakt hij het nul-punt wel juist.

Hetgeen in het het Excel voorbeeld staat doet hij bij mij ook (en veel sneller dan met "mijn" code), maar de lijnen staan (stonden) niet op de juiste posities.

In de regel "endPoint(0) = .Cells(i, 3): endPoint(1) = .Cells(i, 41): endPoint(2) = 0#" stond een 1 te veel.
Na die weggehaald te hebben komt hetgeen er uit zoals in de bijlage.

Waar ik ook blij mee ben; dat de lijnen veel sneller worden geplaatst en dat de code niet aangepast hoeft te worden bij een nieuwe AutoCAD-versie.

Enorm bedankt!!