Iskra

Zadanie domowe rozwiązane bardzo dobrze (choć bez funkcji), ale ok. Funkcja może wygladać tak:
(defun SelRect (/ e d dia)  (defun dia (p)    (if      (not (zerop (distance (car p)(cadddr p))))      (equal        (distance (car p)(caddr p))        (distance (cadr p)(cadddr p))        0.001      )    )  )  (if       (and           (setq e (entsel "\nWskaż prostokąt: "))      (= (cdr (assoc 0 (setq d (entget (car e))))) "LWPOLYLINE")      (= 1 (logand 1 (cdr (assoc 70 d))))      (zerop (apply '+ (mapcar 'abs (cd:DXF_massoc 42 d))))      (= (cdr (assoc 90 d)) 4)      (dia (cd:DXF_massoc 10 d))    )    (princ "\nOk")    (princ "\nŹle. ")  )) SelRect, ma w sobie zdefiniowaną funkcję dia, która zwraca T jeżeli z listy punktów wynika że odległości 1-3 i 2-4 (przekątne) są równe (z tolerancją .001). Trzeba zwrócić uwagę na sprawdzenie czy pierwszy i ostatni punkt się nie pokrywają - eliminuje to przypadek listy 4 współrzędnych definuijących w rzeczywistości trójkąt, a nie czworokąt. Funkcja jest argumentacyjna, i wstawiona jest jako kolejny element w and. Czyli wyszło teraz tak:
- coś wybrane
- to jest LWPoly
- jest zamknięta
- nie ma łuków
- ma 4 wierzchołki
- przekątne są równe...
Wracając do naszej funkcji wyboru, można niektóre warunki zargumentyzować np. otwarta/zamknięta itp. W następnym odcinku możemy to spróbować.

 
Masz rację! Trzeba dodać jeszcze jeden inny warunek. Jaki będzie najprościej?

Właśnie tak jak pisałem wcześniej.

 
Ja bym jeszcze sprawdził kąt czy jest równy 90 stopni pomiędzy trzema kolejnymi wierzchołkami.
Pozdrawiam

No to zadanie domowe nam urosło... ;)
Proponuję dodatkowo sprawdzenie (porównanie) pól polilini: Otrzymanych z pomnożenia długości 1 i drugiego boku, oraz właściwości Area obiektu. Zdaje się że każde "skrzywienie" geometrii (pomimo równych przekątnych) powinno dać różne wyniki. Zmodyfikowana SelRect wygląda tak:
(defun SelRect (/ e d dia)   (defun dia (l p)     (if       (not (zerop (distance (car p)(cadddr p))))       (and         (equal           (distance (car p)(caddr p))           (distance (cadr p)(cadddr p))           0.001         )         (equal           (* (distance (car p)(cadr p))(distance (cadr p)(caddr p)))           (vla-get-Area (vlax-ename->vla-object l))           0.001         )       )     )   )   (if         (and             (setq e (entsel "\nWskaż prostokąt: "))       (= (cdr (assoc 0 (setq d (entget (car e))))) "LWPOLYLINE")       (= 1 (logand 1 (cdr (assoc 70 d))))       (zerop (apply '+ (mapcar 'abs (cd:DXF_massoc 42 d))))       (= (cdr (assoc 90 d)) 4)       (dia (car e)(cd:DXF_massoc 10 d))     )     (princ "\nOk")     (princ "\nŹle. ")   ) )

No to żeby nie było że tak proste zadanie można rozwiązać tak szybko dodam jeszcze swoje uwagi:

1. Co się stanie jeśli Użytkownik zamiast posłusznie wskazać prostokąt naciśnie na klawiaturze [ESC]? Zawsze, ale to absolutnie zawsze jeśli pozwalamy Użytkownikowi zrobi cokolwiek należy użyć obsługi wyjątków vl-catch-all-apply

