;| acmZLevelOfPoint2Field

Schreibt die Z-Koordinate ausgewählter Punktobjekte als Schriftfeld an die Punkte

Plattform: ab AutoCAD 2020

Copyright
Markus Hoffmann, www.CADmaro.de

August 2023
|;
(defun c:acmZLevelOfPoint2Field (/ ssP l rFuzzy lT ss ssT oSpace)
  (mx:Init)
  (princ "\nBitte Punkte auswählen: ")
  (setq ssP (ssget '((0 . "POINT"))))
  ;;
  ;; Alle Object-IDs der gewählten Punkte einsammeln
  (mapcar
    '(lambda (p)
       (setq l
              (cons
                (mx:GetObjectID
                  (vlax-ename->vla-object p)
                )
                l
              )
       )
     )
    (mx:SelectionSet->EList ssP)
  )
  ;;
  ;; Umgebungsbereich definieren
  (setq rFuzzy (/ (distance (getvar 'EXTMIN) (getvar 'EXTMAX)) 100))
  ;;
  ;; Textobjekte um jeden Punkt suchen
  (mapcar
    '(lambda (p)
       (setq lT
              (cons
                (mx:ssgetFuzzy
                  (vlax-safearray->list
                    (vlax-variant-value
                      (vla-get-Coordinates
                        (vlax-ename->vla-object p)
                      )
                    )
                  )
                  rFuzzy
                  '(0 . "*TEXT")
                )
                lT
              )
       )
     )
    (mx:SelectionSet->EList ssP)
  )
  (setq ss (LM:ss-union (vl-remove nil lT)))
  ;;
  ;; Texthöhe anhand des ersten gefundenen Texts festlegen
  (setq rSize
         (if
           (setq ss (ssget "X" '((0 . "*TEXT"))))
            (vla-get-Height
              (vlax-ename->vla-object
                (ssname ss 0)
              )
            )
            (getvar 'TEXTSIZE)
         )
  )
  ;;
  ;; Texte mit Schriftfeldern, die den Specs entsprechen, löschen
  (if ss
    (mapcar
      '(lambda (e / o s)
         (if (setq o (mx:IsField? e))
           (progn
             (if
               (and
                 (setq s (mx:GetFieldcode e))
                 (mapcar
                   '(lambda (i)
                      (wcmatch s (strcat "*" i "*"))
                    )
                   (cons
                     "\\f \"%lu6%pt4\">%"
                     l
                   )
                 )
               )
                (vla-delete (vlax-ename->vla-object e))
             )
           )
         )
       )
      (mx:SelectionSet->EList ss)
    )
  )
  ;;
  ;; Neue Schriftfelder absetzen
  (setq oSpace (mx:ActiveSpace))
  (mapcar
    '(lambda (p / oMT s)
       (setq oMT
              (vla-AddMtext
                oSpace
                (vla-get-Coordinates
                  (vlax-ename->vla-object p)
                )
                0.0
                "###"
              )
       )
       (setq s
              (strcat
                "%<\\AcObjProp Object(%<\\_ObjId "
                (mx:GetObjectID
                  (vlax-ename->vla-object p)
                )
                ">%).Coordinates \\f \"%pt4\">%"
              )
       )
       (vla-put-textstring oMT s)
       (vla-put-Height oMT rSize)
       (vla-update oMT)
     )
    (mx:SelectionSet->EList ssP)
  )
  (princ "\nFertig")
  (mx:Reset)
  (princ)
)

 ;| mx:ssgetFuzzy
SSGET-Auswahl mit Crossing und Fuzzy-Bereich um einen Punkt
|;
(defun mx:ssgetFuzzy (p rF lFilter / p1 p2)
  (setq
    p1 (polar p (deg2rad 270) (/ rF 2))
    p2 (polar p (deg2rad 45) (/ rF 2))
  )
  (ssget "_C" p1 p2 (list lFilter))
)

 ;| Selection Set Union  -  Lee Mac
