---

Hallo zusammen,

ich bin neu in diesem Forum und dabei meine ersten kleinen Programme zu schreiben. Somit treffe ich auf viele Probleme. Hier mein akutes:
Ich möchte einem Rechteck, das ich im Modelbereich gezeichnet habe, eine Art Anhang mit speziellen Informationen (laufende Nummer) mitgeben. Dies mache ich bislang über den Layer, was zu einer Vielzahl an Layern führt.
Gibt es hier eine Möglichkeit eine Eigenschaft (beispielsweise .Tag oder .Handler als String) anzusprechen und zu überschreiben?

Hier mal ein Code-Schnipsel...

'#laufende Nummer aus Selection Set
Dim NewLayer As AcadLayer
Dim Layername As String
Dim lfNr As String
Dim Sset As AcadSelectionSet
    On Error Resume Next
    Set Sset = ThisDrawing.SelectionSets("mysel")
    If Err.Number Then
        Set Sset = ThisDrawing.SelectionSets.Add("mysel")
    End If
    On Error GoTo 0
   
    Dim FilterData(0 To 1) As Variant
    Dim FilterType(0 To 1) As Integer
    FilterType(0) = 8              'Layer
    FilterData(0) = "AF-*"          'Layer
    FilterType(1) = 67              'nur im Modellbereich suchen
    FilterData(1) = 0
   
    Sset.Select acSelectionSetAll, , , FilterType, FilterData
lfNr = Sset.Count + 1

'#Maßstab aus ComboBox
Dim Maßstab As String
      Maßstab = Mid(ComboBoxDIM.Value, 9)  '"Maßstab "wird entfernt, nur zahlen bleiben über
Maßstab = Replace(Maßstab, ":", "_")
Layername = "AF-" & lfNr & "-MSTB" & "-" & Maßstab
Set NewLayer = ThisDrawing.Layers.Add(Layername)

'#Punkte picken
Dim Point As Variant
Dim Point1 As Variant
Dim Prompt1 As String
Dim Prompt2 As String

Me.Hide

ThisDrawing.SetVariable "osmode", 47 'Zentrum
    Prompt1 = vbCrLf & "ersten Punkt unten links angeben: "
    Point = ThisDrawing.Utility.GetPoint(, Prompt1)
   
ThisDrawing.SetVariable "osmode", 47 'Lot
    Prompt2 = vbCrLf & "Zweiten Punkt oben angeben: "
    Point1 = ThisDrawing.Utility.GetPoint(Point, Prompt2)
ThisDrawing.ActiveLayer = NewLayer

'#Rechteck zeichnen
Dim Rechteck As AcadLWPolyline
Dim PointsBox(0 To 7) As Double
    PointsBox(0) = Point(0): PointsBox(1) = Point(1)    'Punkt unten links
    PointsBox(2) = Point1(0): PointsBox(3) = Point(1)  'Punkt unten rechts
    PointsBox(4) = Point1(0): PointsBox(5) = Point1(1)  'Punkt oben rechts
    PointsBox(6) = Point(0): PointsBox(7) = Point1(1)  'Punkt oben links
   
Set Rechteck = ThisDrawing.ModelSpace.AddLightWeightPolyline(PointsBox)
    With Rechteck
        .GetBoundingBox minptRe, maxptRE
        .Closed = True
        .ObjectName = "?????"  '#########funtioniert nicht#########
        End With

Ich hoffe Ihr könnt mir hierbei helfen

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

---

Hm, ich weiß ja nicht was Du vorhast, aber wenn ich das so lese- Maßstab, Beschreibung - wäre es evtl. eine Möglichkeit dass Du bestimmte Bauteile entwerfen möchtest? Dann wäre vielleicht ein Block mit entsprechenden Attributtext eine Variante.

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

---

Hallo KlaK, danke für deinen Tipp!

Ich würde gerne die Polylinie beibehalten. Es geht darum, dass ich mehrere bestimmte Modelbereiche als Ansichtsfenster im Layout sehen möchte. Das Rechteck ist für meine Zwecke besser in der Verwendung (kann man leicht mit dem "Strecken"-Befehl ändern) als ein Block.

Hast Du vielleicht noch einen Rat?

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

---

Zum Brandmarken von Objekten gibt es XData/EED, Extendet Entity Data. wie auch immer.

Google einfach mal mit den Begriffen.
http://www.cadalyst.com/cad/autocad/working-with-extended-data-vba-and-autolisp-4818 

------------------
CAD.de System-Angaben  -  CAD on demand  -  User:FAQ(Acad)

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

---

Hervorragend!!!! Das Klappt bestens!!   

Herzlichsten Dank 

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