;;;*******************************************************************
;;; AX_Property.LSP
;;;
;;; Stellt 2 Funktionen bereit:
;;; - Ermittelt die Eigenschaften eines Zeichnungsobjekts
;;; - Modifizieren der Eigenschaften eines Zeichnugsobjekts
;;;
;;; Beispielcode unter Verwendung von VLisp-ActiveX
;;; Code entnommen aus "Kochbuch AutoLISP" Kap. 4.4 (Fehler korrigiert)
;;;
;;; Keine Behandlung von Laufzeitfehlern!
;;;
;;; 27.05.2010; pb
;;;
;;; Modifikationen
;;; 02.06.2010; pb
;;; - Prüfung auf existierende Eigenschaft und ob ggf. modifizierbar
;;; - "vlax*put-property" gibt bei Fehler nicht NIL,
;;;   sondern korrigierte Werteliste zurück
;;;*******************************************************************

;;;--------------------------------------------------------------------;
;;;  First of all we have to init the ActiveX interface.               ;
;;;--------------------------------------------------------------------;
(vl-load-com)

;;;*******************************************************************
;;; vlax*get-property
;;; Funktion zum Lesen mehrerer Objekt-Eigenschaften
;;;
;;; Eingabeparameter:
;;;  obj = Verweis auf ActiveX-Objekt
;;;  props = ActiveX-Name einer Eigenschaft oder
;;;          Liste der ActiveX-Namen der Eigenschaften
;;;
;;; Rückgabe:
;;;  Eigenschaftswert (Variant)
;;;   oder
;;;  Werteliste, wenn eine Eigenschaftsliste übergeben wurde
;;;*******************************************************************
(defun vlax*get-property (obj props / vlax*get-property1)

  ;; Hilfsfunktion zum Lesen einer Eigenschaft
  ;; Gibt Ersatzwert="*UNBEKANNT*" zurück, bei
  ;; nicht existierender Eigenschaft
  (defun vlax*get-property1 (obj prop1 /)
    (if	(vlax-property-available-p obj prop1)
      (vlax-get-property obj prop1)
      '*UNBEKANNT*			;Ersatzwert
    )
  ) ;_defun
  
  ;; Wenn kein Objekt vorgegeben wurde, dann mit dem Application-Objekt anfangen
  (if(null obj)(setq obj(vlax-get-acad-object)))
  
  ;; Prüfen, ob Liste mit mehreren Eigenschaften abzufragen ist
  (if (listp props)

    ;; Werteliste bilden
    (progn
      (if (cdr props)
	;; Liste mit mehreren Elementen lesen
	;; Eigenschaftsliste rekursiv abarbeiten
	(cons
	  (vlax*get-property1 obj (car props)) ;aktuelle erste Eigenschaft lesen
	  (vlax*get-property obj (cdr props)) ;Rekursiv zur nächsten Eigenschaft
	)

	;; einzelnes/letztes Element der Eigenschaftsliste lesen
	(list (vlax*get-property1 obj (car props)))
      )
    )

    ;; Einzelne Eigenschaft lesen 
    (vlax*get-property1 obj props)
  )
)

     
;;;*******************************************************************
;;; vlax*put-property
;;; Funktion zum Modifizieren mehrerer Objekt-Eigenschaften
;;;
;;; Eingabeparameter:
;;;  obj = Verweis auf ActiveX-Objekt
;;;  props = ActiveX-Name einer Eigenschaft
;;;           oder
;;;          Liste der ActiveX-Namen der Eigenschaften
;;;  values = Ein einzelner Wert, wenn props auch nur ein einzelner Name ist
;;;            oder
;;;           Liste mit neuen Werten, wenn props eine Liste ist!
;;;
;;; Rückgabe: NIL, wenn kein Fehler
;;;           sonst korrigierte Werteliste
;;;*******************************************************************
(defun vlax*put-property (obj props values / vlax*put-property1 ErrValues)

  ;; Hilfsfunktion zum Setzen einer Eigenschaft
  ;; Gibt Ersatzwert="*UNMOEGLICH*" zurück, bei
  ;; nicht existierender oder modifizierbarer Eigenschaft
  (defun vlax*put-property1 (obj prop1 value1 /)
    (if	(vlax-property-available-p obj prop1 T)
      (progn
	(vlax-put-property obj prop1 value1)
	value1
      )
      '*UNMOEGLICH*			;Ersatzwert
    )
  ) ;_defun

  
  ;; Wenn kein Objekt vorgegeben wurde, dann mit dem Application-Objekt anfangen
  (if(null obj)(setq obj(vlax-get-acad-object)))
  
  ;; Prüfen, ob Liste mit mehreren Eigenschaften abzufragen ist
  (if (listp props)
    ;; Eigenschaftsliste rekursiv abarbeiten
    (progn
      (if (cdr props)
	(cons
	  (vlax*put-property1 obj (car props) (car values))
					;aktuelle erste Eigenschaft schreiben
	  (vlax*put-property obj (cdr props) (cdr values))
					;Rekursiv zur nächsten Eigenschaft
	)

	;; einzelnes/letztes Element der Eigenschaftsliste schreiben
	(if (member '*UNMOEGLICH*
		    (setq ErrValues
			   (list (vlax*put-property1 obj (car props) (car values)))
		    )
	    )
	  ;; Rückgabe der Werteliste mit Ersatzwert bei Fehler
	  ErrValues
	  ;; kein Fehler
	  NIL
	)
      )
    )

    ;; Einzelne Eigenschaft schreiben
    (if (= '*UNMOEGLICH* (vlax*put-property1 obj props values))
      ;; Rückgabe des Ersatzwerts bei Fehler
      '*UNMOEGLICH*
      ;; Erfolgreich
      NIL
    )
  )
)


;;;*******************************************************************
;;; Test-Funktion zum Eigenschaft lesen/schreiben
;;;*******************************************************************
(defun C:TestProp ( / obj prop arg)
  ;; Endlosschleife - Abbruch mit ESC oder bei Fehler
  (while T
    
    ;; Objekt wählen
    (setq obj
	   (vlax-ename->vla-object
	     (car (entsel "\nWähle Objekt... "))
	   )
    )
    
    ;; Eigenschaft/-en angeben
    ;; Falls Liste eingegeben wurde, dann Umwandlung von String in List
    (if (= "("		;erstes Zeichen = "(" ???
	   (substr
	     (setq prop(getstring T "\nActiveX-Name bzw. Liste der zu lesenden/modifizierenden Eigenschaft(en) bzw. \"*\" für Eigenschaftsliste: "))
	     1 1)
	 )
      (setq prop(read prop))
      prop
    )
    
    ;; Optional neue(n) Wert(e) angeben
    (cond ((= prop "")
	   (princ "\nKeine Eigenschaft angegeben!")
	  )

	  ((= prop "*")
	   ;; Auflistung aller Eigenschaften ausgeben
	   (vlax-dump-object obj)	;_ Properties mit Werten werden direkt ausgegeben
	  )

	  ;; prop wurde angegeben
	  (T
	   ;; Falls Eigenschaften bereits in einer Liste eingegeben wurden, dann Umwandlung von String in List
	   (progn
	     (if (listp prop)
	       (progn
		 (setq arg
			(getstring
			  T
			  "\nNeue Werte für angegebene Eigenschaften als Liste oder keine zum Lesen: "
			)
		 )
	       )
	       (setq arg
		      (getstring
			T
			"\nNeuer Wert für angegebene Eigenschaft oder keinen zum Lesen: "
		      )
	       )
	     )

	     ;; Lesen oder Schreiben, wenn arg angegeben?
	     (if (= arg "")
	       ;; Lesen
	       (print (vlax*get-property obj prop))
	       ;; Schreiben
	       (progn
		 (if (listp prop)
		   (setq arg (read arg))
		 ) ;_ String -> Liste
		 (if (setq Ergebnis (vlax*put-property obj prop arg))
		   ;; Fehler
		   (progn
		     (print Ergebnis)
		     (print "!!! Fehler beim Modifizieren !!!")
		   )
		   ;;OK
		   (print "OK - Eigenschaft(en) geändert.")
		 )
	       )
	     )
	   )
	  )
    );_ cond
  );_ while
)

  

;;;(Princ "\nFunktionen \"vlax*get-property\" und \"vlax*put-property\" geladen.\n")
;;;(Princ "\nZum Test benutze Funktion: \"TestProp\"")
(princ)
;|«Visual LISP© Format Options»
(80 2 40 2 nil " " 70 9 0 0 0 T T nil T)
;*** KEINEN Text unterhalb des Kommentars hinzufügen! ***|;