;------------- POČETAK - PODNAPUTBINA ZA STORIT ZAPRTE MNOGOKUTE NA RAČUN
CRTA ----------------------------------------------
;OVUSTU RADNJU J STORIL DANE UZ POMOĆ SVEMOGUĆEGA I MILOSRDNEGA BOGA
;podanputbinu pozovi kano (mnogokuti_od_crta niz_crta)), gdje je niz_crta
razlog
;dobivamo niz mnogokuta od najmanje površine prema najvećoj koje još imaju
uz sebe upisane i površine mnogokuta, a ako neke crte ne zatvaraju mnogokut,
;uz njih nam stavi napomenu da se radi o pogrješci
;NAPUTAK ZA KORIŠTENJE OVE RADNJE:
;Ovu radnju pozivamo na sliedeći način, a to je da kano vriednostnicu toj
radnji stavimo niz crta određenih s dvie točke:
; (mnogokuti_od_crta ((list (list (list ya1 xa1 0) (list yb1 xb1 0)) (list
(list ya2 xa2 0) (list yb2 xb2 0))... (list (list yaN xaN 0) (list ybN xbN 0))
)))
; izhod te radnje onda bude niz mnogokuta od najmanje površine prema
najvećoj koje još imaju uz sebe upisane i površine mnogokuta, a ako neke crte
ne zatvaraju mnogokut,
; uz njih na crtežu nam stavi napomenu da se radi o pogrješci, ter mnogokut
unutar kojeg je pogrješka ne će biti dobiven:
; (list (list povrsinaa (list (list ya1 xa1 0) (list ya2 xa2 0)... (list yaN
xaN 0))) (list povrsinab (list (list yb1 xb1 0) (list yb2 xb2 0)... (list ybN
xbN 0)))... )
(defun mnogokuti-od-crta (niz_crta / skup provjera10 br1 polje3p poljeopis
polje3p-pov crtoniz crtoniz1 brkcniz
sloj ybrkc xbrkc zbrkc brkc)
(setq provjera10 0) ;provjerava da li je negdje crta od međe koja nema
spoja na sliedeću crtu
(setq br1 0) ;brojač predmeta unutar skupa-ssget
(setq polje3p (list)) ; polje koje u sebi sadrži sve određene mnogokute
(setq poljeopis (list)); polje koje u sebi sadrži pridjevke mnogokuta
(setq polje3p-pov (list))
(setq crtoniz (list)); niz crta (samo međa - jedna crta se upisuje dva
puta) koje dobijemo iz označenih predmeta
(setq crtoniz1 (list)); niz crta (jedna crta se upisuje puta 2) (samo međa)
koje dobijemo iz označenih predmeta
(setq brkcniz (list)); niz brojeva k.č. i njezinih suosnica
(setq crtoniz niz_crta)
(while (/= niz_crta nil)
(setq crtoniz1 (append crtoniz1
(list (reverse (car niz_crta))) ))
(setq niz_crta (cdr niz_crta))
) ;kraj while
(setq crtoniz1 (append crtoniz1 crtoniz))
(setq crtoniz crtoniz1)
(setq br1 0) ;brojač predmeta unutar skupa-ssget
(while (< br1 (length crtoniz)) ;vrti po redu sve crte unutar crtoniza
dok ne dođe do kraja, a crta je u crtonizu određena s dvie točke, od kojih
svaka ima dvie suosnice y i x, te 0 za z
(princ "\n") (princ
br1) (princ "od") (princ (length crtoniz)) ;izpisuje mi koliko još
naputbina ima za odraditi
(setq tc1 (nth 0 (nth br1
crtoniz))) ;dobivamo položaj prve točke odabrane crte
(setq tc2 (nth 1 (nth br1
crtoniz))) ;dobivamo položaj druge točke odabrane crte
(setq t1 tc1) (setq t2 tc2)
;prva točka bude tc1, a druga tc2
(setq polje2p (list t1 t2))
;određen početak liste mnogokuta na osnovu prve crte
(setq y1 (nth 0 t1)) (setq x1
(nth 1 t1)) (setq y2 (nth 0 t2)) (setq x2 (nth 1 t2)) ;dobivam suosnice iz prva
dva početna vrha mnogokuta
(setq pov 0) ;površina
mnogokuta koja se postupno računa
(setq yprosjek 0) (setq
xprosjek 0) ;računska sredina suosnica svih vrhova nekog mnogokuta
(setq brvrh 0) ;brojač točaka
(vrhova) mnogokuta
(setq pov (* (+ y1 y2) (- x1
x2)) ) ;prva dva vrha mnogokuta u jednačbi za površinu
(setq yprosjek (+ yprosjek y2))
(setq xprosjek (+ xprosjek x2)) ;početak zbroja dva vrha mnogokuta za računsku
sredinu svih suosnica vrhova mnogokuta
(setq brvrh 1) ;brojač točaka
(vrhova) mnogokuta
(setq zbrojkv 0) ;zbroj svih
veznih kutova u jednom mnogokutu
(setq y1p y1) (setq x1p x1)
(setq y2p y2) (setq x2p x2) ;oni pamte položaj od početne crte mnogokuta kako
bi se prepoznalo kad se izredaju crte oko mnogokuta i opet vrate na početnu
(setq br2 nil)
(setq y3k 0) (setq x3k 0)
(while (and (or (/= y1p y2) (/=
x1p x2)) (/= y3k nil)) ;while koji vrti crte po mnogokutu dok ne dođe nazad do
početne crte mnogokuta
(setq br2 0) ;brojač od druge vrtnje
označenih predmeta
(setq kv (* 2 pi)) ;konačni
najmanji vezni kut između dvie crte mnogokuta
(setq y3k nil) (setq x3k nil)
;konačne suosnice od kraja sliedeće crte mnogokuta
(setq crta3 (assoc t2
crtoniz1)) ;iz crtoniza1 dobiva crtu kojoj je početna točka jednaka drugoj
točki iz prve crte
(setq crtoniz2 crtoniz1)
(while (/= crta3 nil) ;traži
sve crte koja se nastavljaju na kraj crte iz predhodne while petlje
(setq ycc1 (nth 0 (nth 0
crta3))) (setq xcc1 (nth 1 (nth 0 crta3))) ;dobivamo dvoprotežni položaj prve
točke odabrane crte
(setq ycc2 (nth 0 (nth 1
crta3))) (setq xcc2 (nth 1 (nth 1 crta3))) ;dobivamo dvoprotežni položaj druge
točke odabrane crte
;(setq provjera10 0) ; ako
ostane 0, a ne 1, znači da se crta ne nadovezuje na predhodnu crtu
(setq y3 ycc2) (setq x3
xcc2) ;dobivamo točku od kraja druge crte (druga točka) koja se nadovezuje na
prvu crtu
(setq ks1 (angle (list y2
x2 0) (list y1 x1 0))) ;smjerni kut s točke 2 na točku 1 u odnosu na ječnu os Y
u obrnutom smjeru od kazaljke na dobnjaku
(setq ks2 (angle (list y2
x2 0) (list y3 x3 0))) ;smjerni kut s točke 2 na točku 3 u odnosu na ječnu os Y
u obrnutom smjeru od kazaljke na dobnjaku
(setq kv1 (- ks1 ks2))
;vezni kut između dvie stranice mnogokuta, s lieve strane u odnosu na smjer
crtanja mnogokuta
(if (< kv1 0) (setq kv1
(+ (* 2 pi) kv1)) ) ;ukoliko je vezni kut niječan, tada ga se zbraja s 360,
kako bi se dobio jestan kut
(if (and (< kv1 kv) (or
(/= y1 y3) (/= x1 x3))) (progn (setq kv kv1) (setq y3k y3) (setq x3k x3) )) ;
ako je trenutni vezni kut manji od predhodnog veznog kuta, ter ako je prva
točka različita od treće točke, onda se od te točke preuzimaju podatci suosnica
(setq crtoniz2 (cdr (member
crta3 crtoniz2)) )
(setq crta3 (assoc t2
crtoniz2) ) ;member će prikazat niz od crte3 do kraja crtoniza1, cdr će
prikazat cieli taj dobiveni niz bez prvog člana, a onda će assoc nnać prvi
sliedeću crtu koja ima prvu točku isti kano druga točka prve zadane crte
(setq br2 (+ br2 1))
) ;kraj while koji traži
crte, kako bi pronašao sliedeću crtu kano nastavak mnogokutne stranice
(if (and (/= y3k nil) (/= x3k nil))
(progn ;tako da oba y3 budu različiti
od nil kako su na početku zadani
(setq crtoniz (vl-remove
(list t1 t2) crtoniz)) ;iz niza crtoniz brišem crtu koja se sastoji od t1 i t2,
jer nam više ne će trebati a samo bi usporavala izvršenje naputbine
(setq pov (+ pov (* (+ y2
y3k) (- x2 x3k) ))) ;jednačba za površinu se pomalo nadopunjava s suosnicama
vrhova mnogokuta
(setq yprosjek (+ yprosjek
y3k)) (setq xprosjek (+ xprosjek x3k)) ;zbrajanje suosnica svih vrhova
mnogokuta
(setq brvrh (+ brvrh 1))
(setq polje2p (append
polje2p (list (list y3k x3k 0)) )) ;nadograđuje listu točaka koje čine mnogokut
(setq y1 y2) (setq x1 x2)
(setq y2 y3k) (setq x2 x3k) ;Prva točka postaje druga točka, a druga postaje
treća točka iz mnogokuta
(setq t1 (list y1 x1 0))
(setq t2 (list y2 x2 0)) ;točke t1 i t2 postaju toče od sliedeće crte koja je
spojena na predhodnu crtu
(setq zbrojkv (+ zbrojkv
kv)) ;postupno dobivam zbroj veznih kutova
)) ;kraj if-progn - tako da
oba y3 budu različiti od nil kako su na početku zadani
) ;kraj while koji vrti crte po
mnogokutu dok ne dođe nazad do početne crte mnogokuta
(if (= y3k nil) (progn (setq
br1 (+ br1 1)) (if (= provjera10 0) (alert "crta medje nije
spojena")) (setq provjera10 1) (command "layer" "m"
"_pogrjeska" "c" "red" "" "s"
"" "") (command "text" "j"
"bl" t2 "2" "0" "crte nisu spojene")))
;ukoliko ne nađe crtu koja se nastavlja na zadnju crtu međe, tada na tom mjestu
izpisuje poruku o pogrješci
(setq ks1 (angle (list y2 x2 0)
(list y1 x1 0))) ;smjerni kut s točke 2 (zapravo prva točka mnogokuta) na točku
1 (zadnju točku mnogokuta) u odnosu na ječnu os Y u obrnutom smjeru od kazaljke
na dobnjaku
(setq ks2 (angle (list y2 x2 0) (list y2p x2p
0))) ;smjerni kut s točke 2 (prva točka mnogokuta) na točku 2p (druga točka
mnogokuta) u odnosu na ječnu os Y u obrnutom smjeru od kazaljke na dobnjaku
(setq kv1 (- ks1 ks2)) ;vezni
kut između dvie stranice mnogokuta, s lieve strane u odnosu na smjer crtanja
mnogokuta
(if (< kv1 0) (setq kv1 (+
(* 2 pi) kv1)) ) ;ukoliko je vezni kut niječan, tada ga se zbraja s 360, kako
bi se dobio jestan kut
(setq kv kv1) ; dobivam vezni
kut kv na prvoj točki mnogokuta, a koji mi je ujedno zadnji izračunati vezni
kut
(setq zbrojkv (+ zbrojkv kv))
;postupno dobivam zbroj veznih kutova
(setq provjerakv (* (- brvrh 2)
pi) ) ;jednačba (brvrhova-2)*180 da je jednako zbroju unutarnjih veznih kutova
u mnogokutu
(setq zbrojkvz (rtos zbrojkv 2
6)) (setq provjerakvz (rtos provjerakv 2 6)) ;zbrojeve kutova unutar mnogokuta
zaokružujem na 6 desetica kano znakonize
(setq ypk (/ yprosjek brvrh))
(setq xpk (/ xprosjek brvrh)) ;dobivene konačne računske sredine suosnica
vrhova nekog mnogokuta
(setq povk (/ (abs pov) 2) )
;tu smo dobili konačnu površinu mnogokuta
(setq opis (list (rtos povk 2
6) (rtos ypk 2 6) (rtos xpk 2 6))) (setq bropis 0) (setq provjera1 0) ;opis je
lista s površinom i računskom sredinom
nekog mnogokuta
(while (> (length poljeopis)
bropis) (if (equal (list (rtos (nth 0
(nth bropis poljeopis)) 2 6) (rtos (nth 1 (nth bropis poljeopis)) 2 6) (rtos
(nth 2 (nth bropis poljeopis)) 2 6)) opis) (setq provjera1 1) ) (setq bropis (+ bropis 1)) ) ;na ovaj način
gledam da u listi već nemam isti mnogokut zapamćen i to na osnovu površine i
položaja računske sredine suosnica vrhova mnogokuta
(if (and (= provjera1 0) (=
provjerakvz zbrojkvz)) (progn ;uvjet da u listi nema već istog mnogokuta i da
je zbroj unutarnjih veznih kuteva jedan (n-2)*180
(setq poljeopis (append
poljeopis (list (list povk ypk xpk )))) ;slaže se lista površine i računske
sredine položaja svih lomnih točaka mnogokuta
(setq polje3p-pov (append
polje3p-pov (list (list povk polje2p)))) ;niz mnogokuta s time da je izpred
svakog mnogokuta iznos površine
)) ;kraj if-progn
;(setq br1 (+ br1 1)) ;brojač ne
treba aš se vrhovi mnogokuta brišu kod svakog obilazka
) ;kraj while koji vrti skup-ssget
(setq polje3p-pov1 (vl-sort polje3p-pov (function (lambda (e1 e2) (<
(car e1) (car e2)))))) ;poreda mnogokute od najmanje površine prema najvećoj
) ;defun kraj od podanputbine
;------------- KRAJ - PODNAPUTBINA ZA STORIT ZAPRTE MNOGOKUTE NA RAČUN CRTA
----------------------------------------------