2. Będąc pod wpływem idei Roberta C. Martina dotyczącej czystości kodu chciałbym jeszcze zwrócić uwagę na czytelność kodu.
 - Dziś wiemy że DXF 70 pozwala sprawdzić czy Polilinia jest zamknięta.  ale czy będzie to dla nas jasne za kilka czy kilkanaście miesięcy, jeśli cały ten czas będziemy pracować w LISP to pewnie tak, ale być może kiedyś wrócimy do dawno zapomnianego kodu, który działał ale musimy w nim coś zmienić będziemy się zastanawiac "o co chodziło z tym 129". A może po kilku miesiącach musimy dodać obsługę okręgów. Nie wiem czy okrąg ma DXF 70 i jakie jest jego znaczenie , ale skoro jest okręgiem to na pewno jest zamknięty i nie ma potrzeby sprawdzanie tego warunku. Warto w takiej sytuacji mieć dokładnie jedno miejsce gdzie tego szukać. Dlatego sugeruję opakować każdy warunek funkcją.

 - być może w przyszłości to nie twórca programu a jego współpracownik, następca, pomocnik, uczeń czy ktokolwiek będzie czytał ten sam kod i będzie zastanawiał się czy funkcja "dia" ma porównywać długości przekątnych, czy jaka jest jej rola. Przeczyta i zrozumie, ale na ten czas odwróci swoją uwagę od czegoś co było ważniejsze bo miał zadanie sprawdzić/dodać cośtam co nie ma się nijak do przekątnych  Dlatego lepiej jest nazywać funkcje i zmienne w taki sposób, żeby czytając jasne było co ma się dziać w kodzie. zainteresowany szczegółami implementacji może sobie znaleźć definicję funkcji i ją przeanalizować.

3. Rozumiem że dla uproszczenia przykładu można użyć (princ "\nŹle. "), ale przestrzegam przed używaniem takiego rozwiązania w kodzie produkcyjnym . Lepiej jest stałe tekstowe przechowywać gdzieś indziej, i tylko odwoływać się do nich w kodzie po symbolu.
Wszytko jest OK, puki pracujemy na swoim komputerze, na znanej stabilnej wersji programu. Aż tu nagle niespodzianie pewnego dnia ktoś nam proponuje żeby uruchomić ten kod na innej maszynie, cieszy oczywiście że nasza praca jest przez kogoś doceniona, ale tylko do czasu kiedy zamiast "Wskaż prostokąt: " zobaczymy "WskaĹĽ prostokÄ…t: " poprostu niektóre systemy działają na Unicode, ale inne NIE. Oczywiście zawsze możemy zmienić każdy krzaczek na poprawną literkę, ale wtedy mamy już 2 wersje kodu do utrzymania i musimy o tym pamiętać przy każdej zmianie wprowadzonej do kodu.
Być może pewnego dnia zechcemy nasz program udostępnić (być może za niewielką opłatą ;) ) komuś kto nie zna naszego języka, wówczas tłumaczymy 1 plik z tekstami a nie musimy wyszukiwać w kodzie wszystkich tekstów.
Podobnie można przejechać się na formatowaniu daty, ale to już temat na inną pogadankę.

