-
Postów
253 -
Dołączył
-
Ostatnia wizyta
-
Wygrane w rankingu
36
Aktywność reputacji
-
kojacek otrzymał(a) reputację od alf w lisp, generowanie kierunków/grotów strzałek na zadanej polilinii
😉 takie coś można wydziobać albo wydrapać... blok dynamiczny sterowany dynamicznie z okna dialogowego:
-
kojacek otrzymał(a) reputację od dmatusz3 w lisp, generowanie kierunków/grotów strzałek na zadanej polilinii
Zadanie z tych banalnych raczej... Można rozwiązać tak:
; ---------------------------------------------------------------------------- ; (defun c:testuj ()(InsBlkInPolySeg (car (entsel)) "arrow1" 20.0 15.0)(princ)) ; ---------------------------------------------------------------------------- ; ; funkcja zwraca liste segmentow LWPOLY typu: ((p1 bulge1 p2)(p2 bulge2 p3)...); ; ---------------------------------------------------------------------------- ; (defun jk:LWP_GetSegments (e / p d r) (setq d (entget e) p (if (= 1 (logand (cdr (assoc 70 d)) 1)) (cdr (assoc 10 d)) ) d (mapcar 'cdr (vl-remove-if-not '(lambda (%)(member (car %) '(10 42))) d ) ) ) (if p (setq d (append d (list p))) ) (while (> (length d) 2) (setq r (cons (list (car d) (cadr d) (caddr d) ) r ) d (cddr d) ) ) (reverse r) ) ; ---------------------------------------------------------------------------- ; (defun InsBlkInPolySeg (Poly Block Scale MinLength / d b n a p) (if (not (tblobjname "BLOCK" Block)) (princ (strcat "\nBłąd: w rysunku nie ma bloku " (strcase Block) "." ) ) (if (not (setq d (jk:LWP_GetSegments Poly)) ) (princ "\nBłąd - niepoprawna Polilinia.") (if (not (setq d (vl-remove-if-not '(lambda (%)(zerop (cadr %))) d) ) ) (princ "\nBłąd - polilinia składa sie z samych łuków.") (if (not (setq d (vl-remove-if '(lambda (%) (< (distance (car %)(caddr %)) MinLength) ) d ) ) ) (princ "\nBłąd - segmenty polilinii są za krótkie.") (progn (cd:SYS_UndoBegin) (foreach % d (setq a (angle (car %)(caddr %)) p (polar (car %) a (/ (distance (car %)(caddr %)) 2.0)) ) (cd:BLK_InsertBlock p Block (list Scale Scale Scale) a nil) ) (cd:SYS_UndoEnd) ) ) ) ) ) ) ; ---------------------------------------------------------------------------- ; Polecenie TESTUJ, wywołuje funkcję InsBlkInPolySeg, dla której jednak kluczem jest funkcja jk:LWP_GetSegments. Dla całości trzeba CADPL-Pack-a który opisywałem kiedyś tutaj: https://kojacek.wordpress.com/2015/11/04/cadpl-pack/ . W uproszczeniu - groty strzałek w postaci bloku (argument Block) wstawiane są na liniowych segmentach wskazanej polilinii (argument Block - tutaj trzeba wstawić jeszcze jakieś testowanie wyboru), których długość jest większa niż argument MinLength.
-
kojacek otrzymał(a) reputację od s1016 w ZWCAD - Bloki dynamiczne i atrybuty
LISP-em można sterować parametrami bloku dynamicznego podczas aktywności okna dialogowego. Pozwala to kontrolować wizualnie dokonane zmiany. Tutaj na szybko tylko jeden parametr:
-
kojacek otrzymał(a) reputację od swazy w [AutoLisp] Zmiana widoczności warstwy.
Byłoby dziwne gdyby wpółpracował. Lista z tblsearch nie jest poprawną listą dla entmod. Użyj tu formy entget + tblobjname. Zobacz:
(setq e (tblobjname "layer" "zbrojenie_linie" )) (setq d (entget e)) (entmod (subst (cons 62 -8)(assoc 62 d) d)) a to prowadzić może do bardziej ogólnej funkcji:
(defun LayOnOff (Lay / e d) (if (setq e (tblobjname "LAYER" Lay)) (progn (setq d (entget e)) (setq d (subst (cons 62 (* -1 (cdr (assoc 62 d))) ) (assoc 62 d) d) ) (entmod d) ) ) ) Funkcja steruje widocznością warstwy podanej jako jej argument tak jak przełącznik, wywołaj kolejno:
(LayOnOff "zbrojenie_linie")
-
kojacek otrzymał(a) reputację od kruszynski w [AutoLisp] Zmiana widoczności warstwy.
Byłoby dziwne gdyby wpółpracował. Lista z tblsearch nie jest poprawną listą dla entmod. Użyj tu formy entget + tblobjname. Zobacz:
(setq e (tblobjname "layer" "zbrojenie_linie" )) (setq d (entget e)) (entmod (subst (cons 62 -8)(assoc 62 d) d)) a to prowadzić może do bardziej ogólnej funkcji:
(defun LayOnOff (Lay / e d) (if (setq e (tblobjname "LAYER" Lay)) (progn (setq d (entget e)) (setq d (subst (cons 62 (* -1 (cdr (assoc 62 d))) ) (assoc 62 d) d) ) (entmod d) ) ) ) Funkcja steruje widocznością warstwy podanej jako jej argument tak jak przełącznik, wywołaj kolejno:
(LayOnOff "zbrojenie_linie")
-
-
kojacek otrzymał(a) reputację od kruszynski w [ssget]
Ja tam jestem zwolennikiem minimalizmu w kodzie:
(ssget "_x" '((0 . "hatch")(-4 . "/=")(62 . 1)(-4 . "/=")(62 . 105))) 😉
-
kojacek otrzymał(a) reputację od Pawcyk w Dokumentacja fotograficzna
Skorzystaj z gotowych narzędzi lispowych zwanych CADPL-Pack.
Poczytaj tutaj: https://kojacek.wordpress.com/2015/11/04/cadpl-pack/ o nim, co to jest i jak używać.
Potem jest już z górki:
1) Odczytanie pliku csv:
(setq a (cd:SYS_ReadFile nil (findfile "GPS.csv")))
zwraca listę:
("D:\\Smietnik\\IMG_20180218_133113.jpg;51.269562;22.542074;22" "D:\\Smietnik\\IMG_20180218_133117.jpg;51.269562;22.542074;90" "D:\\Smietnik\\IMG_20180218_133144.jpg;51.269562;22.542074;180" "D:\\Smietnik\\IMG_20180221_190038.jpg;51.269558;22.542191;130")
2) Podział łańcuchów (elementów listy) na osobne listy:
(setq b (mapcar '(lambda (%)(cd:STR_Parse % ";" T)) a))
zwraca:
(("D:\\Smietnik\\IMG_20180218_133113.jpg" "51.269562" "22.542074" "22") ("D:\\Smietnik\\IMG_20180218_133117.jpg" "51.269562" "22.542074" "90") ("D:\\Smietnik\\IMG_20180218_133144.jpg" "51.269562" "22.542074" "180") ("D:\\Smietnik\\IMG_20180221_190038.jpg" "51.269558" "22.542191" "130"))
3) Utworzenie osobnych list na podstawie indeksu. Na poczatek krótka definicja funkcji do tego celu:
(defun jk:LST_nth (Lst Idx) (mapcar '(lambda (%)(nth Idx %)) Lst) )
Teraz wywołania:
(setq p (jk:LST_nth b 0))
zwraca ścieżki:
("D:\\Smietnik\\IMG_20180218_133113.jpg" "D:\\Smietnik\\IMG_20180218_133117.jpg" "D:\\Smietnik\\IMG_20180218_133144.jpg" "D:\\Smietnik\\IMG_20180221_190038.jpg")
potem iksy:
(setq x (jk:LST_nth b 1))
następnie igreki:
(setq y (jk:LST_nth b 2))
na koniec kąty:
(setq g (jk:LST_nth b 3))
oczywiście jeśli potrzeba zmień STR-ingi listy na liczby, tu dla igreków który wygląda tak:
("22.542074" "22.542074" "22.542074" "22.542191")
wywołujesz:
(mapcar 'read y)
zwraca:
(22.5421 22.5421 22.5421 22.5422) Powinno działać - w razie problemów daj znać.
-
kojacek otrzymał(a) reputację od alf w Szablony i skrypty startowe ZWPack
Odnośnie polecenia C:ZZ (ze skryptu), przełączającego FILLMODE, polecam szersze rozwiązania: https://kojacek.wordpress.com/2017/12/30/uproszczone-wyswietlanie-obiektow/
-
kojacek otrzymał(a) reputację od Pawcyk w Zapamiętywanie ostatniej wprowadzonej wartości
W mojej subiektywnej opinii, pomysł nieco chybiony. Co będzie gdy w tym samym katalogu będzie więcej plików rysunkowych? Wszystkie będą się odwoływać do tego samego pliku tekstowego? A co jeśli przypadkowo plik zostanie usunięty? Nie wiemy czemu ma to służyć, niemniej widzę chyba lepsze rozwiązania: zapamiętanie danych w rysunku np. Zmienna USERRn (ulotne - niezapamiętywane w sesji), lub jako dane niegraficzne - słownik w namedobjdict, a w nim XRecord (zapamiętane na stałe). Ponadto XData przypięta do jakiegoś obiektu, itp.
-
kojacek otrzymał(a) reputację od dmatusz3 w Punkt przecięcia podczas przesuwania [rozwiązany]
Również działa poprawnie w każdej wersji AutoCAD-a, począwszy od wersji 13, czyli od...1994 roku.
-
kojacek otrzymał(a) reputację od JasW w Wyświetlanie etykiety z odległością i kątem - rozszerzenie funkcji [Wprowadzono w ZWCAD 2018]
To jak rozumiem przejęzyczenie? W AC AutoTrack działa w każdym (predefiniowanym i dowolnie ustalonym) układzie:
Ponadto mechanizmy śledzenia i wprowadzania dynamicznego, działają wszędzie, a w zależności od sytuacji dostępne są wszelkie możliwe opcje wywoływane tab-em, klawiszami strzałek itd.
-
kojacek otrzymał(a) reputację od kruszynski w Tworzenie nowego układu
Nie ma problemu. Zainteresuj się CADPL-Pack'iem: http://forum.cad.pl/cadpl-pack-v1-lsp-t78161.html
Potem, wczytaj go, oraz poniższą funkcję:
(defun -MakeLayout (Start End Pref / i n l) (setq i Start l (layoutlist) ) (while (< i End) (progn (setq n (strcat Pref (itoa i))) (if (not (member n l)) (vla-Add (cd:ACX_Layouts) n) ) (setq i (1+ i) l (cons n l)) ) ) ) Ma ona trzy argumenty: Start - to liczba całkowita od jakiej zaczyna się licznik, End - to koniec, Pref to łańcuch tekstowy, nazwy układu.
Wywołujesz ją w ten sposób:
(-MakeLayout 1 201 "Szkic") i po chwili masz te Layouty...
kojacek (https://kojacek.wordpress.com)
-
kojacek otrzymał(a) reputację od dmatusz3 w Rozwój wersji 2017
Wielkość i ilość poprawek do ostatniego ZwCAD-a (kroczącego nieustannie gdzieś między wersją alpha i ciągle jeszcze bardzo wczesną beta), pozwala przypuszczać że ów "bieg czasu" będzie bardzo długi. Przy spełnieniu warunku że "odpowiednik" w tym czasie nie będzie zmierzał do przodu...
-
kojacek otrzymał(a) reputację od gruzin w Przełączanie koloru tła
zgrabniej może być tak:
(setvar "BKGCOLOR" (abs (- 7 (getvar "BKGCOLOR"))))
-
kojacek otrzymał(a) reputację od jacnightingale w Przełączanie koloru tła
zgrabniej może być tak:
(setvar "BKGCOLOR" (abs (- 7 (getvar "BKGCOLOR"))))
-
kojacek otrzymał(a) reputację od dmatusz3 w Rysowanie seryjne linii z grotem, jedna za drugą.
Bierzesz plik z załącznika. Wklejasz sobie do jakiegoś katalogu. W Ac (czy Zw) uruchamiasz polecenie appload, wybierasz plik i zatwierdzasz. Po załadowaniu, masz dostępne polecenie L-LINIA.
Na marginesie, jeśli chodzi o ładowanie lsp, arx, dll, zrx itd, czy ogólnie o korzystaniu z możliwości adaptacji, mógłbyś wykazać więcej swojego zaangażowania i dowiedzieć się w help-ie, poprzeglądać to czy inne fora cad...
l-line.lsp
-
kojacek otrzymał(a) reputację od Harry w Bloki (dynamiczne)
Tutaj szerszy opis: https://kojacek.wordpress.com/autolisp/obiekty-niegraficzne/tablice-symboli/blok-effectivename/
-
kojacek otrzymał(a) reputację od Harry w Bloki (dynamiczne)
Zagadnienie (bo nie problem) w AutoCAD, było (na polskim forum CAD) omawiane już wiele lat temu (gdy tylko pojawiły się bloki dynamiczne). Droga jest stosunkowo prosta: Odniesienie (wstawienie) bloku (mające nazwę anonimową) jest dynamicznym blokiem zależnym od nazwanego bloku dynamicznego, po spełnieniu warunków - (1) jego definicja posiada dane dodatkowe aplikacji o nazwie "AcDbBlockRepBTag", oraz (2) zawiera (w tych danych dodatkowych) odniesienie do uchwytu (handle) obiektu, który jest definicją bloku nazwanego.
W zestawie funkcji CADPL-Pack, (http://forum.cad.pl/cadpl-pack-v1-lsp-t78161.html) zdefiniowana jest funkcja o nazwie cd:BLK_GetDynBlockNames. Zwraca ona listę wszystkich nazw odniesień (bloków anonimowych) zależnych.
-
kojacek otrzymał(a) reputację od Marek-M w Importowanie i eksportowanie właściwości rysunku
Dyskusje na ten temat w przeszłości miały już miejsce:
http://forum.cad.pl/przenoszenie-w-a-ciwo-ci-rysunku-drawing-properties-t79709.html?
oraz:
http://forum.cad.pl/cadpl-pack-v1-lsp-t78158-100.html
Niezmiennie polecam zatem CADPL-Pack'a, do tychże zastosowań, z uwzględnieniem funkcji:
cd:DWG_AddCustomProp cd:DWG_GetCustomProp cd:DWG_RemoveCustomProp cd:DWG_GetSummaryInfo cd:DWG_SetSummaryInfo
oraz innych, do zapisu / odczytu plików tekstowych - tamże
-
kojacek otrzymał(a) reputację od perlon w [VisualLISP] Wczytywanie typów linii
Próbowałeś: cd:ACX_LoadLineType z: http://forum.cad.pl/cadpl-pack-v1-lsp-t78161.html ?
-
kojacek otrzymał(a) reputację od pawmal w Wyciągnięcie bryły pomiędzy dwoma punktami (po linii prostej).
Kolejny etap do testowania... Jeśli chodzi powinien:
1) Rozpoznawać prawidłowe bloki
2) "Urozmaicić wybór", poprzez: podanie nazwy z ręki / wybranie z listy / wskazanie bloku
3) Zapamiętywać ostatnie ustawienia
4) No i polecenie ma skrócone - teraz jest B3D
Kod:
; =========================================================================================== ; (load "CADPL-Pack-v1.lsp" -1) ; =========================================================================================== ; (defun C:B3D ()(ExtrIns)(princ)) ; =========================================================================================== ; (defun ExtrIns (/ LBlk InsName StartP EndP PathEnt InsObj) (if (not (setq LBlk (BlockProfileList))) (princ "\nW rysunku nie zdefiniowano bloków dla profili. ") (progn (if (not *B3D-Settings*)(setq *B3D-Settings* (list (car LBlk) 1.0))) (if (setq StartP (getpoint "\nPierwszy punkt linii definiującej ścieżkę: ")) (if (setq EndP (getpoint StartP "\nKoniec ścieżki: ")) (if (setq InsName (GetBlockProfileName LBlk)) (progn (cd:SYS_UndoBegin) (setq InsObj (cd:BLK_InsertBlock StartP InsName '(1 1 1) 0 T)) (SetInsertZOrient (NewVect StartP EndP) (setq InsObj (vlax-vla-object->ename InsObj)) ) (setq PathEnt (cd:ENT_MakeLine (getvar "CTAB") StartP EndP T)) (ExtrudeProfile (vlax-ename->vla-object InsObj) PathEnt) (cd:SYS_UndoEnd) ) ) ) ) ) ) ) ; =========================================================================================== ; (defun GetBlockProfileName (LProf / f k s) (setq f (car *B3D-Settings*) s (car (mapcar '(lambda (%)(cd:STR_ReParse LProf %))(list " "))) ) (initget (strcat "Lista Wybierz " s)) (setq k (vl-catch-all-apply 'getkword (list (strcat "\nProfil [Lista/Wybierz] lub podaj nazwę <" f ">: ")) ) ) (if (not k) f (if (= (type k) 'STR) (cond ( (= k "Lista")(ProfileDlg LProf)) ( (= k "Wybierz")(SelectBlock LProf)) (t k) ) ) ) ) ; =========================================================================================== ; (defun ProfileDlg (BlkL / r p) (setq r (cd:DCL_StdListDialog BlkL (vl-position (car *B3D-Settings*) BlkL) "Profile" "Wybierz:" 25 12 2 12 (list "&Ok" "&Anuluj") nil T T nil) ) (if r (progn (setq p (nth r BlkL)) (setq *B3D-Settings* (list p (cadr *B3D-Settings*)))) ) p ) ; =========================================================================================== ; (defun SelectBlock (Lst / e d s) (if (and (setq e (entsel "\nWybierz blok: ")) (setq d (entget (car e))) (= "INSERT" (cdr (assoc 0 d))) (member (strcase (setq s (cdr (assoc 2 d)))) (mapcar 'strcase Lst) ) ) (progn (setq *B3D-Settings* (list s (cadr *B3D-Settings*))) s ) ) ) ; =========================================================================================== ; (defun ExtrudeProfile (Blk Lin / Prf Crv Reg Del) (vla-explode Blk) (setq Prf (entlast)) (vla-delete Blk) (if (cond ( (= "LWPOLYLINE" (cdr (assoc 0 (entget Prf)))) (setq Crv (vlax-make-safearray vlax-vbObject '(0 . 0))) (vlax-safearray-put-element Crv 0 (vlax-ename->vla-object Prf)) (setq Reg (vla-AddRegion (cd:ACX_ASpace) Crv)) ) ( (= "REGION" (cdr (assoc 0 (entget Prf)))) (setq Reg (vlax-ename->vla-object Prf)) ) (t nil) ) (progn (vla-AddExtrudedSolidAlongPath (cd:ACX_ASpace) (if (= (type Reg )'VLA-OBJECT) Reg (setq Del (vlax-safearray-get-element (vlax-variant-value Reg) 0)) ) (vlax-ename->vla-object Lin) ) (if Del (vla-delete Del)) (foreach % (list Lin Prf)(entdel %)) ) ) ) ; =========================================================================================== ; (defun NewVect (p1 p2 / dt sq sm um uv) (setq dt (mapcar '- p2 p1) sq (mapcar '* dt dt) sm (apply '+ sq) um (sqrt sm) uv (mapcar '/ dt (list um um um)) ) ) ; =========================================================================================== ; (defun SetInsertZOrient (ExtrVec Ename / e b) (setq e (entget Ename) b (trans (cdr (assoc 10 e)) Ename ExtrVec) e (subst (cons 10 b)(assoc 10 e) e) e (subst (cons 50 0.0)(assoc 50 e) e) e (subst (cons 210 ExtrVec)(assoc 210 e) e) ) (entmod e) ) ; =========================================================================================== ; (defun BlockProfile-p (Name / l d) (if (= 1 (length (setq l (cd:BLK_GetEntity Name nil)))) (progn (setq d (entget (car l))) (or (and (= (cdr (assoc 0 d)) "LWPOLYLINE") (= 1 (logand 1 (cdr (assoc 70 d)))) ) (= (cdr (assoc 0 d)) "REGION") ) ) ) ) ; =========================================================================================== ; (defun BlockProfileList (/ l) (if (setq l (cd:SYS_CollList "BLOCK" (+ 1 2 4 8))) (acad_strlsort (vl-remove-if-not '(lambda (%)(BlockProfile-p %)) l)) ) ) ; =========================================================================================== ; (princ "\nZaładowano polecenie: B3D ") (princ) -
kojacek otrzymał(a) reputację od pawmal w Najmniejszy opisany prostokąt - LISP
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.
-
kojacek otrzymał(a) reputację od Iskra w Najmniejszy opisany prostokąt - LISP
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?
-
kojacek otrzymał(a) reputację od Iskra w Najmniejszy opisany prostokąt - LISP
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. ") ) )