;; Returns the union of a list of Selection Sets
|;
(defun LM:ss-union (lst / i out)
  (setq lst (vl-sort lst '(lambda (a b) (> (sslength a) (sslength b))))
        out (car lst)
  )
  (foreach ss (cdr lst)
    (repeat (setq i (sslength ss))
      (ssadd (ssname ss (setq i (1- i))) out)
    )
  )
  out
)

 ;| deg2rad
Winkel von Bogenmaß in Grad wandeln
|;
(defun deg2rad (a)
  (* pi (/ a 180.0))
)

 ;| mx:SelectionSet->EList

Auswahlsatz in Liste umwandeln
|;
(defun mx:SelectionSet->EList (ss / c lst)
  (repeat
    (setq c (sslength ss))
     (setq lst
            (cons
              (ssname ss (setq c (1- c)))
              lst
            )
     )
  )
)

 ;| ST:ActiveSpace

gibt den aktiven Bereich zurück.
Papier oder Modell bzw. Modell im Papier
|;
(defun mx:ActiveSpace (/ space)
  (if
    (= acModelSpace (vlax-get-property oAD 'ActiveSpace))
     (setq space (vlax-get-property oAD 'ModelSpace))
     (if (= :vlax-true (vlax-get-property oAD 'MSpace))
       (setq space (vlax-get-property oAD 'ModelSpace))
       (setq space (vlax-get-property oAD 'PaperSpace))
     )
  )
  space
)

 ;|
mx:IsField?

enthält das übergebene Objekt ein Schriftfeld,
wird das Schriftfeldobjekt zurückgegeben, sonst NIL
|;
(defun mx:IsField? (ent / result)
  (if
    (and
      (= :vlax-true
         (vlax-get-property
           (vlax-ename->vla-object ent)
           'HasExtensionDictionary
         )
      )
      (not
        (vl-catch-all-error-p
          (setq
            result
             (vl-catch-all-apply
               'vlax-invoke-method
               (list
                 (vlax-invoke-method
                   (vlax-ename->vla-object ent)
                   'GetExtensionDictionary
                 )
                 'Item
                 "Acad_field"
               )
             )
          )
        )
      )
    )
     (vla-item result 0)
  )
)

 ;|
mx:GetFieldcode

Gibt die Schriftfeld-Definition als String zurück
bzw. NIL, wenn das Objekt kein Schriftfeld ist.
|;
(defun mx:GetFieldcode (ent / str)
  (if
    (member
      (cdr (assoc 0 (entget ent)))
      '("ATTRIB" "ATTDEF")
    )
     (setq attprinc
            "\nUnterstützt keine Schriftfelder in Attributen."
     )
     (vl-catch-all-error-p
       (setq str
              (vl-catch-all-apply
                'vlax-invoke-method
                (list
                  (vlax-ename->vla-object ent)
                  'FieldCode
                )
              )
       )
     )
  )
  str
)

 ;| mx:GetObjectID
Object-ID für 32- und 64-Bit-Systeme ermitteln
|;
(defun mx:GetObjectID (o)
  (or *util*
      (setq *util*
             (vla-get-Utility oAD)
      )
  )
  (if
    (vlax-method-applicable-p *util* 'GetObjectIDString)
     (vla-GetObjectIDString *util* o :vlax-false)
     (itoa (vla-get-ObjectID o))
  )
)

 ;| mx:Init

Initialisierung
|;
(defun mx:Init ()
  (vl-load-com)
  (setq oA (vlax-get-acad-object))
  (setq oAD
         (vlax-get-property
           oA
           'ActiveDocument
         )
  )
  (setq iEcho (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (setq c 0)
  (setq errorMX *error*
        *error* mx:Error
  )
  (vlax-invoke-method oAD 'EndUndomark)
  (vlax-invoke-method oAD 'StartUndomark)
)

 ;| mx:Reset

Zurücksetzen
|;
(defun mx:Reset ()
  (vla-regen oAD acAllViewports)
  (setq c nil)
  (setvar "CMDECHO" iEcho)
  (vlax-invoke-method oAD 'EndUndomark)
  (vlax-release-object oAD)
  (vlax-release-object oA)
  (setq *error* errorMX)
  (mapcar
    '(lambda (arg)
       (set
         arg
         'nil
       )
     )
    (list 'errorMX 'iEcho 'oAD 'oA 'lSelected)
  )
)

 ;| mx:Error

Errorfunktion
|;
(defun mx:Error (s)
  (print (strcat "Fehler " s))
  (command-s)
  (command-s
    "_.undo"
    "_back"
  )
  (mx:Reset)
  (princ)
)

;;; Kurzbefehl
(defun c:ZLOP2F () (c:acmZLevelOfPoint2Field))

;; Feedback beim Laden
(princ
  "acmZLevelOfPoint2Field.lsp ist geladen. Copyright M.Hoffmann, www.CADmaro.de.
Start mit \"ZLOP2F\""
)
(princ)