moin,
hier mein neur code, müsste eigentlich auch bei euch laufen :
;aufruf: (fc_text zeile ep layername farbnr texthoehe textstil)
(defun fc_text (zeile ep layername farbnr texthoehe textstil /)
(entmake (list
'(0 . "TEXT")
(cons 1 zeile)
(cons 7 textstil)
(cons 8 layername)
(cons 10 ep)
(cons 40 texthoehe)
'(41 . 0.8)
(cons 62 farbnr)
))
);defun
;aufruf: (fc_rechteck ep zp layername farbnr faktor linientyp)
(defun fc_rechteck (ep zp layername farbnr faktor linientyp /)
(if (and (NULL (tblsearch "ltype" linientyp)) (/= linientyp "byblock") (/= linientyp "bylayer") (/= linientyp 0))
(command "linientyp" "laden" linientyp "acadiso.lin" "")
);if
(entmake (List
'(0 . "LWPolyline")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(90 . 4)
'(70 . 1)
(cons 6 linientyp)
(cons 8 layername)
(cons 48 faktor)
(cons 62 farbnr)
(cons 10 (trans (list (car ep) (cadr ep) 0) 1 0))
(cons 10 (trans (list (car zp) (cadr ep) 0) 1 0))
(cons 10 (trans (list (car zp) (cadr zp) 0) 1 0))
(cons 10 (trans (list (car ep) (cadr zp) 0) 1 0))
))
);defun
(defun fc_polypunkte (fcpolygon /)
(setq punktliste nil)
(foreach n fcpolygon
(if (= (car n) 10)
(progn
(setq punktliste (append punktliste (list (cdr n))))
);progn
);if
);foreach
);defun
(defun fc_text_aendern ( / n alttext neutext altpos zaehler neuelement)
(setq zaehler 0)
(foreach n (vlr-owners reactor-object)
(if (= (cdr (assoc 0 (entget (vlax-vla-object->ename n)))) "TEXT")
(progn
(princ "\nElement : ")
(setq alttext (assoc 1 (entget (vlax-vla-object->ename n))))
(princ (strcat "(" (rtos (car (nth zaehler punktliste))) "," (rtos (cadr (nth zaehler punktliste))) ")"))
(setq neutext (cons 1 (strcat "(" (rtos (car (nth zaehler punktliste))) "," (rtos (cadr (nth zaehler punktliste))) ")")))
(setq altpos (assoc 10 (entget (vlax-vla-object->ename n))))
(setq neupos (cons 10 (append (nth zaehler punktliste) (list 0.0))))
(setq neuelement (subst neutext alttext (entget (vlax-vla-object->ename n))))
(entmod neuelement)
(setq neuelement (subst neupos altpos (entget (vlax-vla-object->ename n))))
(entmod neuelement)
);progn
);if
(setq zaehler (+ zaehler 1))
);foreach
);defun
(defun fc_db_aendern (notifier-object reactor-object argslist / punktliste n)
(cond
((= (cdr (assoc 0 (entget (vlax-vla-object->ename notifier-object)))) "LWPOLYLINE")
(progn
(fc_polypunkte (entget (vlax-vla-object->ename (nth 4 (vlr-owners reactor-object)))))
(fc_text_aendern)
(princ "\nDas Rechteck wurde verändert !")
);progn
)
((= (cdr (assoc 0 (entget (vlax-vla-object->ename notifier-object)))) "TEXT")
(princ "\nDer Text wurde geändert !")
)
);cond
(princ)
);defun
(defun fc_db_zeichnen (pul por / a)
(vl-load-com)
(fc_rechteck pul por "0" 1 1.00 "continuous")
(setq meinrechteck (list (vlax-ename->vla-object (entlast))))
(fc_polypunkte (entget (entlast)))
(foreach a punktliste
(princ "\n")
(princ a)
(fc_text (strcat "(" (rtos (car a)) "," (rtos (cadr a)) ")") a "0" 2 1.8 "standard")
(setq meinrechteck (append meinrechteck (list (vlax-ename->vla-object (entlast)))))
);foreach
(setq fc_db_reaktor (vlr-object-reactor meinrechteck "fc_db_reaktor" '((:vlr-modified . fc_db_aendern))))
(vlr-pers fc_db_reaktor)
(princ "\n")
(princ meinrechteck)
(princ)
);defun
;*************
(defun c:ld ()
(fc_db_zeichnen (getpoint "ep : ") (getpoint "zp : "))
(princ)
);defun
ich bin jetzt so weit, dass die text mit den geänderten eckpunkten verschoben und aktualisiert werden. wie finde ich denn heraus, welche punkte sich verändert haben, ich will es erreichen, dass mein rechteck immer bestehen bleibt.
------------------
MfG
Frank
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP