Wklejam poniżej wspomniany listing, być może ktoś potrafi mi pomóc.
Pozdrawiam - Sławek Jagiełło
(defun c:klotoida(/ P1 P2 P3 alfa tglfa l1 l2 r a1 a2 tau1 tau2 wsp temp
x y xs1 xs2 h1 h2 t1 t2 pkp1 pkp2 pl kl)
(defun kl:err (IT)
(princ (strcat "\nWystąpił błąd " IT "\n"))
(setq IT nil)
(command "_undo" "_e")
(if UCS (command "_ucs" "_p"))
(grclear)
(if OLDERR (setq *error* OLDERR))
(if OS (setvar "OSMODE" OS))
(if CM (setvar "CMDECHO" CM))
(princ)
);end kl:err
(defun punkty ()
(setq P1 (getpoint "\nPodaj dowolny punkt na stycznej wejściowej:")
P2 (getpoint P1 "\nPodaj punkt wierzchołkowy:"))
(grdraw P1 P2 1)
(setq P3 (getpoint P2 "\nPodaj dowolny punkt na stycznej wyjściowej:")
GUMA ( (angle P2 P3) (angle P1 P2))
ALFA (abs ( (angle P2 P3) (angle P1 P2))))
(grdraw P2 P3 1)
(if (> ALFA pi) (setq ALFA ( (* 2 pi) ALFA)))
(setq TGALFA (/ (sin (/ ALFA 2.0)) (cos (/ ALFA 2.0))))
);end punkty
(defun dane ()
(initget 5)
(setq L1 (getreal "\nPodaj długość klotoidy wejściowej:"))
(initget 5)
(setq L2 (getreal "\nPodaj długość klotoidy wyjściowej:"))
(initget 3)
(setq R (getreal "\nPodaj promień łuku kołowego:"))
(setq A1 (sqrt (* L1 (abs R)))
A2 (sqrt (* L2 (abs R)))
TAU1 (/ l1 (* 2 (abs R)))
TAU2 (/ l2 (* 2 (abs R))))
);end dane
(defun sprawdzenie ()
(if (or (= ( (angle P3 P2) (angle P1 P2)) 0)
(= (abs ( (angle P3 P2) (angle P1 P2))) pi)
(> (+ TAU1 TAU2) ALFA))
(princ "\nKlotoida niemożliwa do wytyczenia!")
(rysuj)
);end if
);end sprawdzenie
(defun obl_pkt (L A)
(setq X (+ L
( (/ (expt L 5) (* 40 (expt A 4))))
(/ (expt L 9) (* 3456 (expt A 8)))
( (/ (expt L 13) (* 599040 (expt A 12))))
)
Y (+ (/ (expt L 3) (* 6 A A))
( (/ (expt L 7) (* 336 (expt A 6))))
(/ (expt L 11) (* 42240 (expt A 10)))
( (/ (expt L 15) (* 9676800 (expt A 14))))
)
)
);end obl_pkt
(defun obl_hxs (Y X TAU)
(setq H ( Y (* (abs R) ( 1 (cos TAU))))
XS ( X (* (abs R) (sin TAU)))
)
);end obl_hxs
(defun obl_t (XS ST)
(setq T (+ XS (* (+ (abs R) (/ (+ H1 H2) 2)) TGALFA)
(* ST (/ ( H1 H2) (* 2 TGALFA)))))
);end obl_t
(defun klotoida (A L PKT1 PKT2 ZAM / LICZNIK LISTA PKT TEMP)
(setq LICZNIK 0.0 LISTA nil TEMP "T")
(command "_ucs" "_3" PKT1 P2 PKT2)
(setq UCS "T")
(while (>= L LICZNIK)
(obl_pkt LICZNIK A)
(if (not (minusp R)) (setq PKT (list X Y)) (setq PKT (list ( X) Y)))
(setq LISTA (append LISTA (list PKT)))
(setq LICZNIK (1+ LICZNIK))
(if (and TEMP (> LICZNIK L)) (setq LICZNIK L TEMP nil))
)
(command "_pline" (foreach PKT LISTA (command PKT)))
(if ZAM (setq PL (trans (last LISTA) 1 0)))
(if (not ZAM) (setq KL (trans (last LISTA) 1 0)))
(if UCS (command "_ucs" "_p"))
(setq UCS nil)
);koniec klotoida
(defun łuk (A B)
(command "_arc" (trans A 1 0) "_E" (trans B 1 0) "_R" R)
);end łuk
(defun rysuj (/ TEMP1 TEMP2)
(if (or (< ( (angle P2 P3) (angle P1 P2)) ( pi))
(and (> ( (angle P2 P3) (angle P1 P2)) 0)
(< ( (angle P2 P3) (angle P1 P2)) pi)))
(setq WSP "T")
(setq WSP nil)
)
(if (not (zerop L1))
(progn
(obl_pkt L1 A1)
(obl_hxs Y X TAU1)
(setq H1 H XS1 XS)
)
)
(if (not (zerop L2))
(progn
(obl_pkt L2 A2)
(obl_hxs Y X TAU2)
(setq H2 H XS2 XS)
)
)
(setq T1 (obl_t XS1 -1.0)
T2 (obl_t XS2 1.0))
(if (minusp R)
(progn
(setq T1 ( T1 (* 2 XS1))
T2 ( T2 (* 2 XS2)))
)
)
(setq PKP1 (polar P2 (angle P1 P2) ( T1))
PKP2 (polar P2 (angle P3 P2) ( T2)))
(if WSP
(setq KL (trans PKP2 1 0) PL (trans PKP1 1 0))
(setq KL (trans PKP1 1 0) PL (trans PKP2 1 0))
)
(if (not (zerop L1)) (klotoida A1 L1 PKP1 PKP2 WSP))
(if (not (zerop L2)) (klotoida A2 L2 PKP2 PKP1 (not WSP)))
(command "_ucs" "_w")
(setq UCS "T")
(if (not (minusp R)) (łuk PL KL) (łuk KL PL))
(command "_ucs" "_p")
(setq UCS nil)
);end rysuj
(setq OLDERR *error* *error* kl:error WSP nil UCS nil)
(setq XS1 0.0 XS2 0.0 H1 0.0 H2 0.0)
(setq CM (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(command "_undo" "_be")
(punkty)
(setq OS (getvar "OSMODE"))
(setvar "OSMODE" 0)
(dane)
(sprawdzenie)
(command "_undo" "_e")
(redraw)
(if OLDERR (setq *error* OLDERR))
(if OS (setvar "OSMODE" OS))
(if CM (setvar "CMDECHO" CM))
(princ)
);end file
(princ "\nWczytano polecenie KLOTOIDA")
(princ)
-----
Wysłano za pośrednictwem WWW.CAD.PL (http://www.cad.pl)
Nowe kursy: AutoCAD cz. II i Inventor: http://www.cad.pl/kursy
...?... to nalezy wyplnic... skontaktuj sie z autorem
Darek