kojacek

Użytkownik forum
  • Postów

    253
  • Dołączył

  • Ostatnia wizyta

  • Wygrane w rankingu

    36

Aktywność reputacji

  1. Upvote
    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:
  2. Upvote
    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.

  3. Like
    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:

  4. Upvote
    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")  
  5. Like
    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")  
  6. Upvote
    kojacek otrzymał(a) reputację od Chris w ZWCAD 2020 - ciąg wymiarowy   
    Take?

  7. Upvote
    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))) 😉
  8. Upvote
    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ć.
     
  9. Like
    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/ 
  10. Upvote
    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.
  11. Downvote
    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.
  12. Upvote
    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. 
  13. Upvote
    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)
  14. Downvote
    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...
  15. Upvote
    kojacek otrzymał(a) reputację od gruzin w Przełączanie koloru tła   
    zgrabniej może być tak:
    (setvar "BKGCOLOR" (abs (- 7 (getvar "BKGCOLOR"))))  
  16. Upvote
    kojacek otrzymał(a) reputację od jacnightingale w Przełączanie koloru tła   
    zgrabniej może być tak:
    (setvar "BKGCOLOR" (abs (- 7 (getvar "BKGCOLOR"))))  
  17. Upvote
    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
  18. Upvote
    kojacek otrzymał(a) reputację od Harry w Bloki (dynamiczne)   
    Tutaj szerszy opis: https://kojacek.wordpress.com/autolisp/obiekty-niegraficzne/tablice-symboli/blok-effectivename/
  19. Upvote
    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.
  20. Upvote
    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
  21. Upvote
    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 ?
  22. Upvote
    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)
  23. Upvote
    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.
  24. Upvote
    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?
  25. Upvote
    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. ")   ) )