---

Hallo!

Ich habe in Excel eine Tabelle ( ca. 200 Werte) mit Rechts- und Hochwerten sowie einer Zahl die für eine Bestimmte Farbe steht und einer Beschriftung, die ich gerne in Autocad zeichnen würde (einfach einen Punkt).
Ist das ohne grosse Probleme machbar oder lieber das ganze per Hand zeichnen? Hab bislang nicht soviel VBA Erfahrung aber da ich noch einige solcher Zeichnungen machen muss hab ich die Hoffnung das es dadurch deutlich schneller geht :-)

Danke schonmal

hengesa

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

---

Moin & Hallo hengesa,

hier ein möglicher Ansatz mit VBA: http://ww3.cad.de/foren/ubb/Forum110/HTML/000317.shtml

Gruss Nancy

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

---

Moin!
Super, das hatte ich bei meiner suche bislang nicht gefunden, werde ich mal gleich mit herum experimentieren!

gruss
hengesa

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

---

Das ganze klappt eigentlich recht nett, nur ich bekomme es irgendwie nicht hin den Punkt in der Größe zu Àndern und ihm eine andere Farbe zuzuweisen. Kleiner Tip?

Hier mein derzeitiger code:

Option Explicit

Sub test()
  Dim ac As AcadApplication
  Dim i&, acText#(2)
  Dim acPoint#(2)
  Dim versatzX, versatzY, textgroesse, punktgroesse
  Set ac = New AcadApplication
  ac.Visible = 1
  versatzX = Sheets(1).Cells(3, 10)
  versatzY = Sheets(1).Cells(4, 10)
  textgroesse = Sheets(1).Cells(5, 10)
 
  With ac.ActiveDocument.ModelSpace
      For i = 1 To Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
     
        acText(0) = Sheets(1).Cells(i, 2)
        acText(1) = Sheets(1).Cells(i, 3)
        acText(2) = Sheets(1).Cells(i, 4)
        acText(0) = acText(0) + versatzX
        acText(1) = acText(1) + versatzY
        acPoint(0) = Sheets(1).Cells(i, 2)
        acPoint(1) = Sheets(1).Cells(i, 3)
        acPoint(2) = Sheets(1).Cells(i, 4)
       
        .AddPoint (acPoint)
        .AddText Sheets(1).Cells(i, 1).Value, acText, textgroesse
       
      Next
  End With
  ac.ZoomExtents
End Sub

Danke schon mal
gruß

[Diese Nachricht wurde von hengesa am 03. Feb. 2005 editiert.]

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

---

Geh' am besten über eine Objektvariable also irgendsowas:

Code:

---

Dim mypoint as acadpoint
...
set mypoint = .AddPoint (acPoint)
mypoint.layer="string"
mypoint.color=5
usw

---

Gruss Nancy

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

---

Hallo!
Hab dank Eurer Hilfe und Tips mein Programm im Prinzip fertig. Das einzige was jetzt noch nicht so will ist die Farbe der Kreisfüllung. Die soll bei jedem Kreis unterschiedlich sein und aus Spalte 4 meiner Exceltabelle kommen. Definiert wird die erstmal durch Zahlen von 1 bis 7 mit den Standardfarben. Das Problem jetzt ist, das alle Kreise die gleiche Farbfüllung haben obwohl in der Spalte andere zahlen stehen und zwar immer die Farbe vom letzten Kreis... soweit ich das sehe steht die Farbabfrage eigentlich in der gleichen Schleife mit drin, müsste also neu gesetzt werden.

Weiss da jemand was zu ?

Besten Dank schonmal
gruß
hengesa

Sub test()
 
  Dim ac As AcadApplication
  Dim i&, acText#(2)
  Dim acPoint#(2)
  Dim kreis(0 To 0) As AcadEntity
     
  Dim center(0 To 2) As Double, radius As Double
  Dim versatzX, versatzY, textgroesse, punktgroesse
 
  Dim hatchObj As AcadHatch
  Dim patternName As String
  Dim PatternType As Long
  Dim bAssociativity As Boolean
 
  Set ac = New AcadApplication
  ac.Visible = 1
 
  ' Define the hatch
    patternName = "solid"
    PatternType = 0
    bAssociativity = True
 
  ' Create the associative Hatch object in model space
  With ac.ActiveDocument
      Set hatchObj = .ModelSpace.AddHatch(PatternType, patternName, bAssociativity)
     
      versatzX = Sheets(1).Cells(3, 10)
      versatzY = Sheets(1).Cells(4, 10)
      textgroesse = Sheets(1).Cells(5, 10)
   
          For i = 1 To Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
           
            acText(0) = Sheets(1).Cells(i, 2)
            acText(1) = Sheets(1).Cells(i, 3)
     
            acText(0) = acText(0) + versatzX
            acText(1) = acText(1) + versatzY
       
            center(0) = Sheets(1).Cells(i, 2)
            center(1) = Sheets(1).Cells(i, 3)
     
            radius = Sheets(1).Cells(7, 10)
       
            Set kreis(0) = .ModelSpace.AddCircle(center, radius)
            kreis(0).color = acRed
            .ModelSpace.AddText Sheets(1).Cells(i, 1).Value, acText, textgroesse
       
            ' Append the outerboundary to the hatch object, and display the hatch
            hatchObj.AppendOuterLoop (kreis)
            hatchObj.color = Sheets(1).Cells(i, 4)
            hatchObj.Evaluate
               
            .Regen True
        Next
      End With
       
  ac.ZoomExtents
End Sub

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

---

 

Zitat:

---

End Sub

---

[Diese Nachricht wurde von hengesa am 07. Feb. 2005 editiert.]

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

---

End Sub? ;-)

Mal auf Verdacht, die Zeile:

Code:

---

Set hatchObj = .ModelSpace.AddHatch(PatternType, patternName, bAssociativity)

---

steht ja auch ausserhalb der Schleife, tu' die mal mit rein ...

Gruss Nancy
               

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

---

Uih, bin ich ....

Das wars super und tausend Dank!!!

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