---

Hallo Zusammen,

dies ist meine erster Beitrag

habe ein riesiges Problem...
ich soll möglichst kurzfristig ca.160 Pixelbilder in AutoCAD einfügen,schneiden,spiegeln oder drehen, in x- und y-Richtung scalieren und auf Endposition drehen.
Von Hand gehe ich folgende Schritte durch:
1. Pixelbild einfügen (ohne Pfadstruktur!)
2. Pixelbild schneiden
3. Block erstellen des Pixelbildes
4. Block einfügen mit Faktoren in x- und y- Richtung
5. Block auflösen
6. Pixelbild auf gewünschte stelle verschieben und drehen

.... das funkttioniert auch ... aber dauert sehr sehr sehr lange!

Jetzt habe ich in VBA ein Programm geschrieben das bis auf zwei Sachen Perfekt funktioniert(ich bin Anfänger).

Siehe Punkt 7. Der Block mit dem Pixelbild lässt sich nicht auflösen.

Weiterhin ist der Pfad des Pixelbilds ist immer dabei, d.h. wenn ich die DWG.Datei weiter gebe fehlen die Pixelbilder.

Das Programm hat folgenden logischen Ablauf.
1. Einfügen Pixelbild (Nullpunkt)
2. in 1. oder 2. oder 3. oder 4. Quadrant legen
3. Schneidpunkte Pixel Orginal
4. gewollte Schnittpunkte Pixelbild neue größe angeben
5. Pixelbild löschen
6. Pixelbild als Block einfügen mit Faktoren

7. Pixelbild Block auflösen !!! GEHT NICHT

8. Pixelbild in 1. oder 2. oder 3. oder 4. Quadrant legen
9. Pixelbild schneiden mit neue Schneidpunkte
10. Pixelbild verschieben
11. Pixelbild drehen

Hier der Ausschnitt aus dem Code zu Punkt 7.....

Dim blockObj As AcadBlock '?Reference

Set blockObj = ThisDrawing.Blocks.Add(insertionPoint, Datei) 'Blockname erstellen

Set blockObj = blockObj.AddRaster(imageName, insertionPoint, 1, 0) 'Bild Block zuordnen

Dim blockRef As AcadBlockReference

blockRef = blockObj 'Umstellen auf Reference

Set blockRef = ThisDrawing.ModelSpace.InsertBlock(insertionPoint, Datei, Fak_x, Fak_y, 1#, 0) 'Block einfügen

blockRef.Explode

ICH BITTE UM HILFE

Vielen Dank

Grüße
ThomasBernd

Der gesamte Code liegt im Dateienanhang

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

---

stell mal die Sysvar EXPLMODE auf 1

------------------
  - Thomas -
"Bei 99% aller Probleme ist die umfassende Beschreibung des Problems bereits mehr als die Hälfte der Lösung desselben."

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

---

Vielen Dank für Info

ich weiß aber nicht wie ich EXPLMODE auf 1 stellen kann und der Pfad ist immer noch dabei.

???

Gruß
ThomasBernd

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

---

Hi,

 

Zitat:

---

ich weiß aber nicht wie ich EXPLMODE auf 1 stellen kann

---

ich störe ja nur ungern die heiligen VBA-Hallen, aber das solltest du schon können, bevor du dich an einer Programmierung versuchst. 
Tipp's doch einfach mal ein.

Im übrigen wäre es vielleicht nicht schlecht, wenn du deine Beiträge miteinander verlinken würdest, wenn du schon zweigleisig fahren willst: http://ww3.cad.de/foren/ubb/Forum145/HTML/002167.shtml

Gruß
CADchup

------------------
CADmaro.de

[Diese Nachricht wurde von CADchup am 09. Jul. 2007 editiert.]

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

---

Hi,
ich glaube wir bewegen uns vom eigentlichen Problem weg.
Explmode steht auf 1

z.B. kann ich (troz meinen geringen Kenntnisse) einen Block (z.B. Kreis) mit der selben Befehlsfolge auflösen... aber bei Pixelbilder nicht.

Soweit habe ich das Prog. fertig bis auf das o.g. Problem und dass dem Pixelbild immer der gesamte Pfad zugewisen ist.

Vielen Dank
für alle Infos

ThomasBernd

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

---

kann mir noch einer bei meinem kleinen Problemchen helfen.

Gruß
ThomasBernd

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

---

Hi,

Du kannst mit VBA keine ungleich skalierte Blöcke sprengen. Da musst du wohl auf Sendcommand ausweichen. Bei Zeichenelementen könnte man sich die transformation ja noch berechnen und neuzeichnen lassen, bei einem Bild geht das nun mal nicht.

Gruß, Carsten

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

---

Warum gehst du eigentlich den Umweg über den Block??? Betreffs Skalierung kannst du doch die Properties immagewidth und imageheigth auslesen, multiplizieren und neu setzen..?!

------------------
  - Thomas -
"Bei 99% aller Probleme ist die umfassende Beschreibung des Problems bereits mehr als die Hälfte der Lösung desselben."

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

---

Hallo Thomas,

versuchs doch mal so

Code:

---

Sub test()
    Dim objRaster As AcadRasterImage
    Dim InsPkt(0 To 2) As Double      ' 3D Punkt
    Dim ImageName As String
    Dim Umgrenzung(0 To 9) As Double  ' 2D Punkt Array (letzter=erster)
   
    ImageName = "C:\Temp\Bild009.jpg"
    Set objRaster = ThisDrawing.ModelSpace.AddRaster(ImageName, InsPkt, 50, 0)
    objRaster.Update
    Debug.Print objRaster.Width
    objRaster.ImageWidth = objRaster.ImageWidth * 1.1
    objRaster.ImageHeight = objRaster.ImageHeight * 1.5
    objRaster.ClippingEnabled = True
    objRaster.Update

    ZoomExtents

    ' UL
    Umgrenzung(0) = InsPkt(0)
    Umgrenzung(1) = InsPkt(1)
    ' OL
    Umgrenzung(2) = InsPkt(0)
    Umgrenzung(3) = InsPkt(1) + 50
    ' OR
    Umgrenzung(4) = InsPkt(0) + 50
    Umgrenzung(5) = InsPkt(1) + 50
    ' UR
    Umgrenzung(6) = InsPkt(0) + 50
    Umgrenzung(7) = InsPkt(1)
    ' UL
    Umgrenzung(8) = InsPkt(0)
    Umgrenzung(9) = InsPkt(1)
   
    objRaster.ClipBoundary Umgrenzung
    objRaster.Update
End Sub

---

Wilfried Stelberg

------------------
Warum lisp'eln wenn's auch anders geht.
www.ib-stelberg.de

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

---

Hallo Zusammen,

Vielen Vielen DANK für die Hilfe
Problem ist gelöst!

ich habe ImageHeight und ImageWidth einfach skaliert.
In AutoCAD selbst (über Eigenschaften) geht dies nur linear aber in VB kann ich x und y frei festlegen.
Perfekt !!!!!! und ganz einfach !!!!! (wenn mann's kennt)

    height_neu = height * Fak_y
    width_neu = width * Fak_x
   
    rasterObj.ImageHeight = height_neu
    rasterObj.ImageWidth = width_neu

Bezüglich Pfad
ACAD (Version 2006) sucht zuerst im Pfad das Bild...
wenn dort nicht vorhanden dann in diesem Pfad wo dwg.datei ist...
wenn dort auch nicht vorhanden dann wird nichts angezeigt.

Ihr habt mir (uns) viel viel Zeit erspart.

Danke

Thomas Bernd
       

PS
Diese Seite kann ich sehr empfehlen!!

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