---

hi leute
hab jetzt ein wenig in der suche funktion herumgestöbert...
und leider nur einen etwas unbefriedigenden erfolg zu verzeichnen..
gibt es wirklich keine möglichkeit einen bereich der zeichnung (versch.linien etc) zu verzerren (in x oder y-richtung) ausser daraus einen block zu machen und den dann mit versch. faktoren einzusetzen ???
gibts da sonst noch eine vernünftige variante?

------------------
ciao
dominik
---------------------

---------------------

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

---

Nö, gibt es nicht. - Wenn Strecken nicht geht in deinem Fall, muß
ein Block herhalten...

PS.: bei mir laufen trotz der vielen Beiträge hier die ET immernoch nicht. - 2004Testversion... Toll das es wenigstens jetzt bei euch allen klappt...

------------------
Gruß Sebastian , Ffm
Der Feind des Guten ist das Bessere.

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

---

@cadffm

*** PS.: bei mir laufen trotz der vielen Beiträge hier die ET
*** immernoch nicht. - 2004Testversion... Toll das es wenigstens
*** jetzt bei euch allen klappt...

Was war da jetzt bei Dir? War paar Tage unterwegs bin noch nicht so auf den aktuellen Stand.

Gruss Angelika

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

---

Hallo Angelika,

ich hatte zu dem Thema auch nichts gepostet- es waren schließlich alle Probleme (der anderen) behoben worden.

siehe hier:

*****************************************************************
HELP wanted...

WICHTIG: WinXP, AC2004-TESTVERSION, (ACLT2000 ist auch noch drauf)
        versch. ETools (1x als Install-Paket, 1x entpackt)

Schön das bei euch nach und nach alles klappt ! - ich bekomme die
Etools noch immer nicht ans laufen....
Dabei geht es um die bekannten "Probleme" mit Autoload und ACET-STR-FORMAT.

2.Frage -  Hat jmd. die ET unter ACAD2004-TESTVERSION am laufen oder zumindest
  ganz sicher mal zum laufen gebracht ?

Sind die ETools eigentlich bei der Test-CD dabei ? -

Expressdateien sind nur "kopiert" da ein "richtiges" Install der E-Tools funkt nicht...
"Kein ACAD installiert, bitte installieren Sie ACAD und führen das Setup erneut durch..."
-na super.

weitere InfoŽs:  Habe die Test-CD nicht vorliegen...
                acad2004doc.lsp wird geladen...

------------------------Nochetwas anderes:-------------------------------------

Befehl: appload

acetutil.arx ist nicht kompatibel mit dieser Version von AutoCAD.
AcRxDynamicLinker konnte 'D:\Programme\AutoCAD 2004\EXPRESS\acetutil.arx' nicht
laden

Was soll das denn ? - (habe glaube mit den ET für AC2000 getestet)
--------------------------------------------------------------------------------

Da Ihr ja für "Autoload" und "ACET-STR-FORMAT" bereits Lösungswege habt,
(die leider bei mir nun nicht funken) gehe ich davon aus das ich wohl noch
auf die Registrierung warten muß... (es sei denn Ihr habt es auch schon mit
der TESTVERSION zu laufen gebracht,dann besteht ja noch Hoffnung...

-Da fällt mir nochwas ein: Die acad.mnu liegt nicht im ACAD-Verzeichnis, sondern unter "Dokumente u. Einstellungen/User/Acad etc.
    ist das jetzt normal bei der ACAD-Install oder kommt das von dem
    Sch. XP ?

IST HALT ALLES MIST WENN MAN DEN KRAM NICHT SELBST MACHT !
(die Installation etc...)

------------------
Gruß Sebastian , Ffm
Der Feind des Guten ist das Bessere.

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

---

Hallo Sebastian,

die Express-tools sind auf der CD (Vollversion) dabei. Die Alten ETV1-9 sind meines wissens nicht lauffähig unter 2004.

------------------
Grüße T. Bürger   

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

---

Hi Sebastian,
naja nicht selbst installiert und keine CD da da werds schwierig...
Könnte ja auch sein es sind gar nicht die Tools von der 2004 CD? Bei mir im Express Verzeichnis sind die meisten Dateien vom 14.02.2003 und paar "alte" - vielleicht hilft das beim Orten?

Bei Einzelplatzinstallation funktioniert immer noch ganz gut, dem Nutzer lokal Adminrechte geben, installieren (E-Tools müssen zusätzlich installiert werden sind aber für 2004 wieder auf der CD - und ich hoffe das ist auch bei der Testversion so), Rechte zurücksetzen...

Ja, es wird allerhand in die "Benutzerverzeichnisse" verlegt - WIN XP like... damit die Admins bissel Freude haben 

Gruss Angelika

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

---

so hat das noch keiner gesagt...
Schön das es auf der CD ist, leider hat es ein Komiker nicht installiert (EDV-Futzi).
Aber so kann ich meine Versuche endlich einstellen - wenn
es so ist wie du sagst (war der Meinung hier was anderes gelesen
zu habe (bloß wo?) - deswegen immer wieder getestet...)

CU und danke

------------------
Gruß Sebastian , Ffm
Der Feind des Guten ist das Bessere.

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

---

Hallihallo Sebastian,
ETV1-9 sind mit den ET2004 nicht 100%ig identisch. Ist mir gestern aufgefallen(zB: Eigenschaften mit Doppelklick ist wech).-> Immer die ET von der CD nehmen...
Lothar

------------------
"Stellt Euch vor, es geht, und keiner kriegt's hin." (Neuss)

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

---

nu aber mal langsam mit den jungen pferden :-) vonwegen EDV-Fuzzi und so.

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

