habe eine schöne LSp im forum gefunden zu der ich einen fachmann brauche um sie
meinen bedürfnissen anzupassen, es geht um die automatische anpassung eines textes auf eine linie, vielleicht kann mir auch der autor weiterhelfen:
1.frage an welches stelle in der lsp wird der abstand des textes zur linie eingestellt (brauche Voreinstellung 5 einheiten)
2.ist es möglich die abfrage #AUSRICHTUNG# gleich auf #MITTE# einzustellen ohne tastatureingabe
wäre für hilfe dankbar
;;;Text an Linie
;;;Richtet Text an Linien oder Polyliniensegmenten aus
;;;AutoCAD-Release: 2000 (R14)
;;;Version: 2/1 - 05.03.2003
;;;Startaufruf: tal
;;;benötigte Dateien: tal.lsp
;;;Einschränkungen: nicht bekannt
;;;Programmiert: Holger Brischke
;;; CADlon - Lisp over night!
;;;
http://www.CADlon.de ;;; Tel: +49(0)681/989 06 84
;;; mobil: +49(0)175/205 88 77
;;; mailto:kontakt@CADlon.de
(defun c:tal ( / lin1 lin2 ellin1 ellin2 ellin1li ellin2li lin1typ lin2typ
ELIST ptliste1 ptliste2 num newpt lklkpt ausok plsegm minmaxpt vx)
(setvar "CMDECHO" 0)
(vl-load-com)
(command "_.undo" "_group")
(while (= T (or
(eq (car lin1)(car lin2))
(or
(= lin1 nil)
(= lin2 nil)
)
)
)
(setq lin1 nil
lin2 nil)
(while (= lin1 nil)
(setq lin1 (nentsel "\nText wählen"))
(if (= nil (or
(= lin1 nil)
(= "TEXT" (cdr (assoc 0 (entget(car lin1)))))
)
)
(progn (setq lin1 nil)(princ "\nKein Text gewählt!"))
)
)
(redraw (car lin1) 3)
(entmod (subst (cons 50 0.0)
(assoc 50 (entget (car lin1)))
(entget (car lin1))
)
)
(setvar "UCSICON" 0)
(command "_UCS" "_N" "_OB" (car lin1))
(setq minmaxpt ;(getboundingbox (car lin1)))
(mapcar '(lambda (P)
(car(trans P 0 1))
)
(getboundingbox (car lin1))
)
vx (/ (- (cadr minmaxpt) (car minmaxpt)) 2.0)
)
(command "_UCS" "_W")
(setvar "UCSICON" 1)
(while (= lin2 nil)
(setq lin2 (nentsel "\nLinie wählen"))
(if (= nil (or
(= lin2 nil)
(= "LINE" (cdr (assoc 0 (entget(car lin2)))))
(= "LWPOLYLINE" (cdr (assoc 0 (entget(car lin2)))))
(= "POLYLINE" (cdr (assoc 0 (entget(cdr (assoc 330 (entget(car lin2))))))))
)
)
(progn (setq lin2 nil)(princ "\nKeine Linie/Polyline gewählt!"))
)
)
(redraw (car lin2) 3)
);while
(redraw (car lin1) 4)
(redraw (car lin2) 4)
(setq ellin1 (car lin1)
ellin2 (car lin2))
(if (= nil (or (= (cdr (assoc 0 (entget (car lin2)))) "LINE")(= (cdr (assoc 0 (entget (car lin2)))) "LWPOLYLINE")))
(setq lin2typ (cdr (assoc 0 (entget(cdr (assoc 330 (entget(car lin2)))))))
ellin2 (cdr (assoc 330 (entget(car lin2)))))
)
(setq ellin1li (entget ellin1)
ellin2li (entget ellin2)
lklkpt (cadr lin2)
lin1typ (cdr (assoc 0 ellin1li))
lin2typ (cdr (assoc 0 ellin2li)))
(arxload "geomcal.arx" (princ "."))
(if (= lin1typ "TEXT")
(setq ptliste1 (textpt ellin1li))
)
(cond
((= lin2typ "POLYLINE")
(setq po1na (entnext ellin2)
poldat (entget po1na)
POTYP (cdr (assoc 0 POLDAT)))
(while (= POTYP "VERTEX")
(setq z2 0
pt (cdr (assoc 10 POLDAT))
po1na (entnext po1na)
poldat (entget po1na)
POTYP (cdr (assoc 0 POLDAT)))
(if ptliste2
(setq ptliste2 (append ptliste2 (list pt)))
(setq ptliste2 (list pt))
)
);while
(setq plsegm (searchplsegment ptliste2 lklkpt)
ptliste2 plsegm)
)
((= lin2typ "LWPOLYLINE")
(setq ELIST (entget ellin2)
ptliste2 (apply
'append
(mapcar
'(lambda (X)
(if (= 10 (car X))
(list (cdr X))
) ;_ end of if
) ;_ end of lambda
ELIST
) ;_ end of mapcar
) ;_ end of apply
) ;_ end of setq
(setq plsegm (searchplsegment ptliste2 lklkpt)
ptliste2 plsegm)
)
((= lin2typ "LINE")
(setq ptliste2 (nth 0 (linept ellin2li)))
)
);cond
(setq ausok (doausr ptliste2 T))
(if (= ausok nil)(setq ausok "J")(setq ausok (strcase ausok)))
(cond
((= ausok "NEIN")
(doausr (reverse ptliste2) nil)
)
((= ausok "MITTE")
(doausrm ptliste2 vx nil)
)
)
(setq numa 0.0)
(while (/= numa "Ja")
(initget 2 "Ja")
(setq num (getreal "Abstand oder ok? Ja/<J>: "))
(if (or (= num nil)(= num "Ja"))
(setq num 0.0
numa "Ja")
(progn
(setq newpt (polar (cdr (assoc 10 ellin1li)) (+ (/ pi 2) (cdr (assoc 50 ellin1li))) num)
ellin1li (subst (cons 10 newpt)(assoc 10 ellin1li) ellin1li))
(entmod ellin1li)
)
)
)
(command "_.undo" "_end")
(prin1)
)
(defun getboundingbox (ent1 / minpt maxpt)
(vl-load-com)
(vlax-invoke-method
(vlax-ename->vla-object ent1)
'GetBoundingBox
'minpt
'maxpt
)
(list (vlax-safearray->list minpt) (vlax-safearray->list maxpt))
)
(defun doausr (ptliste abf / erg plsegwi)
(setq plsegwi (angle (car ptliste) (cadr ptliste))
ellin1li (subst (cons 50 plsegwi)(assoc 50 ellin1li) ellin1li)
ellin1li (subst (cons 72 0)(assoc 72 ellin1li) ellin1li)
ellin1li (subst (cons 73 0)(assoc 73 ellin1li) ellin1li)
ellin1li (subst (cons 11 (list 0.0 0.0 0.0))(assoc 11 ellin1li) ellin1li))
(if abf
(progn
(setq ellin1li (subst (cons 10 (car ptliste2))(assoc 10 ellin1li) ellin1li))
(entmod ellin1li)
(initget "Ja Nein Mitte")
(setq erg (getkword "\nAusrichtung ok Ja/Nein/Mitte <M>"))
)
(progn
(setq ellin1li (subst (cons 10 (cadr ptliste2))(assoc 10 ellin1li) ellin1li))
(entmod ellin1li)
)
)
erg
)
(defun doausrm (ptliste xv abf / erg plsegwi)
(setq plsegwi (angle (car ptliste) (cadr ptliste))
npt10 (polar(mapcar '(lambda (P)
(/ P 2.0)
)
(mapcar '(lambda (P1 P2)
(+ P1 P2)
)
(car ptliste) (cadr ptliste)
)
)
plsegwi
(* -1.0 xv)
)
ellin1li (subst (cons 50 plsegwi)(assoc 50 ellin1li) ellin1li)
ellin1li (subst (cons 72 0)(assoc 72 ellin1li) ellin1li)
ellin1li (subst (cons 73 0)(assoc 73 ellin1li) ellin1li)
ellin1li (subst (cons 11 (list 0.0 0.0 0.0))(assoc 11 ellin1li) ellin1li)
;npt10
)
(if abf
(progn
(setq ellin1li (subst (cons 10 (car ptliste2))(assoc 10 ellin1li) ellin1li))
(entmod ellin1li)
(initget "Ja Nein Mitte")
(setq erg (getkword "\nAusrichtung ok Ja/Nein/Mitte <J>"))
)
(progn
(setq ellin1li (subst (cons 10 npt10;|(cadr ptliste2)|
(assoc 10 ellin1li) ellin1li))
(entmod ellin1li)
)
)
erg
)
;;;
;;;
;;;-SUB--SUB--SUB--SUB--SUB--SUB--SUB--SUB-
;;;
;;;
(defun searchplsegment (ptli klkpt / za pt1 pt2 aept)
(setq za 0)
(repeat (1- (length ptli))
(setq pt1 (nth za ptli)
pt2 (nth (1+ za) ptli)
za (1+ za))
(if (klksegmentepr pt1 pt2 klkpt)
(setq aept (list pt1 pt2))
)
)
aept
)
;;;
;;;
;;;-SUB--SUB--SUB--SUB--SUB--SUB--SUB--SUB-
;;;
;;;
(defun linept (elliste / apt ept ugliste)
(setq apt (cdr (assoc 10 elliste))
ept (cdr (assoc 11 elliste))
ugliste (list (list apt ept)))
ugliste
)
;;;
;;;
;;;-SUB--SUB--SUB--SUB--SUB--SUB--SUB--SUB-
;;;
;;;
(defun textpt (elliste / apt ept wpt ugliste)
(setq apt (cdr (assoc 10 elliste))
ept (cdr (assoc 40 elliste))
wpt (cdr (assoc 50 elliste))
ugliste (list (list apt ept wpt)))
ugliste
)
;;;
;;;
;;;-SUB--SUB--SUB--SUB--SUB--SUB--SUB--SUB-
;;;
;;;
(defun klksegmentepr (ap1 ep1 ap2 / rtg rv1 rv2 rv3)
(setq rv1 (cal "vec1(ap1,ap2)");Richtungsvector bestimmen
rv2 (cal "vec1(ap2,ep1)")
rv3 (cal "vec1(ap1,ep1)"))
(if (= T (and
(equal rv1 rv2 0.5)
(equal rv1 rv3 0.5)
(equal rv2 rv3 0.5)
)
)
(setq rtg T)
(setq rtg nil)
)
rtg
)
;;;
;;;--------------------------------------------------ENDE---------------------------------------------------
;;;
;;;
;(princ"\nCADlon - Lisp over night!")
;(princ"\nhttp://www.CADlon.de")
;(princ "\nTal.lsp geladen. ==>Start mit: tal")
;(princ)
------------------
Gruß vom Bauvermesser;
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP
Foren auf CAD.de (alle Foren)
| 
CADwiesel
