Code:
(VL-LOAD-COM)(defun C:PL-AREA (/ LST RETVAL SGET)
(princ "\nAuszuwertende Polylinen wählen: ")
(if (setq SGET (ssget (list (cons 0 "*POLYLINE"))))
(if (setq LST (DT:SELSET->VLA-OBJECTLIST SGET))
(progn
(setq RETVAL
(rtos
(apply
'+
(mapcar
(function (lambda (X) (vlax-get-property X 'AREA)))
LST
)
)
2
4
)
)
(sssetfirst SGET SGET)
(if (setq LST (getpoint "\nPunkt für Textplatzierung klicken: "))
(vla-addtext
(GET-CSPACE)
RETVAL
(vlax-3d-point LST)
(getvar "textsize")
)
)
)
)
)
RETVAL
)
;;; z.B. (DT:SELSET-LIKE-DEFINITION (list (cons 0 "IMAGE")(cons 8 "*$BILD$@*")))
(defun DT:SELSET->ENAMELIST (SELSET / INDEX RETVAL)
(if (eq (type SELSET) 'PICKSET)
(progn
(setq INDEX 0)
(repeat (sslength SELSET)
(setq RETVAL (cons (ssname SELSET INDEX) RETVAL)
INDEX (1+ INDEX)
) ;_ end of setq
) ;_ end of repeat
) ;_ end of progn
) ;_ end of if
retval
) ;_ end of defun
(defun DT:SELSET->VLA-OBJECTLIST (SELSET / RETVAL)
(if (eq (type SELSET) 'PICKSET)
(if (setq RETVAL (DT:SELSET->ENAMELIST SELSET))
(setq RETVAL
(mapcar (function (lambda (X) (->VLA-OBJECT X))) RETVAL)
) ;_ end of setq
) ;_ end of if
) ;_ end of if
RETVAL
) ;_ end of defun
;;; Funktion gibt Ename zurück, wenn Lisp-Objekt oder vla-Objekt
;;; übergeben worden sind. Ansonsten nil
(defun ->ENAME (ENAME /)
(cond
((= (type ENAME) 'VLA-OBJECT) (vlax-vla-object->ename ENAME))
((= (type ENAME) 'ENAME) ENAME)
(t NIL)
) ;_ end of cond
) ;_ end of defun
;;; Funktion gibt vla-Objekt zurück, wenn Lisp-Objekt oder vla-Objekt
;;; übergeben worden sind. Ansonsten nil
(defun ->VLA-OBJECT (ENAME /)
(cond
((= (type ENAME) 'ENAME) (vlax-ename->vla-object ENAME))
((= (type ENAME) 'VLA-OBJECT) ENAME)
(t NIL)
) ;_ end of cond
) ;_ end of defun
;;; Funktion zur ermittlung des MSpace VLAX-Objektes
(defun GET-MSPACE ()
(vla-get-modelspace (GET-ACTIVEDOCUMENT))
) ;_ end of defun
(defun GET-PSPACE ()
(vla-get-paperspace (GET-ACTIVEDOCUMENT))
) ;_ end of defun
(defun GET-CSPACE ()
(if (eq (getvar "tilemode") 1)
(GET-MSPACE)
(if (not (eq (getvar "cvport") 1))
(GET-MSPACE)
(GET-PSPACE)
) ;_ end of if
) ;_ end of if
) ;_ end of defun
;;; Funktion zur ermittlung des
;;; Aktiven Dokuments
(defun GET-ACTIVEDOCUMENT ()
(vla-get-activedocument (vlax-get-acad-object))
) ;_ end of defun