Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  Rund um AutoCAD
  Multi-Führungslinie mit Daten aus einer Exceltabelle

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
  
Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte
Autor Thema:  Multi-Führungslinie mit Daten aus einer Exceltabelle (1956 mal gelesen)
AndreasR 1970
Mitglied
Technischer Angestellter leitend

Sehen Sie sich das Profil von AndreasR 1970 an!   Senden Sie eine Private Message an AndreasR 1970  Schreiben Sie einen Gästebucheintrag für AndreasR 1970

Beiträge: 1
Registriert: 27.05.2013

Windows XP, AutoCAD 2013

erstellt am: 27. Mai. 2013 10:51    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo zusammen,
ich ein kleines Problem und hoffe auf eine Lösung von Euch.
Ich habe eine Tabelle, in eine Zeichnung eingefügt. Die Daten wurden über eine Datenverknüpfung eingelesen, da wir in der Zeichnung, als auch im Flußdiagramm, mit der gleichen Tabelle arbeiten möchten.
Nun möchte ich die Bauteile im Flußdiagram mit Multi-Führungslinie beschriften.
Kann ich die Daten der Tabelle automatisch nutzen oder muss ich das alles per Hand eintragen.

Gruß Anderas

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Wilfried Nelkel
Mitglied
glaubt mir eh keiner


Sehen Sie sich das Profil von Wilfried Nelkel an!   Senden Sie eine Private Message an Wilfried Nelkel  Schreiben Sie einen Gästebucheintrag für Wilfried Nelkel

Beiträge: 804
Registriert: 15.03.2001

AutoCAD/ADT/ACA 2002 - 2023, Hardware: HP Z620 Workstation, 2 x Xeon E5-2690 v2@3.00GHz, 96 GB RAM, NVIDIA Quadro RTX 4000, Windows 10-64bit .....
ATC-Trainer

erstellt am: 28. Mai. 2013 13:44    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für AndreasR 1970 10 Unities + Antwort hilfreich

Hallo und willkommen im Forum,

ich würde mal sagen, mit reinen Boardmitteln geht das nicht. Vielleicht hat einer der vielen Programmier*****s etwas, was er aus dem Ärmel schütteln könnte...

------------------
Schöne Grüsse


Wilfried Nelkel
http://www.cad-nelkel.de
http://www.schulungshandbuch.de

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

rexxitall
Mitglied
Dipl. -Ing. Bau


Sehen Sie sich das Profil von rexxitall an!   Senden Sie eine Private Message an rexxitall  Schreiben Sie einen Gästebucheintrag für rexxitall

Beiträge: 266
Registriert: 07.06.2013

erstellt am: 09. Jun. 2013 21:07    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für AndreasR 1970 10 Unities + Antwort hilfreich

HI,

wenn deine Tabelle die passenden EINFUEGE Koordinaten bereitstellt ist es machbar.
Allerdings wuerde ich da nicht die Multileader benutzen sondern dynamische Blöcke mit Attributen (letztere kann man auch wieder auslesen und sie lassen sich auch spiegeln)


Wenn dem nicht so ist ...
Dann hast du das Problem das niemand weis WO die Beschriftungen anzuflanschen sind - da musst selber klicken.

Die entsprechende VBA Programmierung ist auch aufwaendiger.
Ich wuerd einen Dialog mit einer Listbox bauen sowie einem vor, einem zuruck und einem Einfuegeknopf.
Dann koennt man die Liste mit etwas verwertbarem aus der excel tabelle fuellen
und sie mit den knoepfen der reihe nach durchwandern und mit dem einfuegeknopf den block nach auswahl des punktes dort einfuegen
wo er hingehoert. Und etwas logick übertraegt dann die Blockattribute mit den Tabellenwerten
Dynamische Blöcke um die Attribute etc verschieben zu koennen.
Ist einmalig ungefahr ein Tag Geschaeft fürs vorbereiten (wenn man es AZUBI sicher haben will)
und dann sehr einfach.

Die nachfolgend routinen funktionieren ergeben aber nicht deine fertige Anwendung *lach*
Immerhin adressieren sie die Hauptfunktionen die du benoetigst und diese routinen sind getested.
Sollt schon mal ein paar Tage mit alka selzer ersparen 


Ich hatte mal das problem Aufmasspunkte welche aus 2 koordinatren bestanden dreidimensional darzustellen
und habe zur orientierung dazu Blöcke ebenfalls eingefuegt.
Ferner hab ich noch 3 routinen die Blockattribute setzen und loeschen dazugelegt.
Plus Pubktpickroutine ist ja nicht wie bei armen leuten hier 

IM VBA die referenz oder den Verweis suf die excel.exe nicht vergessen (googlen da hats haufenweise tutorials dazu)


