;| acmZLevelOfPoint2MText

Beschriften der Z-Koordinate von ausgewählten Punktobjekten
mit einem Schriftfeld
Plattform: ab AutoCAD 2020

Copyright
Markus Hoffmann, www.CADmaro.de

Juni 2023
|;
(defun c:acmZLevelOfPoint2MText	(/ ssP l 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:GetObjectIdString
		  (vlax-ename->vla-object p)
		)
		l
	      )
       )
     )
    (mx:SelectionSet->EList ssP)
  )
  ;;
  ;; Alle MTexte löschen, die diese Object-IDs referenzieren
  (if
    (setq ssT (ssget "_X" '((0 . "MTEXT"))))
     (mapcar
       '(lambda	(e / o s iStartString sID)
	  (if (setq o (mx:IsField? e))
	    (progn
	      (if
		(and
		  (setq s (mx:GetFieldcode e))
		  (setq	iStartString
			 (+ 8 (vl-string-search "_ObjId " s))
		  )
		  (setq	sID
			 (substr
			   s
			   (+ 8 (vl-string-search "_ObjId " s))
			   (+ 1
			      (- (vl-string-search ">%)" s) iStartString)
			   )
			 )
		  )
		  (member sID l)
		)
		 (vla-delete (vlax-ename->vla-object e))
	      )
	    )
	  )
	)
       (mx:SelectionSet->EList ssT)
     )
  )
  (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 "
		(itoa
		  (vla-get-objectid
		    (vlax-ename->vla-object p)
		  )
		)
		">%).Coordinates \\f \"%pt4\">%"
	      )
       )
       (vla-put-textstring oMT s)
       (vla-put-AttachmentPoint oMT acAttachmentPointTopLeft)
       (vla-put-InsertionPoint
	 oMT
	 (vla-get-Coordinates
	   (vlax-ename->vla-object p)
	 )
       )
       (setq rOffset
	      (/
		(*
		  (getvar "TEXTSIZE")
		  0.5			; Textversatz von Punkt in x und y
		)
		(getvar "CANNOSCALEVALUE")
	      )
       )
       (setq transMat
	      (vlax-tmatrix
		(list
		  (list 1 0 0 roffset)
		  (list 0 1 0 roffset)
		  '(0 0 1 0)
		  '(0 0 0 1)
		)
	      )
       )
       (vla-TransformBy oMT transMat)
       (vla-update oMT)
     )
    (mx:SelectionSet->EList ssP)
  )
  (mx:Reset)
  (princ)
)

 ;| 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:GetObjectIdString

Gibt die ObjectID des Objekts zurück unabhängig davon, ob ein 32 oder 64Bit-System verwendet wird
zurück
|;
(defun mx:GetObjectIdString (obj)
  (setq objUtil (vlax-get-property oAD 'Utility))
  (if
    (vlax-method-applicable-p objUtil 'GetObjectIdString)
     (vlax-invoke-method
       objUtil
       'GetObjectIdString
       obj
       :vlax-false
     )
     (itoa (vlax-get-property obj 'ObjectId))
  )
)

 ;| 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:ZLOP2T () (c:acmZLevelOfPoint2MText))

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