Moja propozycja kodu źródłowego jest taka:
(defun SelRect (/ select SelectedEntity IsRectangle e d dia OutVal) (defun IsRectangle (Entity / EntityList IsPolyline IsClosed DiagonalsAreEqual AreaIsCorrect NumberOfVertex ) (setq EntityList (entget Entity) ) (progn ; Locals (defun IsPolyline (Entity / ) (= (cdr (assoc 0 Entity)) "LWPOLYLINE") ) (defun IsClosed (EntityList / ) (= 1 (logand 1 (cdr (assoc 70 EntityList)))) ) (defun NumberOfVertex (EntityList / ) (cdr (assoc 90 EntityList)) ) (defun HasArcSegment (EntityList / ) (zerop (apply '+ (mapcar 'abs (cd:DXF_massoc 42 EntityList)))) ) (defun DiagonalsAreEqual (Entity / p ) (setq p (cd:DXF_massoc 10 Entity ) ) (if (and (not (zerop (distance (car p)(cadddr p)))) (equal (distance (car p)(caddr p)) (distance (cadr p)(cadddr p)) 0.001 ) ) ) ) (defun AreaIsCorrect (Entity / p ) (setq p (cd:DXF_massoc 10 Entity ) ) (equal (* (distance (car p)(cadr p))(distance (cadr p)(caddr p))) (vla-get-Area (vlax-ename->vla-object Entity)) 0.001 ) ) ) (if (and (IsPolyline EntityList) (IsClosed EntityList) (= (NumberOfVertex EntityList ) 4) (not (HasArcSegment EntityList)) (DiagonalsAreEqual Entity) (AreaIsCorrect Entity) ) ) ) (setq select (vl-catch-all-apply 'entsel (list "\nWskaż prostokąt: "))) ; przechwytuję błąd jeśli Użytkownik wciśnie [ESC] (if (not (vl-catch-all-error-p select)) ; sprawdzam czy wybór jest poprawny (progn (setq SelectedEntity (car select )) (if (IsRectangle SelectedEntity) (setq OutVal 'IsRectangle ) (setq OutVal 'NOTRectangle ) ) ) (setq OutVal 'NothingSelected ) ) OutVal ) Przepraszam jeśli nie działa, zmiany wprowadzałem w samym tekście bo przyznam że nie mam zainstalowanego CADPacka . Obiecuje że zainstaluje i sprawdzę kiedy będę miał trochę więcej czasu.