Public Sub Polin_aus_EXCEL()
    Dim blo As AcadBlockReference
    Dim PoLin, sPoLin As Acad3DPolyline    'AutoCAD Polylinie
    Dim Punkt(0 To 5) As Double    'Koordinaten des ersten Segments
    Dim NeuPunkt(0 To 2) As Double
    Dim MidPoint(0 To 2) As Double  'Koordintenfolgepunkte
    Dim EPunkt(0 To 2) As Double    'Koordintenfolgepunkte
    Dim wb As Excel.Workbook
    Dim WTAB As Excel.Worksheet
    Set wb = Excel.Workbooks.Open("C:\diana.xls")
    Set WTAB = wb.Worksheets("Sheet1")

    I = 7
    Sc = 1000

    Do While I < 100

        offset = 8
        mytest = WTAB.Cells(I, offset + 1)
        If IsNumeric(mytest) Then

            If mytest <> 0 Then

                Punkt(0) = mVal(WTAB.Cells(I, offset + 1).Value) * Sc
                Punkt(1) = mVal(WTAB.Cells(I, offset + 2).Value) * Sc
                Punkt(2) = mVal(WTAB.Cells(I, offset + 3).Value) * Sc

                'Debug.Print i, Punkt(0), Punkt(1), Punkt(2)
                offset = 23
                Punkt(3) = mVal(WTAB.Cells(I, offset + 1).Value) * Sc
                Punkt(4) = mVal(WTAB.Cells(I, offset + 2).Value) * Sc
                Punkt(5) = mVal(WTAB.Cells(I, offset + 3).Value) * Sc

                Set sPoLin = ThisDrawing.modelspace.Add3DPoly(Punkt)    'Polylinie erzeugen

                MidPoint(0) = 0.5 * (Punkt(0) + Punkt(3))
                MidPoint(1) = 0.5 * (Punkt(1) + Punkt(4))
                MidPoint(2) = 0.5 * (Punkt(2) + Punkt(5))
                sPoLin.ScaleEntity MidPoint, 2#

                'set POINTmarks
                NeuPunkt(0) = Punkt(0)
                NeuPunkt(1) = Punkt(1)
                NeuPunkt(2) = Punkt(2)

                Set blo = ThisDrawing.modelspace.InsertBlock(NeuPunkt, "3D-KOORDINATE", 1, 1, 1, 0)
                NeuPunkt(0) = Punkt(3)
                NeuPunkt(1) = Punkt(4)
                NeuPunkt(2) = Punkt(5)

                Set blo = ThisDrawing.modelspace.InsertBlock(NeuPunkt, "3D-KOORDINATE", 1, 1, 1, 0)
                Debug.Print I, NeuPunkt(0), NeuPunkt(1), NeuPunkt(2)
            End If
        End If
        I = I + 1
    Loop
    wb.Close
End Sub

Sub block_set_attribute(blo As AcadBlockReference, tagname, tagvalue)
    Dim attlist As Variant
    If blo Is Nothing Then Exit Sub
    If blo.HasAttributes Then
        tagname = Trim(UCase(tagname))
        attlist = blo.GetAttributes
        For I = LBound(attlist) To UBound(attlist)
            ''debug.print "#" & UCase(attlist(i).TagString) & "#", tagname
            If UCase(attlist(I).TagString) = tagname Or UCase(Trim(attlist(I).TagString)) = tagname & "_001" Then
                'On Error Resume Next
                attlist(I).textstring = "" & tagvalue

                ' attlist(I).Update
                ' On Error GoTo 0
                Exit Sub
            End If
        Next

    End If
End Sub

Function block_has_attribute(blo As AcadBlockReference, tagname As String) As Boolean
    Dim attlist As Variant
    On Error Resume Next
    block_has_attribute = False
    If blo.HasAttributes Then
        attlist = blo.GetAttributes
        For I = LBound(attlist) To UBound(attlist)
            If UCase(attlist(I).TagString) = tagname Or UCase(Trim(attlist(I).TagString)) = tagname & "_001" Then
                block_has_attribute = True
                Exit Function
            End If
        Next
    End If
End Function
Function block_get_attribute(blo As AcadBlockReference, tagname) As String
    Dim attlist As Variant
    On Error Resume Next
    'If blo Is Nothing Then Exit Function
    If blo.HasAttributes Then
        attlist = blo.GetAttributes
        For I = LBound(attlist) To UBound(attlist)
            If UCase(attlist(I).TagString) = tagname Or UCase(Trim(attlist(I).TagString)) = tagname & "_001" Then
                block_get_attribute = attlist(I).textstring
                Exit Function

            End If
        Next
    End If
End Function


Function get_POINT(MSG As String, P() As Double) As Boolean
    get_POINT = False
    Dim returnPnt As Variant
    Dim v(2) As Double
    ' Return a POINT using a prompt
    On Error GoTo ende
    Err.Clear
    returnPnt = ThisDrawing.UTILITY.getPoint(, "Enter a POINT: ")
    On Error GoTo 0
    If Err.number <> 0 Then Exit Function
    get_POINT = True
    'debug.print TypeName(returnPnt)
    If TypeName(returnPnt) <> "Empty" Then
        SLOPEFORM.CX = str(returnPnt(0))
        SLOPEFORM.CY = str(returnPnt(1))
        SLOPEFORM.CZ = str(returnPnt(2))
        P(0) = returnPnt(0)
        P(1) = returnPnt(1)
        P(2) = returnPnt(2)
    End If

    Exit Function
ende:
    P(0) = NAN
End Function

------------------
wer es nicht versucht, hat schon verlorn

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

rexxitall
Mitglied
Dipl. -Ing. Bau


Sehen Sie sich das Profil von rexxitall an!   Senden Sie eine Private Message an rexxitall  Schreiben Sie einen Gästebucheintrag für rexxitall

Beiträge: 266
Registriert: 07.06.2013

Various: systems, Operating systems, cad systems, cad versions, programming languages.

erstellt am: 09. Jun. 2013 21:09    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für AndreasR 1970 10 Unities + Antwort hilfreich

die SLOPEFORM. Zeien auskommentieren die hab ich vergessen zu loeschen

------------------
wer es nicht versucht, hat schon verlorn

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2023 CAD.de | Impressum | Datenschutz