---

vorweg: sorry for stupid topic, jetz werd ich mal genauer

Also: Erstmal - Hallo!

mal eine Frage, ich wollte mir so um die Weihnachtszeit, gerne mal
etwas x-mas Stimmung auf mein Acad zaubern, einfach nur so als weihnachtliches Feeling.
Ich dachte dabei an verschiedene Linien in allen möglichen Farben,
strahlenförmig, unterschiedlicher Länge, eben eine Art 'Stern'.
Nur bei den Farben haperts, mit meinem jetzigen Code stürzt mir das Programm laufend ab.
Hab' ja schon überlegt, noch was mit application wait() einzubauen, aber möglicherweise
macht das alles nur noch schlimmer. Es reicht ja so schon!
Vielleicht habt ihr ja hier nen Tip für mich, was ich irgendwo falsch mache.
Mein Dank ist euch sicher, genauso wie euer Lächeln auf den Lippen hierüber:

das hab' ich ja mit hängen und würgen noch hinbekommen:

Code:

---

Sub wuergen()
  Dim l As AcadLine
  Dim x&, y&, z%
  Dim p1#(2), p2#(2), p3#(2)
  p1(0) = 0: p1(1) = 0: p1(2) = 0
  p2(0) = 0: p2(1) = 15: p2(2) = 0
  With ThisDrawing.ModelSpace
      Set l = .AddLine(p1, p2)
      For x = -10 To 10
        For y = -10 To 10
            p3(0) = x: p3(1) = y + 15: p3(2) = 0
            et l = .AddLine(p2, p3)
            If z >= 256 Then z = 0
            l.Color = z
            z = z + 1
          Next
      Next
  End With
  ZoomExtents
End Sub

---

 

aber hier ..., wirds finster

Code:

---

Sub haengen() 'danger - bitte, so nicht starten
Dim l As AcadLine
Dim x&, y&, z%, r&, g&, b&
Dim p1#(2), p2#(2), p3#(2)
Dim color As AcadAcCmColor
Set color = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.16")
   
p1(0) = 0: p1(1) = 0: p1(2) = 0
p2(0) = 0: p2(1) = 15: p2(2) = 0
With ThisDrawing.ModelSpace
  Set l = .AddLine(p1, p2)
  For x = -10 To 10
      For y = -10 To 10
        p3(0) = x: p3(1) = y + 15: p3(2) = 0
        Set l = .AddLine(p2, p3)
        For r = 0 To 254
            For g = 0 To 254
              For b = 0 To 254
                  Call color.SetRGB(r, g, b)
                  l.TrueColor = color
              Next
            Next
        Next
      Next
  Next
End With
End Sub

---

Ja, also - wiegesagt, freue mich auf nette Antworten - und eh' ichs vergess', himmel, wir haben ja schon den fast den 21.12. ...

ein besinnliches Fest & natürlich auch ein fröhliches, gutes 2005 wünscht schonmal prophylaktisch

L.Friede 

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

---

mhh, ich weiß zwar nicht, wo genau das Problem liegt (Ich trau mich aufgrund deiner Warnung nicht, das Ding hier auszuführen...  )
Also an der Farbdefinition scheint es nicht zu liegen.
Vielleicht hilft eine kleine Pause ja wirklich, zB. so:
  a = Timer
  Do While Timer < a + 0.05
  Loop

Grüße!
René

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

---

Jo mei, danke für den Pause Tip, hab selber mal eine gemacht ... 
Sodele, bei meiner Recherche im Forum ist nun was völlig andres rausgekommen, als ursprünglich geplant.
Etwas zusammengestückelt is nun sowas rausgekommen.
Wollte ja statt des rotate was mit gradientcolors spielen,
habs aber nicht hinbekommen - is auch wurscht 

Fröhliche Weihnachten

L.Friede

Code:

---

