77 lines
3.2 KiB
Common Lisp
77 lines
3.2 KiB
Common Lisp
;............................................................
|
|
;: DATE : 91-01-01 Kunde: :
|
|
;: Schuetz/Schmidt AutoCAD-Version 11 :
|
|
;: Version 1.0 ab Version 2.6 :
|
|
;: :
|
|
;: LEXT.LSP Verl. oder verk�rzt Linien :
|
|
;:..........................................................:
|
|
;
|
|
;Deklaration:
|
|
; elem Element mit Anpickpunkt List
|
|
; elin Elementname Str
|
|
; verl Verl„ngerung Real
|
|
; elpt Anpickpunkt List
|
|
; lip1 Linienanfangspunkt List
|
|
; lip2 Linienendpunkt List
|
|
; Wech Wahr, wenn Linie gedreht Boole
|
|
; lipt tempor„rer Linienpt. List
|
|
; linp neuer Endpunkt List
|
|
;
|
|
(DEFUN vlre (/ elpt lip1 lip2 wech lipt linp) ;Unterprog Linie verl.
|
|
(SETQ elpt (CADR elem)
|
|
;Anpickpunkt extrahieren
|
|
lip1 (CDR (ASSOC 10 elin))
|
|
;Punkt 1 speichern
|
|
lip2 (CDR (ASSOC 11 elin))
|
|
;Punkt 2 speichern
|
|
)
|
|
(IF (< (DISTANCE elpt lip1)(DISTANCE elpt lip2))
|
|
;wenn Abstand Anpickpunkt zu P1
|
|
;kleiner als Anpickpunkt zu P2
|
|
(SETQ lipt lip1
|
|
lip1 lip2
|
|
lip2 lipt
|
|
wech T
|
|
)
|
|
;Linie drehen, dies ist notwendig, da
|
|
;danach Linie von P1 nach neuem Pt
|
|
)
|
|
(SETQ linp (POLAR lip1 (ANGLE lip1 lip2)
|
|
(+ (DISTANCE lip1 lip2) verl))
|
|
;L„nge der neuen Linie speichern
|
|
elin (IF wech
|
|
;wenn gewechselt wurde
|
|
(SUBST (CONS 10 linp)(ASSOC 10 elin) elin)
|
|
;dann Anfangspunkt wechseln
|
|
(SUBST (CONS 11 linp)(ASSOC 11 elin) elin)
|
|
;sonst Endpunkt wechseln
|
|
)
|
|
)
|
|
(ENTMOD elin)
|
|
;auf Datenbank zur�ckschreiben
|
|
)
|
|
|
|
(DEFUN C:lext (/ elem elin verl) ;Hauptprog. Linie verl.
|
|
(SETQ elem (ENTSEL "Linie an der zu verlaengernden Seite waehlen: "))
|
|
;Element w„hlen
|
|
(IF elem
|
|
;wenn Element gew„hlt
|
|
(IF (= (CDR (ASSOC 0 (SETQ elin (ENTGET (CAR elem))))) "LINE")
|
|
;dann, wenn Element eine Linie
|
|
(IF (SETQ verl (GETREAL "\nVerlaengerung: "))
|
|
;dann, Verl„ngerung abfragen, wenn Verl.
|
|
(vlre)
|
|
;dann Rechenprogramm aufrufen
|
|
(PRINC "*Abbruch*\n")
|
|
;sonst Abbruchmeldung
|
|
)
|
|
(PROMPT "\nElement ist keine Linie! ")
|
|
;sonst Meldung, Element ist keine Linie
|
|
)
|
|
(PROMPT "Kein Element gewaehlt! ")
|
|
;sonst Meldung, kein Element gew„hlt
|
|
)
|
|
(PRINC)
|
|
;unterdr�cken der R�ckgabe
|
|
)
|
|
|