---

EDV-FuzziŽs würdŽich glatt neŽn halben Kohl zum Nachtisch
geben...und da Pferde nicht kotzen können...
-----
Aber mal ehrlich:
Ich bin Tierlieb und mache sowas nicht, solange sie von den Rechnern
mit denen ich zu tuen habe die Finger lassen !
-Unter Aufsicht ist das natürlich was anderes...

Das sich hier im Forum AdminŽs etc. tummeln die sich nebenbei auch noch super mit CAD-ProgŽs auskennen (und wie man damit arbeitet) ist
wohl eine natürliche Sache... und eher die Ausnahme.

Fuzzis haben im Allgemeinen mit Ihrem Betriebssystem und deren "Office"
Produkten sowie dem Netzwerk (genug) zu tun...ist doch schön wenn ich
den Rest (der mich direkt betrifft) übernehmen möchte, oder ? 

------------------
Gruß Sebastian , Ffm
Der Feind des Guten ist das Bessere.

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

---

klingt zwar fast so als ob ich im falschen thread bin, aber hat jetzt wer noch ne idee wegen des varia befehls??

danke

------------------
ciao
dominik
---------------------

---------------------

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

---

VARIA war schon immer gleichmäßige Vergrößerung/Verkleinerung in x,y,z Richtung...

Höchstens mal die Lispler befragen?
http://www.cadwiesel.de http://www.cadlon.de

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

---

werd mal die beiden nerven gehen ....
muss nämlich echt viele objekte überhöht zeichnen und dass wird sonst ziehmlich viel arbeit vorallem kann ich beim block einfügen auch nur nen faktor eingeben ....
und ich muss mir sommit immer den faktor ausrechnen den ich brauche ....
dabei wäre es toll es wie bei align skalieren zu können aber eben nur in die richtung die ich acad vorgebe und dass er die andere ignoriert..
tja mal schauen ob die 2 was wissen....

------------------
ciao
dominik
---------------------

---------------------

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

---

Hi Dominik,
beim "rechnen" kann ich dir evtl helfen...
zumindest bei "krummen" Werten :

Varia (den Block) mit Bezug un dann die jew. X oder Y Skalierung
in den Eigenschaften zurück auf 1 stellen - dabei muß man
allerdings auf den Einfügepunkt beim erstellen achten oder den
Block nachträglich verschieben - test it , bei total dämlichen
längen hat man so aber wenigstens ein 100%iges Ergebnis.

-vielleicht war der Thread jetzt doch nicht so erfolglos...

------------------
Gruß Sebastian , Ffm
Der Feind des Guten ist das Bessere.

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

---

wollt mich nur noch mal schnell bedanken ...
hat so geklappt und auch dass mit dem block is nicht ganz verkehrt,
danke euch auf jeden fall, unities sind unterwegs

------------------
ciao
dominik
---------------------

---------------------

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

---

Ich hab mir mal in VBA ein Überhöhungstool geschrieben, funktioniert aber nur im WKS. Es werden alle Objekte überhöht, Texte werden verschoben und gedreht, bei Blöcken wird gefragt ob sie nur verschoben oder auch scaliert werden sollen. Skaliert wird nur in y-Richtung.
Ich hab es damals aber nur schnell programmiert und danach nicht weiter verfolgt, ist daher noch nicht ganz so wie ich es mir damals vorgestellt habe, wenn du es aber trotzdem möchtest stell ich es dir hier rein.

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

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

---

wenn du nichts dagegen hast würde ich es mir mal gerne anschauen ...
danke auf jeden fall

------------------
ciao
dominik
---------------------

