_

[LISP] CADPL - Tool translator [Tool]

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] CADPL - Tool translator [Tool]

Postprzez kruuger » mar 28, 2012 23:02

Kod: Zaznacz cały
; cd:DCL_SetList          - Wypelnia wycinki / Fills tiles                                    ;

; =========================================================================================== ;
; Wypelnia wycinki "list_box" i "popup_list" / Fills "list_box" and "popup_list" tiles        ;
;  Key [STR]     - nazwa wycinka / tile name                                                  ;
;  Lst [LIST]    - lista do wypelnienia / list to fill                                        ;
;  Pos [STR/nil] - aktualna pozycja na liscie / current position on the list                  ;
; =========================================================================================== ;
(defun cd:DCL_SetList (Key Lst Pos)
  (start_list Key)
  (mapcar (quote add_list) Lst)
  (end_list)
  (set_tile Key
    (itoa
      (cond
        ( (numberp Pos) (fix Pos))
        ( (= (type Pos) (quote STR)) (atoi Pos))
        (T 0)
      )
    )
  )
)
Avatar użytkownika
kruuger
 
Posty: 4839
Dołączył(a): paź 27, 2005 20:14
Lokalizacja: Kraków

Re: [LISP] CADPL - Tool translator [Tool]

Postprzez kruuger » mar 28, 2012 23:19

Kod: Zaznacz cały
; cd:STR_CountChar        - Liczba wystapien znaku / Number of occurrences of a character     ;

; =========================================================================================== ;
; Liczba wystapien znaku / Number of occurrences of a character                               ;
;  Str [STR]   - lancuch tekstowy / string                                                    ;
;  Char [LIST] - znak / character                                                             ;
; ------------------------------------------------------------------------------------------- ;
; (cd:STR_CountChar  "\"123\" \"416\" \"719\" \"A1c\"" "\"")                                  ;
; =========================================================================================== ;
(defun cd:STR_CountChar (Str Char)
  (-
    (strlen Str)
    (length
      (vl-remove
        (ascii Char)
        (vl-string->list Str)
      )
    )
  )
)
Avatar użytkownika
kruuger
 
Posty: 4839
Dołączył(a): paź 27, 2005 20:14
Lokalizacja: Kraków

Re: [LISP] CADPL - Tool translator [Tool]

Postprzez kruuger » kwi 01, 2012 21:05

zrobilem ile sie dalo. bedzie sie testowac przy kolejnych programach.
post7673978.html#p7673978
k.
Avatar użytkownika
kruuger
 
Posty: 4839
Dołączył(a): paź 27, 2005 20:14
Lokalizacja: Kraków

Re: [LISP] CADPL - Tool translator [Tool]

Postprzez ziele_o2k » wrz 08, 2018 03:15

Pozwolę sobie odkopać temat, może się komuś przyda jeśli będzie używał tooltranslatora.
Funkcja do zamiany dcl na lsp z dodaniem odpowiednich elementów pozwalających na użycie nowego lispa przez wspomnianego tooltrasnslatora :)
Kod: Zaznacz cały
(defun c:dcl2lsp ( / fl_dcl fl_tmp lst )
    (if
        (and
            (setq fl_dcl (getfiled "Wybierz plik DCL" "" "dcl" 0))
            (setq fl_tmp (fnsplitl fl_dcl))
            (setq lst (cd:SYS_ReadFile nil fl_dcl))
        )
        (cd:SYS_WriteFile
            (strcat (car fl_tmp) "\\" (cadr fl_tmp) ".lsp")
            (mapcar
                (function
                    (lambda (% / sta end )
                        (if (wcmatch % "*label=*")
                            (progn
                                (setq sta (vl-string-search "label=" % ))
                                (setq end (vl-string-search ";" % sta))
                                (strcat
                                    "(strcat"
                                    (vl-prin1-to-string (substr % 1 (+ sta 7) ))
                                    "(nth *l (list "
                                    (vl-prin1-to-string (substr % (+ sta 7 1) (- (1- end) (+ sta 7))))
                                    "))"
                                    (vl-prin1-to-string (substr % end))
                                    ")  ;LANG;"
                                )
                            )
                            (vl-prin1-to-string %)
                        )
                    )
                )
                lst
            )
            nil
        )
    )
    (princ)
)

albo na full wypasie coś takiego:
Kod: Zaznacz cały
(defun c:dcl2lsp_full ( / pref suf fl_dcl fl_tmp lst )
    (setq
        pref
        (list
            "(defun my_function_name ( / file )"
            "    (and"
            "        (setq *tmp_file (vl-FileName-MkTemp nil nil \".dcl\"))"
            "        (setq file (open *tmp_file \"w\"))"
            "        (progn"
            "            (foreach %"
            "                (list"
        )
        suf
        (list
            "                )"
            "                (write-line % file)"
            "            )"
            "            (setq file (close file))"
            "            (> (setq *dc (load_dialog *tmp_file)) 0)"
            "        )"
            "    )"
            ")"
        )
    )
    (if
        (and
            (setq fl_dcl (getfiled "Wybierz plik DCL" "" "dcl" 0))
            (setq fl_tmp (fnsplitl fl_dcl))
            (setq lst (cd:SYS_ReadFile nil fl_dcl))
        )
        (cd:SYS_WriteFile
            (strcat (car fl_tmp) "\\" (cadr fl_tmp) ".lsp")
            (append
                pref
                (mapcar
                    (function
                        (lambda (% / sta end )
                            (if (wcmatch % "*label=*")
                                (progn
                                    (setq sta (vl-string-search "label=" % ))
                                    (setq end (vl-string-search ";" % sta))
                                    (strcat
                                        "                    (strcat"
                                        (vl-prin1-to-string (substr % 1 (+ sta 7) ))
                                        "(nth *l (list "
                                        (vl-prin1-to-string (substr % (+ sta 7 1) (- (1- end) (+ sta 7))))
                                        "))"
                                        (vl-prin1-to-string (substr % end))
                                        ")  ;LANG;"
                                    )
                                )
                                (strcat "                    " (vl-prin1-to-string %))
                            )
                        )
                    )
                    lst
                )
                suf
            )
            nil
        )
    )
    (princ)
)

Testować można na takim dclu przykładowym:
Kod: Zaznacz cały
afra2 : dialog
{label="C";
    : column
    {
        : edit_box {key="eb16"; label="Base Level";edit_width=12;value="00.000";}
        : edit_box {key="eb17"; label="Top Level";edit_width=12; value="00.000";}
        : edit_box {key="eb18"; label="Horizontal Scale 1 :";edit_width=12; value="200";}
        : edit_box {key="eb19"; label="Vertical Scale 1 :";edit_width=12; value="50";}
        : edit_box {key="eb20"; label="Title";edit_width=20; value="Chainage";}
        : toggle {key="tg1"; value=1;label ="Description On/Off";}
        : edit_box {key="eb21"; label="Path";edit_width=20; value="C:\\";}
        : edit_box {key="eb22"; label="File Name";edit_width=20; value="default";}
    }
    ok_only;
}

Lisp będzie działał prawidłowo jeśli labele będą występowały nie więcej niż jeden raz w linii i dokładnie w takiej formie: label="Title"; (bez spacji).
W powyższym przykładowym oknie dcl można zwrócić uwagę co zrobiłem dla toggle (spacja po label) - taki myk wykluczy nam dany label z tłumaczenia co mi się przydaje.

Edit:
Poprawiłem funkcje, bo brakowało jednego strcata i przy ładowaniu dcla się wysypywało
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 735
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