---

Hallo Community,

ich möchte Linien einer bestehenden Zeichnung mit der Ausrichtung in z beschriften. Allerdings sollen nur Linien bestimmter Layer beschriftet werden. Wie kann ich das nun anstellen. Im Moment bin ich nur soweit, das mir alle Linien der gesamten Zeichnung beschriftet werden. Hier nun mein bestehender Code.

Grüße Daniel.

Code:

---

Sub text_auf_linieNEU()

Dim Pkt As Variant
Dim Höhe As Double
Dim txt As AcadText
Dim Texthoehe As Double
Dim spoint As Variant
'Dim epoint As Variant
'Dim mpoint(0 To 2) As Double
Dim obj As AcadEntity

For Each obj In ThisDrawing.ModelSpace

If TypeOf obj Is AcadLine Then
   
               
   
    spoint = obj.startpoint
    'epoint = obj.endpoint
   
    'mpoint(0) = (spoint(0) + epoint(0)) / 2
    'mpoint(1) = (spoint(1) + epoint(1)) / 2
    'mpoint(2) = (spoint(2) + epoint(2)) / 2

    Höhe = spoint(2)
    Texthoehe = 20
   
   
    Set txt = ThisDrawing.ModelSpace.AddText(Round(Höhe, 2), spoint, Texthoehe)
    txt.Rotate spoint, obj.Angle
    txt.Alignment = acAlignmentCenter
    txt.TextAlignmentPoint = spoint
   
   

End If

Next obj

End Sub

---

[Diese Nachricht wurde von danie8778 am 13. Mrz. 2011 editiert.]

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

---

Hi,

herzlich willkommen bei CAD-de! 

Wenn die Frage ist, wie kann ich nur die Linien auf einem bestimmten Layer beschriften, dann bau eine IF-Abfrage ein, z.B.:

If obj.Layer = "MeinLinienLayerName" then

Der Performance wegen würde ich aber zuerst ein SelectionSet machen, das nur Linien auf Deinem Layer selektiert, dann brauchst Du nachher nur die Objekte im SelectionSet durchgehen, dabei nicht mehr prüfen, ob es eine Linie ist und ob es am richtigen Layer ist. Geht schneller als den ganzen Modellbereich durchzuscannen.

Ein Beispiel für Filterung und SelectionSet findest Du >>>hier<<<

HTH, - alfred -

------------------
www.hollaus.at

---

Hallo Alfred,

danke für die schnelle Antwort. Manchmal ist die Lösung einfach zu nahe liegend.
Da hätte ich auch selbst drauf kommen können. Aber als VBA Anfänger....   

Edit: Den Beitrag mit dem SelectionSet hab ich auch schon gefunden. Nur leider bin ich da nicht ganz durchgestiegen.

[Diese Nachricht wurde von danie8778 am 12. Mrz. 2011 editiert.]

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

---

Hi,

>> Den Beitrag mit dem SelectionSet hab ich auch schon gefunden.
>> Nur leider bin ich da nicht ganz durchgestiegen.

Code:

---

Dim tSelSet as AcadSelectionSet

On Error Resume Next
Set tSelSet = ThisDrawing.SelectionSets.Add("SelSetMyLines")
If Err.Number <> 0 Then
  Set tSelSet = ThisDrawing.SelectionSets("SelSetMyLines")
  tSelSet.Clear
End If
On Error Goto 0

Dim tDxfCodes(2) As Integer
Dim tDxfValues(2) As Variant
tDxfCodes(0) = 0: tDxfValues(0) = "LINE"                'nur Linien
tDxfCodes(1) = 8: tDxfValues(1) = "MeinLinienLayerName"  'nur dieser Layer
tDxfCodes(2) = 410: tDxfValues(2) = "Model"              'nur Modellbereich

'und dann kannst Du mit diesem Filter die Selektion machen
tSelSet.Select acSelectionSetAll, , , tDxfCodes, tDxfValues

if tSelSet.Count > 0 then
  dim tLine as AcadLine
  for each tLine in tSelSet
    'und da kannst Du jetzt Deine Beschriftung setzen
  next
end if

---

Viel Erfolg, - alfred -

------------------
www.hollaus.at