---------------------

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

---

Hier ist es:

Code:

---

Public Sub Ueberhoehung()
   
    Dim SS As AcadSelectionSet
    Dim SSN As AcadSelectionSet
    Dim BlElem As Variant
    Dim BlObj As AcadBlock
    Dim BlRef As AcadBlockReference
    Dim BP As Variant
    Dim Obj As AcadEntity
    Dim ObjAR(0) As AcadEntity
    Dim BlSchieb As AcadBlockReference
    Dim TxtSchieb As AcadText
    Dim EPAlt As Variant
    Dim EPNeu(2) As Double
   
    Dim BlNummer As Long
    Dim BlCount As Long
    Dim BlCol As Collection
    Dim BlColObj As AcadBlockReference
    Dim SSB As AcadSelectionSet
    Dim SSBObj As AcadBlockReference
   
    Dim ScaleFak As Double
   
    On Error Resume Next
    BP = ThisDrawing.Utility.GetPoint(, vbCr & "Basispunkt angeben: ")
    If Err Then Exit Sub
   
    Set SSN = CreateSelectionSet("ScaleObjectsAuswahl")
    SSN.SelectOnScreen
   
    If SSN.Count = 0 Then GoTo ENDE2
   
    ScaleFak = ThisDrawing.Utility.GetReal(vbCr & "Überhöhung: ")
   
    Set BlCol = New Collection
    BlCount = 0
    Set SS = CreateSelectionSet("ScaleBlockObj")
    For Each Obj In SSN
        Set ObjAR(0) = Obj
        Select Case Obj.ObjectName
            Case "AcDbBlockReference"
                BlCol.Add Obj, Obj.Handle
                BlCount = BlCount + 1
           
            Case "AcDbText", "AcDbMText", "AcDbAttribute"
                Select Case Obj.ObjectName
                    Case "AcDbText", "AcDbAttribute"
                        Select Case Obj.Alignment
                            Case 0, 3, 5 '"acAlignmentLeft", "acAlignmentAligned", "acAlignmentFit"
                                EPAlt = Obj.insertionPoint
                            Case Else
                                EPAlt = Obj.TextAlignmentPoint
                        End Select
                    Case "AcDbMText"
                        EPAlt = Obj.insertionPoint
                End Select
                EPNeu(0) = EPAlt(0): EPNeu(1) = BP(1) + (EPAlt(1) - BP(1)) * ScaleFak: EPNeu(2) = EPAlt(2)
                Obj.Move EPAlt, EPNeu
               
                Select Case Obj.Rotation
                    Case Is < funPI / 2
                        Obj.Rotation = Atn(Tan(Obj.Rotation) * ScaleFak)
                    Case funPI / 2
                    Case funPI * 1.5
                    Case Is < funPI * 1.5
                        Obj.Rotation = Atn(Tan(Obj.Rotation) * ScaleFak) + funPI
                    Case Else
                        Obj.Rotation = Atn(Tan(Obj.Rotation) * ScaleFak)
                End Select
               
            Case Else
                SS.AddItems ObjAR
        End Select
   
    Next Obj
   
    If BlCount = 0 Then GoTo BlockEinsetzten
    Call AlleUnsichtbarInActSpace
   
    For Each BlColObj In BlCol
        BlColObj.Visible = True
    Next BlColObj
   
    ThisDrawing.Utility.Prompt "Blöcke die nicht überhöht werden sollen --> "
    Set SSB = CreateSelectionSet("ScaleBlocksAuswahl")
    SSB.SelectOnScreen
   
    Call AlleSichtbarInActSpace
   
    Select Case SSB.Count
        Case 0
            For Each BlColObj In BlCol
                Set ObjAR(0) = BlColObj
                SS.AddItems ObjAR
            Next BlColObj
        Case Else
            For Each BlColObj In SSB
                Set BlSchieb = BlColObj
                EPNeu(0) = BlSchieb.insertionPoint(0): EPNeu(1) = BP(1) + (BlSchieb.insertionPoint(1) - BP(1)) * ScaleFak: EPNeu(2) = BlSchieb.insertionPoint(2)
                BlSchieb.Move BlSchieb.insertionPoint, EPNeu
                Select Case BlSchieb.Rotation
                    Case Is < funPI / 2
                        BlSchieb.Rotation = Atn(Tan(BlSchieb.Rotation) * ScaleFak)
                    Case funPI / 2
                    Case funPI * 1.5
                    Case Is < funPI * 1.5
                        BlSchieb.Rotation = Atn(Tan(BlSchieb.Rotation) * ScaleFak) + funPI
                    Case Else
                        BlSchieb.Rotation = Atn(Tan(BlSchieb.Rotation) * ScaleFak)
                End Select
                BlCol.Remove BlSchieb.Handle
            Next BlColObj
           
            If BlCol.Count > 0 Then
                For Each BlColObj In BlCol
                    Set ObjAR(0) = BlColObj
                    SS.AddItems ObjAR
                Next BlColObj
            End If
                   
    End Select
   
