469 lines
15 KiB
Plaintext
469 lines
15 KiB
Plaintext
;............................................................
|
|
;: DATE : 92-01-01 Kunde: tewi :
|
|
;: Autor: Schmidt AutoCAD-Version 11 :
|
|
;: Version 1.5 ab Version 10 mit anpassen :
|
|
;: :
|
|
;: KONST.LSP Konstruktionslinien :
|
|
;:..........................................................:
|
|
|
|
(SPECIAL '(oofs spal))
|
|
|
|
(DEFUN xtan (win dist) ;gibt L„nge der Ankat mit Win. und Gegegkat
|
|
(IF (= win 0)
|
|
(SETQ win PI)
|
|
)
|
|
(/ dist (/ (SIN win)(COS win)))
|
|
)
|
|
|
|
(DEFUN basl (bast / esel ctyt) ;Basislinien-Dialog
|
|
(SETQ ctyt ctype
|
|
ctype 0
|
|
)
|
|
(IF (SETQ esel (ENTSEL (STRCAT "\nW„hlen Sie die " bast "Basislinie: ")))
|
|
(IF (= "LINE" (CDR (ASSOC '0 (SETQ elsl (ENTGET (NTH 0 esel))))))
|
|
(PROGN
|
|
(SETQ punkt (OSNAP (NTH 1 esel) "_NEA")
|
|
angl (ANGLE (TRANS (CDR (ASSOC '10 elsl)) 0 1)
|
|
(TRANS (CDR (ASSOC '11 elsl)) 0 1)
|
|
)
|
|
ctype ctyt
|
|
)
|
|
(IF (OR (OR (EQUAL angl 0.0 0.00000000001)
|
|
(EQUAL (- angl PI) 0.0 0.00000000001)
|
|
)
|
|
(EQUAL (- angl PI PI) 0.0 0.00000000001)
|
|
)
|
|
(SETQ angl 0.0)
|
|
)
|
|
)
|
|
(emsg "kein g�ltiges Objekt gefunden!")
|
|
)
|
|
(emsg "kein Objekt gefunden!")
|
|
)
|
|
)
|
|
|
|
(DEFUN punk () ;Punkt-Dialog
|
|
(IF (NULL (SETQ punkt (GETPOINT "\nPunkt eingeben: ")))
|
|
(PROGN
|
|
(emsg "kein g�ltiger Punkt!")
|
|
(SETQ ctype 0)
|
|
)
|
|
)
|
|
)
|
|
|
|
(DEFUN wink () ;Winkel-Dialog
|
|
(IF (NULL (SETQ angl (GETANGLE "\nWinkel eingeben: ")))
|
|
(PROGN
|
|
(emsg "kein g�ltiger Winkel ")
|
|
(SETQ ctype 0)
|
|
)
|
|
)
|
|
)
|
|
|
|
(DEFUN vers (vset) ;Versatz-Dialog
|
|
(IF vset
|
|
(PROGN
|
|
(IF (NULL oofs) (SETQ oofs 0))
|
|
(IF (NULL (SETQ eofs (GETDIST (STRCAT "\nVersatz eingeben <" (RTOS oofs)">: "))))
|
|
(SETQ eofs oofs)
|
|
)
|
|
(IF (/= eofs 0)
|
|
(PROGN
|
|
(SETQ anpt (GETPOINT "\nSeite des positiven Versatzes: "))
|
|
(IF anpt
|
|
(SETQ anse (ANGLE punkt anpt))
|
|
(PROGN
|
|
(emsg "ung�ltige Eingabe!")
|
|
(SETQ ctype 0)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(SETQ anba (IF (> angl PI)(- angl PI)(EVAL angl))
|
|
oofs eofs
|
|
)
|
|
)
|
|
)
|
|
(IF (> ctype 0)
|
|
(IF (OR (< anse anba)(> anse (+ anba PI)))
|
|
(SETQ punkt (POLAR punkt (+ anba (* 3 (/ PI 2))) eofs))
|
|
(SETQ punkt (POLAR punkt (+ anba (/ PI 2)) eofs))
|
|
)
|
|
)
|
|
)
|
|
|
|
|
|
(DEFUN rech (/ andi angd ptdi pttp lauf lip1 lip2 scnp) ;Berechnen
|
|
(IF (>= angl PI)
|
|
(SETQ angl (- angl PI))
|
|
)
|
|
(IF (OR (EQUAL angl 0.0 0.00000000001)
|
|
(EQUAL (- angl PI) 0.0 0.00000000001)
|
|
)
|
|
(SETQ angl 0.0)
|
|
)
|
|
(SETQ g:l5 g:l1
|
|
andi (IF (> angl (/ PI 2))(QUOTE 1)(QUOTE 0))
|
|
angd (IF (= andi 1)(- PI angl) angl)
|
|
ptdi (IF (= andi 1)(* -1 (xtan angd 100))(xtan angd 100))
|
|
pttp (MAPCAR '+ punkt (APPEND (if (= angl 0) '(100 0)(LIST ptdi 100)) '(0)))
|
|
lip1 (INTERS g:l1 g:l2 punkt pttp NIL)
|
|
lip2 (INTERS g:l3 g:l4 punkt pttp NIL)
|
|
lauf 1
|
|
g:s1 NIL
|
|
g:s2 NIL
|
|
scnp "g:s1"
|
|
)
|
|
(IF (NULL lip1)
|
|
(SETQ lip1 (INTERS g:l2 g:l3 punkt pttp NIL)
|
|
lip2 (INTERS g:l4 g:l1 punkt pttp NIL)
|
|
)
|
|
)
|
|
(IF (AND lip1 lip2) ;2D
|
|
(PROGN
|
|
(WHILE (AND (< lauf 5)(NULL g:s2))
|
|
(SET (READ scnp) (INTERS lip1 lip2
|
|
(EVAL (READ (STRCAT "g:l" (ITOA lauf))))
|
|
(EVAL (READ (STRCAT "g:l" (ITOA (setq lauf (1+ lauf))))))
|
|
)
|
|
)
|
|
(IF (AND (= scnp "g:s1") g:s1)
|
|
(SETQ scnp "g:s2")
|
|
)
|
|
)
|
|
(IF (NULL g:s2)
|
|
(PROGN
|
|
(emsg "Linie ausserhalb Limiten!")
|
|
(SETQ ctype 0)
|
|
)
|
|
)
|
|
)
|
|
(PROGN
|
|
(emsg "Linie liegt im Raum!")
|
|
(SETQ ctype 0)
|
|
)
|
|
)
|
|
)
|
|
|
|
(DEFUN lmake (cli1 cli2) ;Linie erzeugen
|
|
(IF (AND cli1 cli2)
|
|
(ENTMAKE (LIST (CONS 0 "LINE")
|
|
(CONS 8 CO%%)
|
|
(CONS 10 (TRANS cli1 1 0))
|
|
(CONS 11 (TRANS cli2 1 0))
|
|
)
|
|
)
|
|
(PROGN
|
|
(PRINC "keine Konstruktionslinie m”glich!")
|
|
(SETQ ctype 0)
|
|
)
|
|
)
|
|
)
|
|
|
|
(DEFUN whalb (/ isec ang1 ang2) ;Winkelhalbierende
|
|
(SETQ isec (APPEND (LIST (TRANS
|
|
(CDR (ASSOC '10 elsl)) 0 1))
|
|
(LIST (TRANS (CDR (ASSOC '11
|
|
elsl)) 0 1))
|
|
)
|
|
ang1 angl
|
|
)
|
|
(basl "zweite ")
|
|
(SETQ isec (APPEND isec (LIST (TRANS
|
|
(CDR (ASSOC '10 elsl)) 0 1))
|
|
(LIST (TRANS (CDR (ASSOC '11
|
|
elsl)) 0 1))
|
|
)
|
|
ang2 angl
|
|
punkt (INTERS (NTH 0 isec)
|
|
(NTH 1 isec)
|
|
(NTH 2 isec)
|
|
(NTH 3 isec) NIL
|
|
)
|
|
angl (+ ang1 (/ (- ang2 ang1) 2))
|
|
)
|
|
(IF punkt
|
|
(PROGN
|
|
(rech)
|
|
(lmake g:s1 g:s2)
|
|
(SETQ angl (+ angl (/ PI 2)))
|
|
)
|
|
(SETQ ctype 0)
|
|
)
|
|
)
|
|
|
|
(DEFUN mulip (/ anba pbas anzv eofs) ;Mehrfach Versatz
|
|
(GRAPHSCR)
|
|
(basl "")
|
|
(SETQ pbas punkt)
|
|
(IF (> ctype 7)
|
|
(PROGN
|
|
(vers T)
|
|
(COND
|
|
((= ctype 8)
|
|
(IF (/= eofs 0)
|
|
(SETQ anzv (GETINT "\nWie viele Linien: "))
|
|
(SETQ anzv 1)
|
|
)
|
|
(IF anzv
|
|
(REPEAT anzv
|
|
(IF (> ctype 7)
|
|
(PROGN
|
|
(rech)
|
|
(IF (> ctype 7)
|
|
(PROGN
|
|
(lmake g:s1 g:s2)
|
|
(vers NIL)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(emsg "Abbruch des Programmes!")
|
|
)
|
|
)
|
|
((= ctype 9)
|
|
(WHILE (> ctype 7)
|
|
(rech)
|
|
(IF (> ctype 7)
|
|
(PROGN
|
|
(lmake g:s1 g:s2)
|
|
(IF (> ctype 7)
|
|
(PROGN
|
|
(IF (SETQ eofs (GETDIST pbas
|
|
"\nVersatz eingeben: "))
|
|
(PROGN
|
|
(SETQ punkt pbas
|
|
oofs eofs
|
|
)
|
|
(vers NIL)
|
|
)
|
|
(SETQ ctype 0)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(DEFUN redi (/ grpu sepu) ;Risserg„nzungs-Dialog
|
|
(SETQ ctype 0)
|
|
(IF (SETQ grpu (GETPOINT "\nPunkt im Grundriss: "))
|
|
(IF (SETQ sepu (GETPOINT "\nPunkt im Seitenriss: "))
|
|
(IF (NOT (OR (MINUSP (CAR (SETQ tofs (MAPCAR '- sepu grpu))))
|
|
(MINUSP (CADR tofs))
|
|
)
|
|
)
|
|
(IF (SETQ punkt (INTERS grpu (MAPCAR '+ grpu '(10 0 0))
|
|
sepu (MAPCAR '+ sepu '(0 10 0)) NIL
|
|
)
|
|
)
|
|
(PROGN
|
|
(SETQ angl (* 3 (/ PI 4)))
|
|
(rech)
|
|
(SETQ spal (LIST g:s1 g:s2 g:l1 g:l3)
|
|
ctype 10
|
|
)
|
|
)
|
|
(emsg "kein Schnittpunkt zwischen bezeichneten Punkten! ")
|
|
)
|
|
(emsg "Punkte falsch bezeichnet! ")
|
|
)
|
|
(emsg "kein Punkt bezeichnet! ")
|
|
)
|
|
(emsg "kein Punkt bezeichnet! ")
|
|
)
|
|
)
|
|
|
|
(DEFUN rier (/ spap rip1 rip2 stpt enpt hori lpen) ;Rissergaenzung
|
|
(INITGET 1 "Ja Nein Nein")
|
|
(IF (AND spal (AND (EQUAL (NTH 2 spal) g:l1)(EQUAL (NTH 3 spal) g:l3)))
|
|
(IF (= (GETKWORD "\nNeue Spiegelachse definieren? <N>: ") "Ja")
|
|
(redi)
|
|
)
|
|
(redi)
|
|
)
|
|
(WHILE (> ctype 0)
|
|
(IF (SETQ rip1 (GETPOINT "\nPunkt bezeichnen: "))
|
|
(PROGN
|
|
(IF (EQUAL (ANGLE (NTH 0 spal)(NTH 1 spal))
|
|
(/ (* PI 3) 4) 0.0000001)
|
|
(SETQ stpt 0
|
|
enpt 1
|
|
)
|
|
(SETQ stpt 1
|
|
enpt 0
|
|
)
|
|
)
|
|
(IF (MINUSP (- (ANGLE (NTH stpt spal)(NTH enpt spal))
|
|
(ANGLE (NTH stpt spal) rip1)
|
|
)
|
|
)
|
|
(SETQ angl 0.0
|
|
hori T
|
|
)
|
|
(SETQ angl (/ (* PI 3) 2)
|
|
hori NIL
|
|
)
|
|
)
|
|
(SETQ punkt rip1)
|
|
(rech)
|
|
(IF (> ctype 0)
|
|
(IF (SETQ spap (INTERS (NTH 0 spal)(NTH 1 spal) g:s1 g:s2))
|
|
(PROGN
|
|
(IF hori
|
|
(SETQ angl (/ PI 2))
|
|
(SETQ angl 0.0)
|
|
)
|
|
(SETQ punkt spap)
|
|
(rech)
|
|
(IF (> ctype 0)
|
|
(PROGN
|
|
(lmake rip1 spap)
|
|
(IF hori
|
|
(IF (EQUAL (ANGLE spap g:s1)
|
|
(/ PI 2) 0.0000001)
|
|
(SETQ lpen g:s1)
|
|
(SETQ lpen g:s2)
|
|
)
|
|
(IF (EQUAL (ANGLE spap g:s1) PI 0.0000001)
|
|
(SETQ lpen g:s1)
|
|
(SETQ lpen g:s2)
|
|
)
|
|
)
|
|
(lmake spap lpen)
|
|
)
|
|
(emsg "Spiegelachse wird nicht geschnitten!")
|
|
)
|
|
)
|
|
(emsg "Spiegelachse wird nicht geschnitten!")
|
|
)
|
|
)
|
|
)
|
|
(SETQ ctype 0)
|
|
)
|
|
)
|
|
)
|
|
|
|
(DEFUN eaconst (cosw / xlay) ;Ein/Aus-Schalten
|
|
(IF (SETQ xlay (TBLSEARCH "LAYER" CO%%))
|
|
(IF (OR (= (CDR (ASSOC '70 xlay)) 65)(MINUSP (CDR (ASSOC '62 xlay))))
|
|
(COMMAND "_LAYER" "_T" CO%% "_on" CO%% "")
|
|
(IF cosw
|
|
(COMMAND "_LAYER" "_off" CO%% "")
|
|
)
|
|
)
|
|
(COMMAND "_LAYER" "_N" CO%% "_color" RO%% CO%% "")
|
|
)
|
|
)
|
|
|
|
(DEFUN delcon (/ count edel) ;Konstlin. L”schen
|
|
(IF (ques "Wollen Sie alle Konstruktionslinien l”schen?" NIL)
|
|
(PROGN
|
|
(PRINC "\nBitte warten")
|
|
(SETQ edel (SSGET "X" (LIST (CONS '8 CO%%)))
|
|
count 0
|
|
)
|
|
(IF edel
|
|
(REPEAT (SSLENGTH edel)
|
|
(ENTDEL (SSNAME edel count))
|
|
(SETQ count (1+ count))
|
|
(PRINC ".")
|
|
)
|
|
)
|
|
(REDRAW)
|
|
)
|
|
)
|
|
)
|
|
|
|
(DEFUN const (ctype / g:l1 g:l2 g:l3 g:l4 punkt angl g:s1 g:s2 eofs anse elsl)
|
|
(pstart "Konstruktionslinien" "" NIL)
|
|
(SETQ g:l1 (GETVAR "limmin")
|
|
g:l3 (GETVAR "limmax")
|
|
g:l2 (TRANS (LIST (car g:l3)(cadr g:l1)) 0 1)
|
|
g:l4 (TRANS (LIST (car g:l1)(cadr g:l3)) 0 1)
|
|
g:l1 (TRANS g:l1 0 1)
|
|
g:l3 (TRANS g:l3 0 1)
|
|
co%% "CONST"
|
|
ro%% "8"
|
|
)
|
|
(IF (/= ctype 11)
|
|
(eaconst NIL)
|
|
)
|
|
(IF (AND (> ctype 0) (< ctype 13))
|
|
(COND
|
|
((< ctype 8)
|
|
(PROGN
|
|
(GRAPHSCR)
|
|
(IF (> ctype 4)
|
|
(basl "")
|
|
(punk)
|
|
)
|
|
(IF (< ctype 3)
|
|
(IF (= ctype 1)
|
|
(SETQ angl 0.0)
|
|
(SETQ angl (/ PI 2))
|
|
)
|
|
)
|
|
(IF (AND (> ctype 2)(< ctype 5))
|
|
(wink)
|
|
)
|
|
(IF (OR (> ctype 6)(= ctype 4))
|
|
(vers T)
|
|
)
|
|
(IF (= ctype 5)
|
|
(PROGN
|
|
(punk)
|
|
(IF (> ctype 0)
|
|
(PROGN
|
|
(IF (SETQ atmp (GETANGLE
|
|
"\nWinkel zur Basislinie eingeben <90>: "))
|
|
(SETQ angl (+ angl atmp))
|
|
(SETQ angl (+ angl (/ PI 2)))
|
|
)
|
|
)
|
|
)
|
|
(WHILE (> angl PI)
|
|
(SETQ angl (- angl PI))
|
|
)
|
|
)
|
|
)
|
|
(IF (= ctype 6) (whalb))
|
|
(IF (> ctype 0)
|
|
(rech)
|
|
)
|
|
(IF (> ctype 0)
|
|
(lmake g:s1 g:s2)
|
|
)
|
|
)
|
|
)
|
|
((OR (= ctype 8)(= ctype 9)) (mulip))
|
|
((= ctype 10)(rier))
|
|
((= ctype 11)(eaconst T))
|
|
((= ctype 12)(delcon))
|
|
)
|
|
)
|
|
(pend)
|
|
)
|
|
|
|
(DEFUN c:khoriz () (const 1))
|
|
(DEFUN c:kverti () (const 2))
|
|
(DEFUN c:kschr () (const 3))
|
|
(DEFUN c:kschrv () (const 4))
|
|
(DEFUN c:keschr () (const 5))
|
|
(DEFUN c:kwhalb () (const 6))
|
|
(DEFUN c:kvers () (const 7))
|
|
(DEFUN c:kversr () (const 8))
|
|
(DEFUN c:kversu () (const 9))
|
|
(DEFUN c:krisserg () (const 10))
|
|
(DEFUN c:kea () (const 11))
|
|
(DEFUN c:kdel () (const 12))
|
|
(DEFUN c:konst () (PRINC "\nKonstruktionslinien geladen"))
|
|
(c:konst)
|
|
(PRINC)
|
|
|