_

[Lisp] CadPack propozycja DCL_StdQuickOptionsDialog

Forum poświęcone flagowemu produktowi oraz aplikacjom pochodnym Autodesku. To jedyne forum mające w tytule nazwę programu, a to ze względu na jego olbrzymią popularność w Polsce. Można tutaj umieszczać również posty z ogólnie pojętej tematyki "Kreślarskie 2D".

Re: [Lisp] CadPack propozycja DCL_StdQuickOptionsDialog

Postprzez kruuger » cze 28, 2017 14:07

ziele_o2k napisał(a):Zasady nie ma żadnej jak to działa. Testowane na win 7 i win 10 autocad 2017 2014 2007 i chińczyk

a jak takie, ktore jest w miare luzne, nie jest ciasno? zachowuje rozmiar?
tak, okno sie rozciaga zeby pomiescic kontrolki. kazda ma jakies swoje minimum.
faktycznie value i label daje inny efekt.

co ciekawe jesli juz w dcl wpiszemy jakas label do text to okno dostosuje sie tak, aby wyswietlic cala zawartosc.
jesli jednak label nadamy lispem to tekst moze zostac przyciety. czasem sie przydaje zeby okno sie nie rozkraczalo za bardzo.
Załączniki
taknie2.png
taknie2.png (4.26 KiB) Przeglądane 202 razy
Taknie2.dcl
(959 Bajtów) Pobrane 2 razy
Avatar użytkownika
kruuger
 
Posty: 4765
Dołączył(a): paź 27, 2005 20:14
Lokalizacja: Kraków

Re: [Lisp] CadPack propozycja DCL_StdQuickOptionsDialog

Postprzez MarCho » cze 28, 2017 14:13

kruuger napisał(a):
MarCho napisał(a):może 3 kolumny: toggle - text opisu - edit(lub popup)
aktywne w zależności od wprowadzanych danych?

chyba zbedne skoro dynamicznie tworzymy okno to mozna je od razu pominac.


słusznie, można, nawet lepiej wygląda :)
MarCho
 
Posty: 31
Dołączył(a): paź 12, 2010 08:15

Re: [Lisp] CadPack propozycja DCL_StdQuickOptionsDialog

Postprzez ziele_o2k » cze 29, 2017 00:03

Na roboczo wersja, a tutaj uwagi:
  1. Label jako text tile - do zmiany
  2. funkcja sprawdzająca zawartość edit_boxa _CheckVal jest w niektórych miejscach zmieniona tak, żeby dostosować ją do naszych potrzeb. Największą zmianą jest zapisanie na sztywno opisów errtile. Moim zdaniem definiowanie tego dla każdego edit_boxa jest zbyt skomplikowane. W danych wejściowych podajemy teraz tylko Bit, a _CheckVal robi resztę.
  3. w poleceniu cd:DCL_StdEditBoxDialog domyślna wartość edit_boxa była sprawdzana na wejściu. Tutaj trochę namieszałem, ale wybrnąłem z tego tak, że może i wejdziemy do okienka i może w polach ediit_box będą złe wartości, ale nie wyjdziemy, dopóki wszystkie nie zostaną poprawione :)
  4. Kod jeszcze muszę sprawdzić, bo mogły jakieś śmieci zostać, ale testować można
  5. Dokładny opis funkcji do zrobienia
