---

hallo zusammen,
ich lass mir mit vba für autocad 2002 längsschnitte (für straßen)
zeichnen. u.a. werden auch viertel-kreise in einer schleife mit
schraffur/solid farbig ausgefüllt. jetzt hab ich das problem, dass
ich später die schraffur nur komplett bearbeiten kann und nicht zb.
nur einen viertel-kreis löschen kann. weiss jemand, wie ich das
problem umgehen kann.

ps: bin vba anfänger und jetz im wochenende. also antwort hat zeit
bis montag....

danke
jörg

hier noch der prog-code (ausschnitt):

'**********************************************************
    'Wechselpunkte ausfüllen
   
    Dim hatchObj As AcadHatch
    Dim patternName As String
    Dim PatternType As Long
    Dim bAssociativity As Boolean
   
    patternName = "SOLID"
    PatternType = 0

    bAssociativity = True
    Set hatchObj = ThisDrawing.ModelSpace.AddHatch(PatternType, patternName, bAssociativity)
    'Dim arcObj As AcadArc
    Dim outerLoop(0 To 2) As AcadEntity

    For i = 1 To n
        If bez(i) = "TS" Or bez(i) = "START" Then
        TSpunkt = ts(i)
        Abstand = abst(i)
        neigung = m(i)
        End If
       
    mth(i) = (TSpunkt + neigung / 100 * Abstand / 2 - ursprung) * 10    'höhe bei hälfte                                                            'Neigung,ausgerichtet
    mt(i) = TSpunkt + neigung / 100 * Abstand                            'höhe bei nächstem TS
    mm(i) = Atn(10 * (mt(i) - TSpunkt) / Abstand)                    'neigung ausgerichtet
   
    'MsgBox (bez(i) & " / " & mm(i))
   
    'If bez(i) = "TS" Or bez(i) = "START" Then
    If bez(i) = "TS" Then
    GoTo 105:
    Else
    GoTo 1005:
    End If
105:
   
    m1 = mm(i) * 10
   
    mtt = 1 + m1 / 100 * 50
    mm1 = mm(i) 'Atn(10 * (mtt - 1) / 50)
    center(0) = s(i): center(1) = (ts(i) - ursprung + 1.5) * 10: _
    center(2) = 0#
    radius = 1
    startAngle = mm1 '+ 3.141592
    endAngle = 0.5 * 3.141592
    Set arcObj = ThisDrawing.ModelSpace.AddArc _
    (center, radius, startAngle, endAngle)
   
    Set outerLoop(0) = arcObj
    Set outerLoop(1) = ThisDrawing.ModelSpace.AddLine _
    (outerLoop(0).startPoint, arcObj.center)
    Set outerLoop(2) = ThisDrawing.ModelSpace.AddLine _
    (outerLoop(0).endPoint, arcObj.center)
   
    hatchObj.AppendOuterLoop (outerLoop)
   
    m11 = mm(i - 1) * 10
    'MsgBox (m11)
    mtt = 1 + m11 / 100 * 50
    mm11 = mm(i - 1) 'Atn(10 * (mtt - 1) / 50)
    center(0) = s(i): center(1) = (ts(i) - ursprung + 1.5) * 10: _
    center(2) = 0#
    radius = 1
    startAngle = mm11 + 3.141592
    endAngle = 1.5 * 3.141592
    Set arcObj = ThisDrawing.ModelSpace.AddArc _
    (center, radius, startAngle, endAngle)
   
    Set outerLoop(0) = arcObj
    Set outerLoop(1) = ThisDrawing.ModelSpace.AddLine _
    (outerLoop(0).startPoint, arcObj.center)
    Set outerLoop(2) = ThisDrawing.ModelSpace.AddLine _
    (outerLoop(0).endPoint, arcObj.center)
   
    hatchObj.AppendOuterLoop (outerLoop)
   
1005:
Next i

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

---

Du erstellst eine Schraffur im Loop,
dann ist es auch eine Schraffur, wenn
du jedesmal eine Neue erzeugen würdest,
wären es auch einzelne Schraffuren, und
damit getrennt bearbeitbar.

------------------
Bernd Cuder
Cad&Co makes CAD easy - z.B. Applikation für lineare Bemaßung

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

---

Hallo Jörg!

Bin erst heute auf Deine Anzeige gestoßen. Wenn ich es richtig interpretiere, hast Du Dir ein Lisp-Programm für Längsschnitte geschrieben. Ich suche schon seit längerer Zeit Lisp-Programme für diesen Bereich.
Ist es möglich, dass Du mir Dein Programm zur Verfügung stellst?

Danke und Gruß
Josef

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