Pozwolę sobie wyrazić swoją opinię, w sprawie trzech powyższych punktów.
Ad 1. Zgoda, ale chyba za wcześnie na to wszystko. Do tej pory odnosiłem wrażenie że wątek mając nieco charakter edukacyjny, powoli rośnie zwiększając poziom zaawansowania. Zwłaszcza że kolega Iskra (zakładając wątek) sam nadmienił że się dopiero uczy. Napisał kawałek dość dobrego kodu (w ogólności co do zasady), nie wystrzegł się paru błędów, ale nie zniechęcajmy go jednak na samym początku. Na vl-catch-all-apply przyjdzie jeszcze czas. Na razie bez radykalnego zawsze i absolutnie. Póki co proste rzeczy, pytania i odpowiedzi. Chce wiedzieć, pyta, ma potencjał, na wszystko przyjdzie czas. Popatrz (że znów wrócę do CAD-Pack'a), nie mówię że wszystko jest do d*py, weź no funkcję cd:USR_EntSelObj, daj se spokój bo ona jest git... Na marginesie, warto na nią też popatrzeć.
Ad 2. Różnić się będę także co do rzekomej czytelności kodu. Wydaje mi się że przedstawiona propozycja zaciemnia a nie rozjaśnia. Ogólnie jestem zwolennikiem stosowania funkcji w funkcji (mającej charakter lokalny) w dwóch przypadkach. Po pierwsze: podfunkcja (tak ją nazwijmy umownie), wywoływana jest wielokrotnie, lub (po drugie), jest na tyle obszerna że zaciemnia właśnie kod główny. Ten drugi przypadek widać w zastosowaniu funkcji dia wewnątrz SelRect. Wszystkie inne wywołania w and, (typ obiektu, zamknięcie, bulge itp.) wydają się na tyle proste że nie widzę potrzeby definiowania ich jako osobne funkcje. Zwłaszcza jako funkcje lokalne (mające zasięg tylko wewnątrz innej jednej funkcji). Spójrzmy, przykład pierwszy z brzegu. Kod:
 
(defun IsPolyline (Entity / )  (= (cdr (assoc 0 Entity)) "LWPOLYLINE")  ) właściwie niczego nie wnosi (oprócz zwiększenia objętości), bowiem samo:
 
(= (cdr (assoc 0 Entity)) "LWPOLYLINE") wydaje się być i tak czytelne. Ewentualnie można je opatrzyć komentarzem.
Powtórzę raz jeszcze - zwłaszcza jako funkcja lokalna. Co innego gdyby to była funkcja biblioteczna (mogąca mieć wielokrotne zastosowanie w wielu miejscach). Jestem zagorzałym zwolennikiem tworzenia funkcji bibliotecznych. Jednak uważam, należy zachować tutaj pewien umiar i szukać możliwie uniwersalnego zastosowania. Bowiem (jeszcze na tym przykładzie), gdyby nawet twoja IsPolyline, była nawet funkcją biblioteczną, jej sens i tak jest mocno wątpliwy. Bowiem tym tropem trzeba by stworzyć tyle funkcji ile jest typów obiektów (Isline, IsArc, IsCircle... etc.) Nie trzeba wiele analizować że nie ma to sensu. W tym przypadku funkcja biblioteczna mogłaby być jedna i sprawdzać czy podany obiekt jest akceptowany wg jakiegoś kryterium (tutaj rodzaj obiektu). Na przykład definicja:
 
(defun GetTypeObj (Ent TypeLst)  (car (member (cdr (assoc 0 (entget Ent))) TypeLst)) ) i potem przykładowe wywołania:
 
(GetTypeObj (car (entsel)) '("LWPOLYLINE" "LINE" "ARC")) pozwala określić ze wskazania czy to jest polilnia albo linia albo łuk
czy:
 
(GetTypeObj (car (entsel)) '("LWPOLYLINE")) zawęzić typ tylko do polilinii.
Podsumowując - w mojej opinii - poprzez przerost definicji funkcji zaciemniłeś, a nie rozjaśniłeś kod.
 
Ad 3. Powtórzę to co w Ad 1. Ogólnie zgoda, niemniej tutaj testujemy budowanie prostej funkcji ilustrując jej działanie, tak aby była zrozumiała, na tym poziomie ogólności. W tej chwili potrzebujemy informacji czy wybór jest ok czy be. Gdy to przejdziemy nastąpić może ciąg dalszy (coś się dzieje gdy jest ok, coś innego gdy jest be).

Tymczasem wróćmy (bośmy nieco "zboczyli"... ;) ) do wyboru polilinii. Krótko jeszcze o "zadaniu domowym". Spójrzmy na obrazek porównujący prostokąt z "kokardką":
 
Pożądany przez nas czworokąt będący prostokątem można sprawdzić też w ten sposób:
Weźmy dwa sąsiednie boki (np. 1-2 i 2-3). Wybierzmy najdłuższy z nich (tu będzie to 1-2). I teraz sprawdzamy: w prostokącie ten najdłuższy z boków musi być krótszy od długości przekątnej (np. 1-4), dodatkowo oczywiście to (przekątne) jednocześnie muszą być sobie równe. I to chyba w zupełności wystarczy?
Kod "zadania domowego":
(defun SelRect (/ e d rect-p)   (defun rect-p (p / d)     (if                                          ; jezeli       (not (zerop (distance (car p)(cadddr p)))) ; 1 i 4 pkt sie nie pokrywaja       (and                                       ; sprawdz         (equal                                   ; czy jest rowna           (setq d (distance (car p)(caddr p)))   ; dlugosc 1 przekatnej           (distance (cadr p)(cadddr p))          ; i 2 przekatnej?           0.001         )         (<                                       ; i najwiekszy           (max                                   ; bok z 1 i 2             (distance (car p)(cadr p))           ; jest             (distance (cadr p)(caddr p))         ; mniejszy           )           d                                      ; od przekatnej         )       )                                          ; T  (spelnia warunki)     )                                            ; nil (nie spelnia)   )   (if         (and             (setq e (entsel "\nWskaż prostokąt: "))                    ; jest wybor       (= (cdr (assoc 0 (setq d (entget (car e))))) "LWPOLYLINE") ; to LWPoly       (= 1 (logand 1 (cdr (assoc 70 d))))                        ; jest zamknieta       (zerop (apply '+ (mapcar 'abs (cd:DXF_massoc 42 d))))      ; nie ma seg. lukowych       (= (cdr (assoc 90 d)) 4)                                   ; ma 4 wierzcholki       (rect-p (cd:DXF_massoc 10 d))                              ; jest prostokatem     )     (princ "\nOk")     (princ "\nŹle. ")   ) ) wzbogacony o komentarze, które pozwolą łatwiej prześledzić działanie.

Funkcja z przedrostkiem C: to specjalna definicja funkcji lispowej - najoględniej mówiąc tworzy polecenie AutoCAD-a, zdefiniowane w LISP-ie. Wywołanie jej działa jak polecenie, można je wywołać z linii poleceń. Taka funkcja nie może mieć argumentów.
Natomiast "zwykłe" funkcje można wywołać w linii poleceń, ale trzeba je wywoływać w pełnej składni wymaganej przez interpreter LISP-a, czyli w nawiasach i z argumentami (jeśli funkcja je posiada). I tak, namaluj coś i w linii poleceń napisz:
(entlast) funkcja zwróci ename ostatniego obiektu. Teraz wywołaj funkcję z argumentem np. :
(entget (entlast)) dostaniesz listę DXF danych tego obiektu.
Tak samo wywołujesz funkcję SelRect:
(SelRect)  
Drugi problem. Kierunek polilinii. Potrzebujesz funkcji napisanej przez gile'a. Wygląda tak:
;; Clockwise-p  -  Gilles Chanteau (gile) ;; Returns T if p1,p2,p3 are clockwise oriented (defun gc:clockwise-p (p1 p2 p3)     (< (sin (- (angle p1 p3) (angle p1 p2))) -1e-14) ) Zwraca T jeśli 3 punkty podane jako argumenty funkcji tworzą kąt zorientowany zgodnie z ruchem wskazówek zegara, lub nil w przeciwnym wypadku. 
Potem można już zdefiniować polecenie sprawdzające polilinię. Musi ona mieć co najmniej dwa wierzchołki. Funkcja może wyglądać tak:
(defun C:TESTCLP (/ e d p)   (if     (and       (setq e (entsel "\nWybierz polilinie: "))       (= (cdr (assoc 0 (setq d (entget (car e))))) "LWPOLYLINE")     )     (if       (> (length (setq p (cd:DXF_massoc 10 d))) 2)       (gc:clockwise-p (car p)(cadr p)(caddr p))     )   ) )

Od końca. Ilość wierzchołków to jedyna wartość dla kodu 90. Stąd od razu porównanie. Dla zamknięcia sprawa jest bardziej złożona. Kod 70 zawiera jednocześnie informację czy Polilinia jest zamknięta, oraz czy generowanie rodzaju linii jest włączone czy nie. I tak: 0 - poly otwarta a 1 zamknięta. PLINEGEN zaś to wartość 128. Stąd test zamknięcia polilinii sprowadza się do sprawdzenia logand = 1 (1 i 129 to zamknięta).

Jeśli można tutaj (chyba że admin przeniesie do innego wątku), od samego początku.
Czyli wybór obiektu. Niech będzie prosta funkcja o nazwie Sel do wyboru jednego obiektu. Do testowania zwracać będzie wynik Ok lub Źle. W kolejnych krokach trochę urośnie, ale pozwoli to prześledzić działanie.
Podobnie jak w twoim kodzie, chcemy wybrać obiekt (polilinię). Spójrz:
 
(defun Sel (/ e) (if (setq e (entsel "\nWskaż polilinię: ")) (princ "\nOk") (princ "\nŹle. ") ) ) 

Powiedzmy szczerze że żadnych rewelacji, nie trafisz - masz źle, wybierzesz jest Ok. Powiela twój błąd - możesz wybrać cokolwiek, a chcesz przecież polilinię.
Zatem druga przymiarka:
 
(defun Sel (/ e d)  (if    (and      (setq e (entsel "\nWskaż polilinię: ")) (= (cdr (assoc 0 (setq d (entget (car e))))) "LWPOLYLINE") ) (princ "\nOk") (princ "\nŹle. ") ) ) W and od razu pobieramy dane obiektu (zmienna d), jednocześnie sprawdzamy czy to Polilinia. Lepiej?
Lepiej ale... w twoim przypadku trzeba wybrać polilinię zamkniętą raczej. Zatem popatrzmy:
 
(defun Sel (/ e d)  (if    (and (setq e (entsel "\nWskaż polilinię: "))      (= (cdr (assoc 0 (setq d (entget (car e))))) "LWPOLYLINE") (= 1 (logand 1 (cdr (assoc 70 d)))) )    (princ "\nOk") (princ "\nŹle. ") ) ) and ma teraz trzy warunki ( 1.wybraliśmy obiekt, 2.polilinię i 3.zamkniętą). Zamknięta polilinia w DXF to kod 70. Musi mieć wartość 1 (oraz ewentualnie 129). Jest dużo lepiej. Ale to nie koniec. Właściwie, to powinieneś wybrać zamkniętą polilinię ale o co najmniej 3 segmentach... Więc zmieniamy sel:
 
(defun Sel (/ e d) (if    (and      (setq e (entsel "\nWskaż polilinię: ")) (= (cdr (assoc 0 (setq d (entget (car e))))) "LWPOLYLINE") (= 1 (logand 1 (cdr (assoc 70 d)))) (>= 4 (cdr (assoc 90 d))) ) (princ "\nOk") (princ "\nŹle. ") ) ) I teraz mamy już bardziej (niż mniej) poprawny kawałek kodu do wybrania polilini...

Witam
Korzystając z samych odcinków prostych pomysł z łączeniem punktów w pary jest bardzo trafny, natomiast nie sprawdzi się w przypadku segmentów łukowych.
Obiekty graficzne w CAD mają metodę: GetBoundingBox
np:
(vl-load-com) (setq util (vla-get-utility (vla-get-activedocument (vlax-get-acad-object)))) (vla-getentity util 'obj 'ip "\nSelect Object: ") (vla-GetBoundingBox obj 'minpoint 'maxpoint) (princ (vlax-safearray->list minpoint ) ) (terpri) (princ vlax-safearray->list maxpoint) Metoda GetBoundingBox przekazuje to zmiennych minpoint  i maxpoint odpowiedni lewy dolny i prawy górny narożnik prostokąta obejmującego element
Jest tylko jeden problem:  GetBoundingBox wylicza prostokąt obejmujący w układzie globalnym więc zwykle uzyskany prostokąt nie będzie najmniejszym.
Myślę, że jeśli mamy obracać układem współrzędnych równie dobrze możemy pokręcić samym mierzonym elementem, albo jego kopią. Może i uzyskany prostokąt nie będzie najmniejszy z możliwych, ale przyjmując jakąś rozsądną relację wydajności do dokładności możemy obracać np 90 razy co 1 stopień, lub 180 razy co 0.5 stopnia aż do uzyskania wystarczająco dokładnego efektu w akceptowalnie długim czasie wykonania.
Pozdrawiam

Nie wydaje mi się aby zabawy z obracaniem obiektów, będą efektywniejsze niźli LISP który wskazałem we wcześniejszym poście. Wykorzystuje on algorytm Grahama (wyznaczenie otoczenia punktów), sprowadzając wynik ostatecznie w uproszczeniu do najmniejszego prostokąta (o co w rzeczywistości chodzi). Wydaje mi się że działa dobrze w większości zastosowań.

Co do znalezienia najmniejszego prostokąta (opisującego płaską figurę) zobacz tutaj:
http://www.theswamp.org/index.php?topic=33607.msg389707#msg389707
Jest tam program do ściągnięcia:
http://www.theswamp.org/index.php?action=dlattach;topic=33607.0;attach=15988
Potestuj i zobacz czy spełnia twoje oczekiwania.
 
Co do lisp-ów zaś, zobacz tutaj: http://forum.cad.pl/cadpl-pack-v1-lsp-t78161.html
To o takim zjawisku o nazwie CADPL-Pack. Jest to zestaw funkcji bibliotecznych, których użycie (także w twoim omawianym tutaj problemie), znacznie może ułatwić pracę. Również sama dyskusja przy poczęciu i rozwoju Pack-a, (w mojej opinii) może być źródłem porządnej lisp-owej wiedzy. W tej chwili widzę już na początku wiele błędów w twoim kodzie. Chętnie (w miarę możliwości czasowych) służę pomocą, w ich ewentualnej poprawie i wyjaśnieniu na czym polegają.