Funkcja:
Kod: Zaznacz cały
(defun cd:DCL_StdQuickOptionsDialog (Data Default Title WidthColA WidthColB BtnsWidth BtnsLabel DPos
                                     / *error* inc keys_A keys_B fd tmp dc defval res _CheckVal)
  (defun _CheckVal (Code Bit Val Key DataCV / tmp _Logand _IsBlank _IsSpaces _Pattern _UserList
                                   _Error _StrUnit _Nth _IsNumb res err)
    (princ(last (nth (vl-position Key (mapcar 'cadr Data)) Data)))
    (if
      (and
        (not Code)
        (not Bit)
        Val
        Key
        (not DataCV)
      )
      (setq
        DataCV (last (nth (vl-position Key (mapcar 'cadr Data)) Data))
        Code (car DataCV)
        Bit (cadr DataCV)
      )
    )
    (defun _Logand (b) (= b (logand Bit b)))
    (defun _IsBlank (s) (= s ""))
    (defun _IsSpaces (s) (not (vl-remove '32 (vl-string->list s))))
    (defun _Pattern (s) (not (wcmatch s (_Nth 4))))
    (defun _UserList (s) (member (strcase Val) (mapcar (quote strcase) (_Nth 5))))
    (defun _Error (b) (setq err b))
    (defun _StrUnit (s) (distof s 3))
    (defun _Nth (n / p)
      (if (setq p (vl-catch-all-apply (quote nth) (list n DataCV)))
        p
        (vl-catch-all-error-p p)
      )
    )
    (defun _IsNumb (s b / r)
      (if (setq r (_StrUnit s))
        (cond
          ( (and (= 1 (logand 1 b)) (numberp r)) ) ; liczba / number
          ( (and (= 2 (logand 2 b)) (zerop r)) )   ; zero   / zero
          ( (and (= 4 (logand 4 b)) (minusp r)) )  ; ujemna / negative
          ( T nil )
        )
      )
    )
    (cond
      ( (= Code 0) ; dowolny lancuch / any string
        (cond
          ( (and (_Logand 1) (_IsBlank Val)) (_Error "Wypelnij pole") )         ; bez ""            / no ""
          ( (and (_Logand 8) (_IsSpaces Val)) (_Error "Bez samych spacji") )    ; bez samych spacji / no spaces
          ( T (setq res Val) )
        )
      )
      ( (= Code 1) ; lancuch zgodny z nazwa tablicy / string consistent with table name
        (cond
          ( (and (_Logand 1) (_IsBlank Val)) (_Error "Wypelnij pole") )                ; bez ""                  / no ""
          ( (and (_Logand 2) (not (snvalid Val))) (_Error "Niepoprawna nazwa") )       ; bez zlej nazwy snvalid  / no bad name
          ( (and (_Logand 4) (tblsearch (_Nth 3) Val)) (_Error "Nazwa już istnieje") ) ; bez istniejacych nazw   / no existing name
          ( (and (_Logand 8) (_IsSpaces Val)) (_Error "Bez samych spacji") )           ; bez samych spacji       / no spaces
          ( (and (_Logand 16) (_Pattern Val)) (_Error "Nie pasuje do wzorca") )        ; pasujacy do wzorca      / match pattern
          ( (and (_Logand 32) (_UserList Val)) (_Error "Nie wystepuje na liscie") )        ; nie wystepuje na liscie / does not appear in the list
          ( T (setq res Val) )
        )
      )
      ( (member Code (list 2 3)) ; INT = 2, REAL = 3
        (cond
          ( (and (_Logand 1) (_IsBlank Val)) (_Error "Wypelnij pole") )                 ; bez ""            / no ""
          ( (and (_Logand 2) (_IsNumb Val 2)) (_Error "Nie może być 0") )               ; bez zera          / no zero
          ( (and (_Logand 4) (_IsNumb Val 4)) (_Error "Nie może być <0") )              ; bez ujemnych      / no negative
          ( (and (_Logand 8) (_IsSpaces Val)) (_Error "Bez samych spacji") )            ; bez samych spacji / no spaces
          ( (and (_Logand 16) (not (_IsNumb Val 1))) (_Error "Tylko liczby") )          ; tylko liczby      / only number
          ( (and (_Logand 32) (> (_Nth 3) (_StrUnit Val))) (_Error "Wartość za mała") ) ; liczba za mala    / number to small
          ( (and (_Logand 64) (< (_Nth 4) (_StrUnit Val))) (_Error "Wartość za duża") ) ; liczba za duza    / number to big
          ( T
            (setq res
              (if (_IsNumb Val 1)
                (if (= Code 2)
                  (itoa (fix (_StrUnit Val)))
                  (cd:CON_Real2Str (_StrUnit Val) (_Nth 5) (_Nth 6))
                )
                Val
              )
            )
          )
        )
      )
      ( T nil )
    )
    (set_tile Key Val)
    (if err
      (progn (set_tile "error" err) (mode_tile Key 2))
      (progn (set_tile "error" "") )
    )
  )
  (if (not DPos) (setq *cd-TempDlgPosition* (list -1 -1)))
  (setq
    keys_A (mapcar '(lambda (%1) (cons (strcat "A_" (cadr %1)) (caddr %1))) Data)
  )
  (cond
    ( (not
        (and
          (setq fd
            (open
              (setq tmp (vl-FileName-MkTemp nil nil ".dcl")) "w"
            )
          )
          (foreach %
            (list
              (strcat
                "_BUTTON : button { width = " (if BtnsWidth (cd:CON_Real2Str BtnsWidth 2 3) "13") "; fixed_width = true; }"
                "_POPUP : popup_list { edit_width = " (if WidthColB (cd:CON_Real2Str (- WidthColB 0.8) 2 3) "20") "; }"
                "_EDITBOX : edit_box { edit_width = " (if WidthColB (cd:CON_Real2Str WidthColB 2 3) "20") "; }"
                "_TEXT : text { width = " (if WidthColA (cd:CON_Real2Str WidthColA 2 3) "20")";}"
                "StdQuickOptionsDialog : dialog {"
                (if Title (strcat "label = \"" Title "\";") "")
                ": row {"
                " : column {"
              )
              (cd:STR_ReParse
                (mapcar
                  '(lambda (%1)
                    (strcat ": _TEXT { key = \"" (car %1) "\";value = \"" (cdr %1) "\";}" )
                  )
                  keys_A
                )
                " "
              )
              (strcat
                "}"
                ": column {"
              )
              (cd:STR_ReParse
                (mapcar
                 '(lambda (%1)
                    (cond
                      ( (= (car %1) 0)
                        (strcat ": _POPUP { key = \"" (cadr %1) "\"; }")
                      )
                      ( (= (car %1) 1)
                        (strcat
                          ": _EDITBOX { key = \"" (cadr %1) "\";"
                          (if  (caddr (last %1)) (strcat "edit_limit = " (itoa (caddr (last %1))) ";") "")
                          "}"
                        )
                      )
                      (T nil)
                    )
                  )
                  Data
                )
                " "
              )
              (strcat
                " }"
                "}"
                ": spacer_1 {}"
                ": row { alignment = centered; fixed_width = true;"
                " : _BUTTON { key = \"" (car BtnsLabel) "\";"
                "   label = \"" (car BtnsLabel) "\"; is_default = true; }"
                " : _BUTTON { key = \"" (cadr BtnsLabel) "\";"
                "   label = \"" (cadr BtnsLabel) "\"; is_cancel = true; }"
                "} "
                (if (member 1 (mapcar 'car Data)) "errtile;" ":   spacer_1 {}")
                "}"
              )
            )
            (write-line % fd)
          )
          (not (close fd))
          (< 0 (setq dc (load_dialog tmp)))
          (new_dialog "StdQuickOptionsDialog" dc ""
            (cond
              ( *cd-TempDlgPosition* )
              ( (quote (-1 -1)) )
            )
          )
        )
      )
    )
    ( T
      (mapcar
       '(lambda (%1 %2)
          (cond
            ( (= (car %1) 0)
              (cd:DCL_SetList (cadr %1) (cadddr %1) (vl-position %2 (cadddr %1)))
            )
            ( (= (car %1) 1)
              (set_tile (cadr %1) %2)
            )
            ( T nil )
          )
        )
        Data
        Default
      )
      (foreach %1 Data
        (cond
          ( (= (car %1) 1)
            (action_tile (cadr %1)
              (vl-prin1-to-string
                (quote
                  (progn
                    (_CheckVal (car (last %1)) (cadr (last %1)) $value $key (last %1))
                  )
                )
              )
            )
          )
          ( T nil )
        )
      )
      (action_tile (car BtnsLabel)
        (vl-prin1-to-string
          (quote
            (progn
              (foreach %1 Data
                (cond
                  ( (= (car %1) 1)
                    (_CheckVal nil nil (get_tile (cadr %1)) (cadr %1) nil)
                  )
                  ( T nil )
                )
              )
              (if (or (= (get_tile "error") "") (not (member 1 (mapcar 'car Data))))
                (progn
                  (setq res
                    (mapcar
                     '(lambda (%1)
                        (cond
                          ( (= (car %1) 0)
                            (nth (atoi (get_tile (cadr %1))) (cadddr %1))
                          )
                          ( (= (car %1) 1)
                            (get_tile (cadr %1))
                          )
                        )
                      )
                      Data
                    )
                  )
                  (setq *cd-TempDlgPosition* (done_dialog 1))
                )
              )
            )
          )
        )
      )
      (action_tile (cadr BtnsLabel) "(setq res nil) (done_dialog 0)")
      (start_dialog)
    )
  )
  (if (< 0 dc) (unload_dialog dc))
  (if (setq tmp (findfile tmp)) (vl-file-delete tmp))
  (if (not DPos) (setq *cd-TempDlgPosition* (list -1 -1)))
  res
)

Funkcja do testowania:
już mi się nie chce pisać, może jutro coś ładnego wrzucę, a teraz tylko to:
Kod: Zaznacz cały
(defun c:tese ( / *error* )
  (defun *error* (msg / so)
   (cond
     ((not msg))
     ((member msg '("Function cancelled" "quit / exit abort")))
     (
       (princ (strcat "\n  <!>  Error: " msg "  <!> "))
       (cond (T (vl-bt)))
     )
   )
   (princ)
  )
  (cd:DCL_StdQuickOptionsDialog
    (list
      (list
        0
        "Popup_1"
        "Poziom odniesienia dla  tej analizy"
        '("Względny" "Bezwzględny")
      )
      (list
        1
        "Edit_1"
        "Podaj rzędną"
        '(3 25 nil nil nil 2 2)
      )
    )
    '("Względny" "asd" "Kropka")
    "Test by ziele_o2k"
    15 10 15 '("&Ok" "&Anluluj") T
  )
)
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 469
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

Re: [Lisp] CadPack propozycja DCL_StdQuickOptionsDialog

Postprzez ziele_o2k » cze 29, 2017 13:25

Jeszcze jeden pomysł. Poza popup_list i edit_box dać jeszcze button :)
Kod: Zaznacz cały
(defun cd:DCL_StdQuickOptionsDialog (Data Default Title WidthColA WidthColB BtnsWidth BtnsLabel DPos
                                     / *error* inc keys_A keys_B fd tmp dc defval res _CheckVal)
  (defun _ButtonAction (Key)
    (cadr (last (nth (vl-position Key (mapcar 'cadr Data)) Data)))
  )
  (defun _CheckVal (Code Bit Val Key DataCV / tmp _Logand _IsBlank _IsSpaces _Pattern _UserList
                                   _Error _StrUnit _Nth _IsNumb res err)
    (if
      (and
        (not Code)
        (not Bit)
        Val
        Key
        (not DataCV)
      )
      (setq
        DataCV (last (nth (vl-position Key (mapcar 'cadr Data)) Data))
        Code (car DataCV)
        Bit (cadr DataCV)
      )
    )
    (defun _Logand (b) (= b (logand Bit b)))
    (defun _IsBlank (s) (= s ""))
    (defun _IsSpaces (s) (not (vl-remove '32 (vl-string->list s))))
    (defun _Pattern (s) (not (wcmatch s (_Nth 4))))
    (defun _UserList (s) (member (strcase Val) (mapcar (quote strcase) (_Nth 5))))
    (defun _Error (b) (setq err b))
    (defun _StrUnit (s) (distof s 3))
    (defun _Nth (n / p)
      (if (setq p (vl-catch-all-apply (quote nth) (list n DataCV)))
        p
        (vl-catch-all-error-p p)
      )
    )
    (defun _IsNumb (s b / r)
      (if (setq r (_StrUnit s))
        (cond
          ( (and (= 1 (logand 1 b)) (numberp r)) ) ; liczba / number
          ( (and (= 2 (logand 2 b)) (zerop r)) )   ; zero   / zero
          ( (and (= 4 (logand 4 b)) (minusp r)) )  ; ujemna / negative
          ( T nil )
        )
      )
    )
    (cond
      ( (= Code 0) ; dowolny lancuch / any string
        (cond
          ( (and (_Logand 1) (_IsBlank Val)) (_Error "Wypelnij pole") )         ; bez ""            / no ""
          ( (and (_Logand 8) (_IsSpaces Val)) (_Error "Bez samych spacji") )    ; bez samych spacji / no spaces
          ( T (setq res Val) )
        )
      )
      ( (= Code 1) ; lancuch zgodny z nazwa tablicy / string consistent with table name
        (cond
          ( (and (_Logand 1) (_IsBlank Val)) (_Error "Wypelnij pole") )                ; bez ""                  / no ""
          ( (and (_Logand 2) (not (snvalid Val))) (_Error "Niepoprawna nazwa") )       ; bez zlej nazwy snvalid  / no bad name
          ( (and (_Logand 4) (tblsearch (_Nth 3) Val)) (_Error "Nazwa już istnieje") ) ; bez istniejacych nazw   / no existing name
          ( (and (_Logand 8) (_IsSpaces Val)) (_Error "Bez samych spacji") )           ; bez samych spacji       / no spaces
          ( (and (_Logand 16) (_Pattern Val)) (_Error "Nie pasuje do wzorca") )        ; pasujacy do wzorca      / match pattern
          ( (and (_Logand 32) (_UserList Val)) (_Error "Nie wystepuje na liscie") )    ; nie wystepuje na liscie / does not appear in the list
          ( T (setq res Val) )
        )
      )
      ( (member Code (list 2 3)) ; INT = 2, REAL = 3
        (cond
          ( (and (_Logand 1) (_IsBlank Val)) (_Error "Wypelnij pole") )                 ; bez ""            / no ""
          ( (and (_Logand 2) (_IsNumb Val 2)) (_Error "Nie może być 0") )               ; bez zera          / no zero
          ( (and (_Logand 4) (_IsNumb Val 4)) (_Error "Nie może być <0") )              ; bez ujemnych      / no negative
          ( (and (_Logand 8) (_IsSpaces Val)) (_Error "Bez samych spacji") )            ; bez samych spacji / no spaces
          ( (and (_Logand 16) (not (_IsNumb Val 1))) (_Error "Tylko liczby") )          ; tylko liczby      / only number
          ( (and (_Logand 32) (> (_Nth 3) (_StrUnit Val))) (_Error "Wartość za mała") ) ; liczba za mala    / number to small
          ( (and (_Logand 64) (< (_Nth 4) (_StrUnit Val))) (_Error "Wartość za duża") ) ; liczba za duza    / number to big
          ( T
            (setq res
              (if (_IsNumb Val 1)
                (if (= Code 2)
                  (itoa (fix (_StrUnit Val)))
                  (cd:CON_Real2Str (_StrUnit Val) (_Nth 5) (_Nth 6))
                )
                Val
              )
            )
          )
        )
      )
      ( T nil )
    )
    (set_tile Key Val)
    (if err
      (progn (set_tile "error" err) (mode_tile Key 2))
      (progn (set_tile "error" "") )
    )
  )
  (if (not DPos) (setq *cd-TempDlgPosition* (list -1 -1)))
  (setq
    keys_A (mapcar '(lambda (%1) (cons (strcat "A_" (cadr %1)) (caddr %1))) Data)
    flag 2
  )
  (cond
    ( (not
        (and
          (setq fd
            (open
              (setq tmp (vl-FileName-MkTemp nil nil ".dcl")) "w"
            )
          )
          (foreach %
            (list
              (strcat
                "_BUTTON : button { width = " (if BtnsWidth (cd:CON_Real2Str BtnsWidth 2 3) "13") "; fixed_width = true; }"
                "_POPUP : popup_list { edit_width = " (if WidthColB (cd:CON_Real2Str (- WidthColB 0.8) 2 3) "20") "; }"
                "_EDITBOX : edit_box { edit_width = " (if WidthColB (cd:CON_Real2Str WidthColB 2 3) "20") "; }"
                "_TEXT : text { width = " (if WidthColA (cd:CON_Real2Str WidthColA 2 3) "20")";}"
                "_BUTTON2 : button { width = " (if WidthColB (cd:CON_Real2Str (+ WidthColB 2) 2 3) "20") ";fixed_width = true;}"
                "StdQuickOptionsDialog : dialog {"
                (if Title (strcat "label = \"" Title "\";") "")
              )
              (cd:STR_ReParse
                (mapcar
                 '(lambda (%1)
                    (cond
                      ( (= (car %1) 0)
                        (strcat ": _POPUP { key = \"" (cadr %1) "\"; label = \"" (caddr %1) "\"; }")
                      )
                      ( (= (car %1) 1)
                        (strcat
                          ": _EDITBOX { key = \"" (cadr %1) "\"; label = \"" (caddr %1) "\";"
                          (if  (caddr (last %1)) (strcat "edit_limit = " (itoa (caddr (last %1))) ";") "")
                          "}"
                        )
                      )
                      ( (= (car %1) 2)
                        (strcat
                          ": row {"
                          (strcat ": text { key = \"" (strcat "A_" (cadr %1)) "\";label = \"" (caddr %1) "\";}" )
                          ": _BUTTON2 { key = \"" (cadr %1) "\"; label = \"" (car (last %1)) "\";"
                          "}}"
                        )
                      )
                      (T nil)
                    )
                  )
                  Data
                )
                " "
              )
              (strcat
                ": spacer_1 {}"
                ": row { alignment = centered; fixed_width = true;"
                " : _BUTTON { key = \"" (car BtnsLabel) "\";"
                "   label = \"" (car BtnsLabel) "\"; is_default = true; }"
                " : _BUTTON { key = \"" (cadr BtnsLabel) "\";"
                "   label = \"" (cadr BtnsLabel) "\"; is_cancel = true; }"
                "} "
                (if (member 1 (mapcar 'car Data)) "errtile;" ":   spacer_1 {}")
                "}"
              )
            )
            (write-line % fd)
          )
          (not (close fd))
          (< 0 (setq dc (load_dialog tmp)))
        )
      )
    )
    ( T
      (while (> flag 1)
        (if
          (not
            (new_dialog "StdQuickOptionsDialog" dc ""
              (cond
                ( *cd-TempDlgPosition* )
                ( (quote (-1 -1)) )
              )
            )
          )
          (exit)
        )
        (mapcar
         '(lambda (%1 %2)
            (cond
              ( (= (car %1) 0)
                (cd:DCL_SetList (cadr %1) (cadddr %1) (vl-position %2 (cadddr %1)))
              )
              ( (= (car %1) 1)
                (set_tile (cadr %1) %2)
              )
              ( T nil )
            )
          )
          Data
          Default
        )
        (foreach %1 Data
          (cond
            ( (= (car %1) 1)
              (action_tile (cadr %1)
                (vl-prin1-to-string
                  (quote
                    (progn
                      (_CheckVal (car (last %1)) (cadr (last %1)) $value $key (last %1))
                    )
                  )
                )
              )
            )
            ( (= (car %1) 2)
              (action_tile (cadr %1)
                (vl-prin1-to-string
                  (quote
                    (progn
                      (setq func (_ButtonAction $key))
                      (setq Default
                        (mapcar
                         '(lambda (%1)
                            (cond
                              ( (= (car %1) 0)
                                (nth (atoi (get_tile (cadr %1))) (cadddr %1))
                              )
                              ( (= (car %1) 1)
                                (get_tile (cadr %1))
                              )
                            )
                          )
                          Data
                        )
                      )
                      (setq *cd-TempDlgPosition* (done_dialog 2))
                    )
                  )
                )
              )
            )
            ( T nil )
          )
        )
        (action_tile (car BtnsLabel)
          (vl-prin1-to-string
            (quote
              (progn
                (foreach %1 Data
                  (cond
                    ( (= (car %1) 1)
                      (_CheckVal nil nil (get_tile (cadr %1)) (cadr %1) nil)
                    )
                    ( T nil )
                  )
                )
                (if (or (= (get_tile "error") "") (not (member 1 (mapcar 'car Data))))
                  (progn
                    (setq res
                      (mapcar
                       '(lambda (%1)
                          (cond
                            ( (= (car %1) 0)
                              (nth (atoi (get_tile (cadr %1))) (cadddr %1))
                            )
                            ( (= (car %1) 1)
                              (get_tile (cadr %1))
                            )
                            ( (= (car %1) 2)
                              (get_tile (cadr %1))
                            )
                          )
                        )
                        Data
                      )
                    )
                    (setq *cd-TempDlgPosition* (done_dialog 1))
                  )
                )
              )
            )
          )
        )
        (action_tile (cadr BtnsLabel) "(setq res nil) (done_dialog 0)")
        (setq flag (start_dialog))
        (if (> flag 1)
          (eval func)
        )
      )
    )
  )
  (if (< 0 dc) (unload_dialog dc))
  (if (setq tmp (findfile tmp)) (vl-file-delete tmp))
  (if (not DPos) (setq *cd-TempDlgPosition* (list -1 -1)))
  res
)

testować z:
Kod: Zaznacz cały
(defun c:tese2 ( / pt )
  (cd:DCL_StdQuickOptionsDialog
    (list
      (list
        0
        "Popup_1"
        "&Poziom odniesienia dla  tej analizy"
        '("Względny" "Bezwzględny")
      )
      (list
        1
        "Edit_1"
        "Po&daj rzędną"
        '(3 25 nil nil nil 2 2)
      )
      (list
        2
        "Button_1"
        "Zmień poziom odniesienia"
        '(
          "&Zmień <"
          (setq pt (getpoint "\nWskaż nowy punkt bazowy"))
        )
      )
    )
    '("Względny" "asd" nil)
    "Test by ziele_o2k"
    15 15 15 '("&Ok" "&Anluluj") T
  )
)
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 469
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

Re: [Lisp] CadPack propozycja DCL_StdQuickOptionsDialog

Postprzez kojacek » cze 29, 2017 13:31

O! Coś się ruszyło. Brawo Ziele. Muszę dopiero poczytać i nadrobić... bom za późno wszedł i jakby trochę z czasem nie za bardzo. Wygląda zachęcająco :)
Avatar użytkownika
kojacek
 
Posty: 5235
Dołączył(a): paź 03, 2005 20:17

Re: [Lisp] CadPack propozycja DCL_StdQuickOptionsDialog

Postprzez ziele_o2k » cze 29, 2017 14:05

kojacek napisał(a):O! Coś się ruszyło. Brawo Ziele. Muszę dopiero poczytać i nadrobić... bom za późno wszedł i jakby trochę z czasem nie za bardzo. Wygląda zachęcająco :)

Tak się zastanawiałem czemu wrona nie kracze :)
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 469
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

Re: [Lisp] CadPack propozycja DCL_StdQuickOptionsDialog

Postprzez kruuger » cze 29, 2017 14:57

ziele_o2k napisał(a):
kojacek napisał(a):O! Coś się ruszyło. Brawo Ziele. Muszę dopiero poczytać i nadrobić... bom za późno wszedł i jakby trochę z czasem nie za bardzo. Wygląda zachęcająco :)

Tak się zastanawiałem czemu wrona nie kracze :)

ja niestety od jutra znikam na 2tyg wiec poki co nic nie podumam. ale zastanawiam sie czy w jakis sposob nie wydzielic funkcji _CheckVal z DCL_StdEditBoxDialog co by nie pzrzepisywac tego tutaj ponownie. jako osobna funkcja w pack? nie wiem czy w ogole tak sie da, nie rozkminialem tego jeszcze dobrze.
funkcja testowa TESE wyglada juz bardzo zwiezle i faktycznie mozna latwo zrobic szybkie ustawienia.
k.
Avatar użytkownika
kruuger
 
Posty: 4765
Dołączył(a): paź 27, 2005 20:14
Lokalizacja: Kraków

Re: [Lisp] CadPack propozycja DCL_StdQuickOptionsDialog

Postprzez ziele_o2k » cze 29, 2017 15:54

kruuger napisał(a):
ziele_o2k napisał(a):
kojacek napisał(a):O! Coś się ruszyło. Brawo Ziele. Muszę dopiero poczytać i nadrobić... bom za późno wszedł i jakby trochę z czasem nie za bardzo. Wygląda zachęcająco :)

Tak się zastanawiałem czemu wrona nie kracze :)

ja niestety od jutra znikam na 2tyg wiec poki co nic nie podumam. ale zastanawiam sie czy w jakis sposob nie wydzielic funkcji _CheckVal z DCL_StdEditBoxDialog co by nie pzrzepisywac tego tutaj ponownie. jako osobna funkcja w pack? nie wiem czy w ogole tak sie da, nie rozkminialem tego jeszcze dobrze.
funkcja testowa TESE wyglada juz bardzo zwiezle i faktycznie mozna latwo zrobic szybkie ustawienia.
k.

_CheckVal moim zdaniem da się wywalić z DCL_StdEditBoxDialog. Będzie miało trochę inną formę, ale damy radę. Pomysł jakiś tam mam, ale trzeba pokombinować.
W sumie nawet dobrze by było to zrobić jako oddzielną funkcję, bo jest tutaj praktycznie pełna obsługa wartości edit_boxów.
Na kilka dni wstrzymam się z pisaniem (też z czasem bida), kojacek wczyta się w temat, a kruuger wróci na gotowe ;)
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 469
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

Re: [Lisp] CadPack propozycja DCL_StdQuickOptionsDialog

Postprzez ziele_o2k » lip 06, 2017 01:31

No to tak:
Wyciągnąłem funkcję _CheckVal, zrobiłem z tego DCL_CheckEditBoxValue i zwraca numer errora, a jak nie było błędu to string z poprawną wartością. I tutaj od razu uwaga - nie podoba mi się to Data w wartościach, które trza podać więc i tak do zmiany. Pokombinuję jeszcze - nie sprawdzałem co robi funkcja _Nth i po co ona jest.
Kod: Zaznacz cały
(defun cd:DCL_CheckEditBoxValue (Code Bit Val Data / _Logand _IsBlank _IsSpaces _Pattern _UserList
                                 _Error _StrUnit _Nth _IsNumb res)

  (defun _Logand (b) (= b (logand Bit b)))
  (defun _IsBlank (s) (= s ""))
  (defun _IsSpaces (s) (not (vl-remove '32 (vl-string->list s))))
  (defun _Pattern (s) (not (wcmatch s (_Nth 4))))
  (defun _UserList (s) (member (strcase Val) (mapcar (quote strcase) (_Nth 5))))
  (defun _Error (b) (setq res b))
  (defun _StrUnit (s) (distof s 3))
  (defun _Nth (n / p)
    (if (setq p (vl-catch-all-apply (quote nth) (list n Data)))
      p
      (vl-catch-all-error-p p)
    )
  )
  (defun _IsNumb (s b / r)
    (if (setq r (_StrUnit s))
      (cond
        ( (and (= 1 (logand 1 b)) (numberp r)) ) ; liczba / number
        ( (and (= 2 (logand 2 b)) (zerop r)) )   ; zero   / zero
        ( (and (= 4 (logand 4 b)) (minusp r)) )  ; ujemna / negative
        ( T nil )
      )
    )
  )
  (cond
    ( (= Code 0) ; dowolny lancuch / any string
      (cond
        ( (and (_Logand 1) (_IsBlank Val)) (_Error 1) )  ; bez ""            / no ""
        ( (and (_Logand 8) (_IsSpaces Val)) (_Error 8) ) ; bez samych spacji / no spaces
        ( T (setq res Val) )
      )
    )
    ( (= Code 1) ; lancuch zgodny z nazwa tablicy / string consistent with table name
      (cond
        ( (and (_Logand 1) (_IsBlank Val)) (_Error 1) )           ; bez ""                  / no ""
        ( (and (_Logand 2) (not (snvalid Val))) (_Error 2) )      ; bez zlej nazwy snvalid  / no bad name
        ( (and (_Logand 4) (tblsearch (_Nth 3) Val)) (_Error 4) ) ; bez istniejacych nazw   / no existing name
        ( (and (_Logand 8) (_IsSpaces Val)) (_Error 8) )          ; bez samych spacji       / no spaces
        ( (and (_Logand 16) (_Pattern Val)) (_Error 16) )         ; pasujacy do wzorca      / match pattern
        ( (and (_Logand 32) (_UserList Val)) (_Error 32) )        ; nie wystepuje na liscie / does not appear in the list
        ( T (setq res Val) )
      )
    )
    ( (member Code (list 2 3)) ; INT = 2, REAL = 3
      (cond
        ( (and (_Logand 1) (_IsBlank Val)) (_Error 1) )                ; bez ""            / no ""
        ( (and (_Logand 2) (_IsNumb Val 2)) (_Error 2) )               ; bez zera          / no zero
        ( (and (_Logand 4) (_IsNumb Val 4)) (_Error 4) )               ; bez ujemnych      / no negative
        ( (and (_Logand 8) (_IsSpaces Val)) (_Error 8) )               ; bez samych spacji / no spaces
        ( (and (_Logand 16) (not (_IsNumb Val 1))) (_Error 16) )       ; tylko liczby      / only number
        ( (and (_Logand 32) (> (_Nth 3) (_StrUnit Val))) (_Error 32) ) ; liczba za mala    / number to small
        ( (and (_Logand 64) (< (_Nth 4) (_StrUnit Val))) (_Error 64) ) ; liczba za duza    / number to big
        ( T
          (setq res
            (if (_IsNumb Val 1)
              (if (= Code 2)
                (itoa (fix (_StrUnit Val)))
                (cd:CON_Real2Str (_StrUnit Val) (_Nth 5) (_Nth 6))
              )
              Val
            )
          )
        )
      )
    )
    ( T nil )
  )
  res
)

Na tą chwilę efektem jest nowe DCL_StdEditBoxDialog, a zmiana polegała na definicji nowego _CheckVal:
Kod: Zaznacz cały
(defun cd:DCL_StdEditBoxDialog (Data Title EditTitle Width BtnsWidth BtnsLabel DPos Limit
                                / _CheckVal fd tmp dc defval res fl
                               )
  (defun _CheckVal (Code Bit Val / _Error tmp res )
    ;(defun _Error (b) )
    (setq tmp Bit)
    (if (not fl) (setq Bit (apply (quote +) (mapcar (quote car) Bit))))
    (if (numberp (setq res (cd:DCL_CheckEditBoxValue Code Bit Val Data)))
      (progn
        (if (not fl) (set_tile "error" (cdr (assoc res tmp))))
        (set_tile "edit" Val)
        (setq res nil)
      )
      (progn
        (set_tile "edit" res)
        (if (not fl) (set_tile "error" ""))
      )
    )
    res
  )
  (if (not DPos) (setq *cd-TempDlgPosition* (list -1 -1)))
  (cond
    ( (not
        (and
          (setq fd
            (open
              (setq tmp (vl-FileName-MkTemp nil nil ".dcl")) "w"
            )
          )
          (foreach %
            (list
              (strcat
                "but : button { width = " (if BtnsWidth (itoa BtnsWidth) 13) "; fixed_width = true; }"
                "StdEditBoxDialog : dialog {"
                (if Title (strcat "label = \"" Title "\";") "")
                "  : boxed_column {"
                (if EditTitle (strcat "label = \"" EditTitle "\";") "")
                "    width = " (if Width (itoa Width) "20") ";"
                "    : edit_box { key = \"edit\";"
                (if Limit (strcat "edit_limit = " (itoa Limit) ";") "")
                "    } spacer; }"
                "  : row { alignment = centered; fixed_width = true;"
                "  : but { key = \"" (car BtnsLabel) "\";"
                "    label = \"" (car BtnsLabel) "\"; is_default = true; }"
                "  : but { key = \"" (cadr BtnsLabel) "\";"
                "    label = \"" (cadr BtnsLabel) "\"; is_cancel = true; }"
                "  } " (if (setq fl (= (type (cadr Data)) (quote INT))) "" ": errtile { width = 20; }") " }"
              )
            )
            (write-line % fd)
          )
          (not (close fd))
          (< 0 (setq dc (load_dialog tmp)))
          (new_dialog "StdEditBoxDialog" dc ""
            (cond
              ( *cd-TempDlgPosition* )
              ( (quote (-1 -1)) )
            )
          )
        )
      )
    )
    ( T
      (setq defval (substr (caddr Data) 1 Limit)
            res (if (not (= defval "")) (_CheckVal (car Data) (cadr Data) defval ))
      )
      (mode_tile "edit" 2)
      (action_tile "edit" "(setq res (_CheckVal (car Data) (cadr Data) $value ))")
      (action_tile (car BtnsLabel) "(if res (setq *cd-TempDlgPosition* (done_dialog 1)))")
      (action_tile (cadr BtnsLabel) "(setq res nil) (done_dialog 0)")
      (start_dialog)
    )
  )
  (if (< 0 dc) (unload_dialog dc))
  (if (setq tmp (findfile tmp)) (vl-file-delete tmp))
  (if (not DPos) (setq *cd-TempDlgPosition* (list -1 -1)))
  res
)

No i nowe DCL_StdQuickOptionsDialog, gdzie też zmieniłem tylko _CheckVal:
Kod: Zaznacz cały
(defun cd:DCL_StdQuickOptionsDialog (Data Default Title WidthColA WidthColB BtnsWidth BtnsLabel DPos
                                     / *error* inc keys_A keys_B fd tmp dc defval res _CheckVal)

  (defun _ButtonAction (Key)
    (cadr (last (nth (vl-position Key (mapcar 'cadr Data)) Data)))
  )
  (defun _CheckVal (Key Val / _Error DataCV Code Bit ErrLst err)
    (defun _Error (b) (setq err b))
    (setq
      DataCV (last (nth (vl-position Key (mapcar 'cadr Data)) Data))
      Code (car DataCV)
      Bit (cadr DataCV)
    )
    (setq ErrLst
      (cond
        ( (= Code 0)
          (list
            (cons 1 "Wypelnij pole")
            (cons 8 "Bez samych spacji")
          )
        )
        ( (= Code 1)
          (list
            (cons 1 "Wypelnij pole")
            (cons 2 "Niepoprawna nazwa")
            (cons 3 "Nazwa już istnieje")
            (cons 8 "Bez samych spacji")
            (cons 16 "Nie pasuje do wzorca")
            (cons 32 "Nie wystepuje na liscie")
          )
        )
        ( (member Code (list 2 3))
          (list
            (cons 1 "Wypelnij pole")
            (cons 2 "Nie może być 0")
            (cons 4 "Nie może być <0")
            (cons 8 "Bez samych spacji")
            (cons 16 "Tylko liczby")
            (cons 32 "Wartość za mała")
            (cons 64 "Wartość za duża")
          )
        )
      )
    )
    (if
      (numberp (setq err (cd:DCL_CheckEditBoxValue Code Bit Val DataCV)))
      (progn (set_tile "error" (cdr (assoc err ErrLst))) (mode_tile Key 2))
      (progn (set_tile "error" "") (set_tile Key err))
    )
  )
  (if (not DPos) (setq *cd-TempDlgPosition* (list -1 -1)))
  (setq
    keys_A (mapcar '(lambda (%1) (cons (strcat "A_" (cadr %1)) (caddr %1))) Data)
    flag 2
  )
  (cond
    ( (not
        (and
          (setq fd
            (open
              (setq tmp (vl-FileName-MkTemp nil nil ".dcl")) "w"
            )
          )
          (foreach %
            (list
              (strcat
                "_BUTTON : button { width = " (if BtnsWidth (cd:CON_Real2Str BtnsWidth 2 3) "13") "; fixed_width = true; }"
                "_POPUP : popup_list { edit_width = " (if WidthColB (cd:CON_Real2Str (- WidthColB 0.8) 2 3) "20") "; }"
                "_EDITBOX : edit_box { edit_width = " (if WidthColB (cd:CON_Real2Str WidthColB 2 3) "20") "; }"
                "_TEXT : text { width = " (if WidthColA (cd:CON_Real2Str WidthColA 2 3) "20")";}"
                "_BUTTON2 : button { width = " (if WidthColB (cd:CON_Real2Str (+ WidthColB 2) 2 3) "20") ";fixed_width = true;}"
                "StdQuickOptionsDialog : dialog {"
                (if Title (strcat "label = \"" Title "\";") "")
              )
              (cd:STR_ReParse
                (mapcar
                 '(lambda (%1)
                    (cond
                      ( (= (car %1) 0)
                        (strcat ": _POPUP { key = \"" (cadr %1) "\"; label = \"" (caddr %1) "\"; }")
                      )
                      ( (= (car %1) 1)
                        (strcat
                          ": _EDITBOX { key = \"" (cadr %1) "\"; label = \"" (caddr %1) "\";"
                          (if  (caddr (last %1)) (strcat "edit_limit = " (itoa (caddr (last %1))) ";") "")
                          "}"
                        )
                      )
                      ( (= (car %1) 2)
                        (strcat
                          ": row {"
                          (strcat ": text { key = \"" (strcat "A_" (cadr %1)) "\";label = \"" (caddr %1) "\";}" )
                          ": _BUTTON2 { key = \"" (cadr %1) "\"; label = \"" (car (last %1)) "\";"
                          "}}"
                        )
                      )
                      (T nil)
                    )
                  )
                  Data
                )
                " "
              )
              (strcat
                ": spacer_1 {}"
                ": row { alignment = centered; fixed_width = true;"
                " : _BUTTON { key = \"" (car BtnsLabel) "\";"
                "   label = \"" (car BtnsLabel) "\"; is_default = true; }"
                " : _BUTTON { key = \"" (cadr BtnsLabel) "\";"
                "   label = \"" (cadr BtnsLabel) "\"; is_cancel = true; }"
                "} "
                (if (member 1 (mapcar 'car Data)) "errtile;" ":   spacer_1 {}")
                "}"
              )
            )
            (write-line % fd)
          )
          (not (close fd))
          (< 0 (setq dc (load_dialog tmp)))
        )
      )
    )
    ( T
      (while (> flag 1)
        (if
          (not
            (new_dialog "StdQuickOptionsDialog" dc ""
              (cond
                ( *cd-TempDlgPosition* )
                ( (quote (-1 -1)) )
              )
            )
          )
          (exit)
        )
        (mapcar
         '(lambda (%1 %2)
            (cond
              ( (= (car %1) 0)
                (cd:DCL_SetList (cadr %1) (cadddr %1) (vl-position %2 (cadddr %1)))
              )
              ( (= (car %1) 1)
                (set_tile (cadr %1) %2)
              )
              ( T nil )
            )
          )
          Data
          Default
        )
        (foreach %1 Data
          (cond
            ( (= (car %1) 1)
              (action_tile (cadr %1)
                (vl-prin1-to-string
                  (quote
                    (progn
                      (_CheckVal $key $value)
                    )
                  )
                )
              )
            )
            ( (= (car %1) 2)
              (action_tile (cadr %1)
                (vl-prin1-to-string
                  (quote
                    (progn
                      ;(setq func (_ButtonAction $key))
                      (_ButtonAction $key)
                      ;(eval (_ButtonAction $key))
                      (setq Default
                        (mapcar
                         '(lambda (%1)
                            (cond
                              ( (= (car %1) 0)
                                (nth (atoi (get_tile (cadr %1))) (cadddr %1))
                              )
                              ( (= (car %1) 1)
                                (get_tile (cadr %1))
                              )
                            )
                          )
                          Data
                        )
                      )
                      (setq *cd-TempDlgPosition* (done_dialog 2))
                    )
                  )
                )
              )
            )
            ( T nil )
          )
        )
        (action_tile (car BtnsLabel)
          (vl-prin1-to-string
            (quote
              (progn
                (foreach %1 Data
                  (cond
                    ( (= (car %1) 1)
                      (_CheckVal (cadr %1) (get_tile (cadr %1)))
                    )
                    ( T nil )
                  )
                )
                (if (or (= (get_tile "error") "") (not (member 1 (mapcar 'car Data))))
                  (progn
                    (setq res
                      (mapcar
                       '(lambda (%1)
                          (cond
                            ( (= (car %1) 0)
                              (nth (atoi (get_tile (cadr %1))) (cadddr %1))
                            )
                            ( (= (car %1) 1)
                              (get_tile (cadr %1))
                            )
                            ( (= (car %1) 2)
                              (get_tile (cadr %1))
                            )
                          )
                        )
                        Data
                      )
                    )
                    (setq *cd-TempDlgPosition* (done_dialog 1))
                  )
                )
              )
            )
          )
        )
        (action_tile (cadr BtnsLabel) "(setq res nil) (done_dialog 0)")
        (setq flag (start_dialog))
        (if (> flag 1)
          (eval func)
        )
      )
    )
  )
  (if (< 0 dc) (unload_dialog dc))
  (if (setq tmp (findfile tmp)) (vl-file-delete tmp))
  (if (not DPos) (setq *cd-TempDlgPosition* (list -1 -1)))
  res
)
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 469
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

Re: [Lisp] CadPack propozycja DCL_StdQuickOptionsDialog

Postprzez ziele_o2k » lip 06, 2017 10:20

ziele_o2k napisał(a):(...)
I tutaj od razu uwaga - nie podoba mi się to Data w wartościach, które trza podać więc i tak do zmiany. Pokombinuję jeszcze - nie sprawdzałem co robi funkcja _Nth i po co ona jest.
(...)

Wczytałem się i stwierdzam, że tak musi zostać, tylko trzeba dać dokładny opis co ma być w Data )
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 469
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

Poprzednia strona

Powrót do AutoCAD

Kto przegląda forum

Użytkownicy przeglądający ten dział: Brak zidentyfikowanych użytkowników