Code:
;;;***********************************************************************
;;;***********************************************************************
;;; **
;;; -== NovaConverter ==- **
;;; Ersetzt Texte zu einem Raumtempel_Block mit Polylinie **
;;; Verknüpfung und Setzt User eingabe vor der Alten Raumnummer **
;;; **
;;; Utxt -> User Eingabe [Usereingabe] + [Text]. **
;;; Ans -> Auswahlverfahren [Irgendwo anders benutzbar?] **
;;; sstext -> Alle Texte die das Kriterium Erfülle. **
;;; ni -> Zähler **
;;; ptxt -> Cordi des Aktuellen Textes. **
;;; **
;;;***********************************************************************
;;;***********************************************************************;;;Startet die Lisp (Für änderungen so geschrieben)
(defun c:NovaConverter (/ ans )
(initget 1 "Alle Wahl ")
(setq ans (strcase (getkword "\nVerfahren wälen [Alle/Wahl] : "))
ms (getvar "Millisecs")
)
(cond
((eq ans "ALLE") (NovaConverterstart ans ms))
((eq ans "WAHL") (NovaConverterstart ans ms))
((eq ans "Mehrfach") (NovaBatch!!!!!))
)
)
;;;***********************************************************************
(Defun NovaConverterstart (ans ms / Utxt sstxt Nci ptxt ms)
(vl-load-com)
(errorgo (list '("cmdecho" 0)
'("dynmode" 1)
'("Attdia" 0)
'("dynmode" 1)
'("Attreq" 1)
'("INSUNITS" 0)
'("INSUNITSDEFSOURCE" 0)
'("INSUNITSDEFTARGET" 0)
)
)
(if (tblsearch "Block" "B_Raumstempel")
(print "Block ist schon Vorhanden")
(progn (Entmakblk)
(print "Block wurde geladen")
)
)
(setq Utxt (getstring "\nHaus + . : ")
NCi 0
)
(cond
((eq ans "ALLE")
(progn (setq sstxt (ssget "_X"
'((-4 . "<OR")
(8 . "*Raum*")
(8 . "B_Fläche")
(-4 . "OR>")
(0 . "Text*")
)
)
)
)
) ;ALL
((eq ans "WAHL")
(progn (Setq sstxt (ssget '((-4 . "<OR")
(8 . "*Raum*")
(8 . "B_Fläche")
(-4 . "OR>")
(0 . "Text*")
)
)
)
)
)
) ;Cond
(repeat (sslength sstxt)
(setq ptxt (Cdr (assoc 10 (entget (ssname sstxt NCi))))
Polylink (strcat
"%<\\AcObjProp Object(%<\\_ObjId "
(Get-ObjectIDx64 (caar (lookPol (ssname sstxt NCi))))
">%).Area \\f \"%lu2%pr2\">%"
)
)
(command-s
"_.-Insert"
"B_Raumstempel"
ptxt
1
1
(/ (* (vla-get-rotation
(vlax-ename->vla-object (ssname sstxt NCi))
)
180
)
pi
)
""
(strcat Utxt (cdr (assoc 1 (entget (ssname sstxt NCi)))))
Polylink
) ;Comand
(Line ptxt
(vlax-curve-getclosestpointto
(caar (lookPol (ssname sstxt NCi)))
ptxt
)
)
(Setq NCi (+ NCi 1))
)
(errorEnd)
(setq ms (- (getvar "Millisecs") ms ))
(print (strcat "Es hatt " (itoa (/ ms 1000)) " Sekunden gedauert"))
(print "\FERTIG!")
(print)
) ;defun
;;;***************************************************************************
;;; *
;;; Wandelt eine Selection Set in eine Liste um *
;;; *
;;;***************************************************************************
(defun ss->list (a / i ssl)
(Setq i 0)
(repeat (- (sslength a) 1)
(setq ssl (append ssl (list (ssname a i)))
i (+ 1 i)
)
)
ssl
)
;;;***************************************************************************
;;; *
;;; Gibt die Cordinaten und Ename aus *
;;; *
;;;***************************************************************************
(defun List->Cordi (pl)
(mapcar 'cdr
(vl-remove-if-not
'(lambda (x)
(= (car x) 10)
)
pl
)
)
)
;;;***************************************************************************
;;; *
;;; Sucht das nächst liegende Objekt *
;;; *
;;;***************************************************************************
(defun lookPol (pt / ssobj txtpoi ssobj txtpoi x)
(setq ssobj (ss->list
(ssget "_X" '((0 . "*Polyline*") (8 . "B_Fläche")))
)
txtpoi (cdr (assoc 10 (entget pt)))
)
(vl-sort
(mapcar '(Lambda (x)
(list x
(distance txtpoi
(vlax-curve-getclosestpointto x txtpoi)
)
)
)
ssobj
)
'(lambda (a b) (< (car (cdr a)) (car (cdr b))))
)
)
;;;***************************************************************************
;;;**********************Gekaut von By Jimmy Bergmark*************************
(defun Get-ObjectIDx64 (obj / util)
(setq util (vla-get-Utility
(vla-get-activedocument (vlax-get-acad-object))
)
)
(if (= (type obj) 'ENAME)
(setq obj (vlax-ename->vla-object obj))
)
(if (= (type obj) 'VLA-OBJECT)
(if (> (vl-string-search "x64" (getvar "platform")) 0)
(vlax-invoke-method
util
"GetObjectIdString"
obj
:vlax-False
)
(rtos (vla-get-objectid obj) 2 0)
)
)
)
;;;**************************************************************************************
(defun Line (p1 p2)
(entmakex (list (cons 0 "LINE")
(cons 8 "Obj_TO_Poly")
(cons 62 1)
(cons 420 15835136)
(cons 10 p1)
(cons 11 p2)
)
)
)
;;;***************************************************************************
(Defun Entmakblk (/)
(entmake
(list (cons 0 "BLOCK")
(cons 2 "B_Raumstempel")
(cons 8 "B_Raumstempel")
(list 10 0 0)
(cons 70 2)
)
) ;Block
(entmake
(append
(list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 8 "B_Raumstempel")
(cons 90 4)
(cons 70 1)
)
(mapcar (function (lambda (x) (cons 10 x)))
'((0.0 0.794658)
(1.80053 0.794658)
(1.80053 0.0)
(0.0 0.0)
)
)
)
) ;LW Poly
(entmake
(list
'(0 . "ATTDEF")
'(100 . "AcDbEntity")
(cons 8 "B_Raumstempel")
'(100 . "AcDbText")
'(10 0.081435 0.598051 0.0)
'(40 . 0.15)
'(7 . "Klinikum1")
'(1 . "")
'(100 . "AcDbAttributeDefinition")
'(280 . 0)
'(3 . "")
'(2 . "RAUM-ID_NEU")
'(70 . 0)
'(73 . 0)
'(74 . 0)
'(280 . 1)
)
) ;ATT Raum-ID
(entmake
(list
'(0 . "ATTDEF")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
'(10 0.081435 0.34805 0.0)
'(40 . 0.15)
'(7 . "Klinikum1")
(cons 8 "B_Raumstempel")
'(1 . "")
'(100 . "AcDbAttributeDefinition")
'(280 . 0)
'(3 . "")
'(2 . "RAUM-ID_ALT")
'(70 . 0)
'(73 . 0)
'(74 . 0)
'(280 . 1)
)
) ;ATT Raumnum.
(entmake
(list
'(0 . "ATTDEF")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 8 "B_Raumstempel")
'(10 0.081435 0.098051 0.0)
'(40 . 0.15)
'(7 . "Klinikum1")
'(1 . "")
'(100 . "AcDbAttributeDefinition")
'(280 . 0)
'(3 . "")
'(2 . "Fläche")
'(70 . 0)
'(73 . 0)
'(74 . 0)
'(280 . 1)
)
) ;ATT Fläche
(entmake
(list
'(0 . "Text")
'(10 0.89061 0.098051 0.0)
(cons 8 "B_Raumstempel")
'(1 . "m²/NGF")
'(7 . "Klinikum1")
'(40 . 0.15)
)
) ;ATT m2
(entmake
(list
(cons 0 "ENDBLK")
(cons 8 "B_Raumstempel")
)
)
)
;;;**************************************************************************
;;;**************************************************************************
;;;**************************************************************************
(defun ErrorGo (var / x y)
(setq uservar (mapcar '(lambda (x)
(list (car x) (getvar (car x)))
)
var
)
*oldError* *error*
*Error* ErrorFun
)
(mapcar '(lambda (y)
(setvar (car y)
(car (cdr y))
)
)
var
)
(command-s "_Undo" "_Mark")
)
;;;**************************************************************************
(defun ErrorFun (msg / x)
(if msg
(print msg)
)
(command-s "_undo" "_end")
(command-s "_undo" "_Back")
(mapcar '(lambda (x)
(setvar (car x) (car (cdr x)))
)
uservar
)
(setq uservar nil
*Error* *olderror*
*olderror* nil
var nil
)
)
;;;**************************************************************************
(defun errorEnd (/ x)
(command-s "_Undo" "_end")
(mapcar '(lambda (x)
(setvar (car x) (car (cdr x)))
)
uservar
)
(setq uservar nil
*error* nil
)
)
;;;**************************************************************************
;;;**************************************************************************
;;;**************************************************************************