BlockEinsetzten:
    BlNummer = 0
BlockGibtEsSchon:
    BlNummer = BlNummer + 1
    On Error Resume Next
    Set BlObj = ThisDrawing.Blocks.Item("_Ueberhoehung" & BlNummer)
    If Err Then
        Set BlObj = ThisDrawing.Blocks.Add(BP, "_Ueberhoehung" & BlNummer)
    Else
        GoTo BlockGibtEsSchon
    End If
    On Error Resume Next
    ThisDrawing.CopyObjects ssArray(SS), BlObj
    If Err Then
        GoTo ENDE
    End If
   
    Select Case ThisDrawing.ActiveSpace
        Case 0
            Select Case ThisDrawing.MSpace
                Case True
                    Set BlRef = ThisDrawing.ModelSpace.InsertBlock(BP, BlObj.Name, 1, ScaleFak, 1, 0)
                Case False
                    Set BlRef = ThisDrawing.PaperSpace.InsertBlock(BP, BlObj.Name, 1, ScaleFak, 1, 0)
            End Select
        Case 1
            Set BlRef = ThisDrawing.ModelSpace.InsertBlock(BP, BlObj.Name, 1, ScaleFak, 1, 0)
    End Select
   
    If BlCount = 0 Or BlCount = SSB.Count Then
        BlRef.Explode
        BlRef.Delete
        ThisDrawing.Blocks.Item(BlObj.Name).Delete
    Else
        MsgBox "Block """ & BlObj.Name & """ wurde erstellt!" & vbCrLf & vbCrLf & _
              "Den Block explodieren und Zeichnung bereinigen."
    End If
   
ENDE:
    SSB.Delete
    SS.Erase
ENDE2:
    SSN.Delete
    If BlCount = 0 Then Call AlleSichtbarInActSpace
   
End Sub

Public Function CreateSelectionSet(Optional ssName As String = "SS") As AcadSelectionSet

    Dim objSelSet As AcadSelectionSet
    Dim objSelCol As AcadSelectionSets
   
    Set objSelCol = ThisDrawing.SelectionSets
    For Each objSelSet In objSelCol
      If objSelSet.Name = ssName Then
        objSelCol.Item(ssName).Delete
        Exit For
      End If
    Next
    Set objSelSet = objSelCol.Add(ssName)
    Set CreateSelectionSet = objSelSet

End Function

Public Function ssArray(SS As AcadSelectionSet)

    Dim retVal() As AcadEntity, i As Long
   
    ReDim retVal(0 To SS.Count - 1)
   
    For i = 0 To SS.Count - 1
        Set retVal(i) = SS.Item(i)
    Next
   
    ssArray = retVal

End Function

' schaltet alle Objekte in aktivem Bereich auf unsichtbar
Public Sub AlleUnsichtbarInActSpace()
   
    Dim Obj As Object
   
    Select Case ThisDrawing.ActiveSpace
        Case 0
            Select Case ThisDrawing.MSpace
                Case True
                    For Each Obj In ThisDrawing.ModelSpace
                        On Error Resume Next
                        Obj.Visible = False
                    Next Obj
                Case False
                    For Each Obj In ThisDrawing.PaperSpace
                        On Error Resume Next
                        Obj.Visible = False
                    Next Obj
            End Select
        Case 1
            For Each Obj In ThisDrawing.ModelSpace
                On Error Resume Next
                Obj.Visible = False
            Next Obj
    End Select

End Sub

' schaltet alle Objekte in aktivem Bereich auf sichtbar
Public Sub AlleSichtbarInActSpace()
   
    Dim Obj As Object
   
    Select Case ThisDrawing.ActiveSpace
        Case 0
            Select Case ThisDrawing.MSpace
                Case True
                    For Each Obj In ThisDrawing.ModelSpace
                        On Error Resume Next
                        Obj.Visible = True
                    Next Obj
                Case False
                    For Each Obj In ThisDrawing.PaperSpace
                        On Error Resume Next
                        Obj.Visible = True
                    Next Obj
            End Select
        Case 1
            For Each Obj In ThisDrawing.ModelSpace
                On Error Resume Next
                Obj.Visible = True
            Next Obj
    End Select

End Sub

---

Ich hoffe, ich habe nichts vergessen.

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

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