Hot News:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  AutoCAD VBA
  Zellentexte übernehmen - ACAD2005

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:  Zellentexte übernehmen - ACAD2005 (541 mal gelesen)
RoSiNiNo
Mitglied
Konstrukteur


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

Beiträge: 1126
Registriert: 09.10.2002

Acad 2011-deutsch, Express Tools
3ds Max 2010
Win 7-Professional
HP Workstation Z400, 6GB
GeForce GTX 470

erstellt am: 29. Apr. 2004 10:31    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

Wenn es jemanden interessiert, anbei ein kleines Programm um Zellentexte zwischen Tabellen zu kopieren.

Code:
'Feletic: 29.04.2004
'Kopieren von Zellentexten in Tabellen
Public Sub CellTextMatch()
   
    Dim objTable As AcadTable
    Dim Pt As Variant
    Dim RI As Long
    Dim CI As Long
    Dim objTable2 As AcadTable
    Dim Pt2 As Variant
    Dim RI2 As Long
    Dim CI2 As Long
   
    On Error GoTo Err_Control
    Do
        GetEntityEx objTable, Pt, vbCrLf & "Zelle zeigen: "
        objTable.Select Pt, Point3D(0, 0, 1), Point3D(0, 0, 1), 1, 1, False, resultRowIndex:=RI, resultColumnIndex:=CI
        GetEntityEx objTable2, Pt2, vbCrLf & "Gezeigter Text: """ & objTable.GetText(RI, CI) & """" & vbCrLf & _
                                            "Zelle zeigen: "
        objTable2.Select Pt2, Point3D(0, 0, 1), Point3D(0, 0, 1), 1, 1, False, resultRowIndex:=RI2, resultColumnIndex:=CI2
        objTable2.SetText RI2, CI2, objTable.GetText(RI, CI)
    Loop
Exit_Here:
    Exit Sub
Err_Control:
    Err.Clear
    Resume Exit_Here
End Sub

'Continually prompts for an object selection until an object is acquired or the operation is cancelled
'Arguments: Identical to those required for GetEntity
Public Sub GetEntityEx(ent As Object, pickedPoint, Optional Prompt)

    On Error Resume Next
StartLoop:
    ActiveDocument.Utility.GetEntity ent, pickedPoint, Prompt
    If Err Then
        If ActiveDocument.GetVariable("errno") = 7 Then
            Err.Clear
            GoTo StartLoop
        Else
            Err.Raise vbObjectError + 5, , "User cancelled operation"
        End If
    End If

End Sub

'Converts the supplied doubles into a point
'Arguments: An X, Y and optional Z value
'Example: ThisDrawing.ModelSpace.AddCircle 0.25, Point3D(10, 10)
Public Function Point3D(x As Double, y As Double, Optional z As Double = 0) As Variant

    Dim retVal(0 To 2) As Double
   
    retVal(0) = x: retVal(1) = y: retVal(2) = z
   
    Point3D = retVal

End Function


------------------
Roland

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