Option Explicit
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub x_mas()
   Dim color As AcadAcCmColor, color1 As AcadAcCmColor, color2 As AcadAcCmColor
   Set color = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.16")
   Dim dummy As AcadLine, outerloop(0) As AcadEntity, myhatch As AcadHatch
   Dim p1#(2), p2#(2), p3#(2), p4#(2), coo
   Dim n#, r#, i%, k%
   Const pi# = 3.14159265358979
   n = 10: r = 3
   p2(0) = r: p3(0) = r + 7
   With ThisDrawing.ModelSpace
      Set myhatch = .AddHatch(1, "SOLID", 0)
      Set dummy = .AddLine(p1, p2)
      ReDim p#((n + 1) * 2 - 1)
      For i = 0 To UBound(p) Step 2
         coo = dummy.EndPoint
         p(i) = coo(0)
         p(i + 1) = coo(1)
         dummy.Rotate p1, 360 / n * pi / 180
      Next
      dummy.Delete
      Set dummy = .AddLine(p2, p3)
      dummy.Rotate p4, 18 * pi / 180
      ReDim star#(UBound(p) * 2 - 1)
      k = 0
      For i = 0 To UBound(star) - 3 Step 4
         coo = dummy.EndPoint
         star(i) = p(k)
         star(i + 1) = p(k + 1)
         star(i + 2) = coo(0)
         star(i + 3) = coo(1)
         k = k + 2
         dummy.Rotate p4, 36 * pi / 180
      Next
      star(UBound(star) - 1) = p(0)
      star(UBound(star)) = p(1)
      dummy.Delete
      Set outerloop(0) = .AddLightWeightPolyline(star)
      outerloop(0).Closed = 1
      myhatch.AppendOuterLoop outerloop
      myhatch.Evaluate
      ZoomExtents
      outerloop(0).Delete
      For i = 1 To 255
         Call color.SetRGB(i, 0, 0)
         myhatch.TrueColor = color
         myhatch.Rotate p4, 0.5 * pi / 180
         ThisDrawing.Regen acActiveViewport
         Sleep 100
      Next
      myhatch.Delete
   End With
End Sub

---

[Diese Nachricht wurde von L.Friede am 22. Dez. 2004 editiert.]

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

---

lower.txt

kommt mir doch etwas bekannt vor, lass' mer aber mal aussen vor ;-)
Eins würd mich mal intressieren an der sache, das 'unruhige Bild' ...
Liegt das am 256x Regnen? oder evtl. an meinem Monitor?

Zum andren @all:
Weiss ja nicht, wielange und ob überhaupt jemand noch vor der ersten Januarwoche 05 da ist.
Deswegen nur kurz, hat mich gefreut, war ein nettes Jahr hier in der Runde, dafür wollte ich einfach mal Danke sagen.
Alle ihr da draussen, gesegnetes Fest, guten Rutsch sowie ein aalglattes Durchstarten 2005,
was auch immer ihr euch vorgenommen habt.

Also bis demnächst - in diesem Theater ;-)

Gruss Nancy
--
We all live in a yellow subroutine.

[Diese Nachricht wurde von startrek am 22. Dez. 2004 editiert.]

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

---

jo, bei mir flimmerts auch...
Aber trotzdem ein nettes X_Mas-Prog!

Nun denn,wünsch euch auch allen und guten Rutsch!

Grüße!
René

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

---

Auch von mir, frohe Weihnachten und einen guten Rutsch!!!

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

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

---

tja, [flimmer]Kiste gelöst ...

man nehme statt thisdrawing.regen activeviewport ein:
thisdrawing.application.update
... dann läuft die Sache auch etwas 'ruhiger' ab.

Nich das ich da alleine drauf gekommen bin, thx an den Stein, äh - Proxy des Anstoss'.
Wollt nur einfach die 'falsche' Zeile korrigieren.

Achja - sleep 10-20 macht die Sache etwas flotter ;-)

Gruss Nancy
--
'Warum ich?' fragte der Frosch.
'Geschmackssache!' sagte der Storch.

[Diese Nachricht wurde von startrek am 23. Dez. 2004 editiert.]

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