Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 12/03/2022 in all areas

  1. That may explain it, I believe there was a switch to a different in place mtext editor control. I remember seeing the code for the old version, crazy difficult, having to track every fragment’s font, size, style, along with the justification...
    1 point
  2. I thought you where using a dashed line instead of multiple little lines. have to think about what to do.
    1 point
  3. One lisp file is better than two : a lisp file and a dcl file. But I have tons of dcl files so just for fun (Grrr knows all about fun) decided to make a tiny lisp in my lunch break to make this just a little bit more easier for me, myself and I. Probably not the first with this idea , haven't checked it (maybe I should have...) , also haven't tested it much (also should have done this) but hey , almost weekend... so go check youself! ; RLX - 25 Jan 2019 - just another luchtime fun (defun RLX_Convert_Dcl ( / dcl-fn dcl-fp lsp-fn lsp-fp dir base inp) (if (and (setq dcl-fn (getfiled "Select DCL file" "" "dcl" 0)) (setq dcl-fp (open dcl-fn "r")) (setq lsp-fn (strcat (setq dir (car (fnsplitl dcl-fn))) (setq base (cadr (fnsplitl dcl-fn))) "_dcl.lsp")) (setq lsp-fp (open lsp-fn "w"))) (progn (princ (strcat "(defun " base "_Write_Dialog ( )\n (if (and (setq " base "-fn " "(vl-filename-mktemp ") lsp-fp) (prin1 (strcat base ".dcl") lsp-fp) (princ (strcat ")) (setq " base "-fp (open " base "-fn \"w\")))\n") lsp-fp) (princ (strcat " (mapcar \n '(lambda (x)(write-line x " base "-fp))\n (list\n") lsp-fp) (while (setq inp (read-line dcl-fp)) (princ " " lsp-fp)(prin1 inp lsp-fp)(princ "\n" lsp-fp)) (princ (strcat " )\n )\n )\n (if " base "-fp (close " base "-fp))\n)") lsp-fp) (close dcl-fp)(close lsp-fp)(gc) ) ) (if (and lsp-fn (findfile lsp-fn))(startapp "notepad" lsp-fn)) (princ) ) ; (RLX_Convert_Dcl) ; original dcl file name : rlx.dcl ; rlx : dialog ; { label = "RLX (RLX Jan'19)"; ; : list_box { key = "lb"; } ; ok_cancel; ; } ; converted to rlx_dcl.lsp: ;(defun rlx_Write_Dialog ( ) ; (if (and (setq rlx-fn (vl-filename-mktemp "rlx.dcl")) (setq rlx-fp (open rlx-fn "w"))) ; (mapcar ; '(lambda (x)(write-line x rlx-fp)) ; (list ; "rlx : dialog" ; " { label = \"RLX (RLX Jan'19)\";" ; " : list_box { key = \"lb\"; }" ; " ok_cancel;" ; " }" ; ) ; ) ; ) ; (if rlx-fp (close rlx-fp)) ; )
    1 point
  4. Nice idea, Rlx! :exitedmaniacemoji: If I remember correctly you had a similar routine for DCL previewing.. . And I never attempted something like that so here it goes - ; LispWrapperForDCL (defun C:test ( / *error* src Sdes lsp Ddes row L tmp ) (defun *error* ( m ) (and (eq 'FILE (type Sdes)) (close Sdes)) (and (eq 'FILE (type Ddes)) (close Ddes)) (and (eq 'STR (type lsp)) (findfile lsp) (vl-file-delete lsp)) (and m (princ m)) (princ) ); defun *error* (cond ( (not (setq src (getfiled "Specify DCL file" (strcat (getenv "userprofile") "\\Desktop\\") "dcl" 16))) (prompt "\nDCL file not specified.") ) ( (not (setq Sdes (open src "R"))) (prompt "\nUnable to open the DCL file for reading.") ) ( (not (princ "" (setq Ddes (open (setq lsp ( (lambda (s / i tmp) (setq i 0) (while (findfile (setq tmp (strcat s "_" (itoa i) ".lsp"))) (setq i (1+ i))) tmp) (apply (function (lambda (a b c) (vl-string-translate "/" "\\" (strcat a b)))) (fnsplitl src)) ) ); setq lsp "W" ); open ); setq Ddes ); princ ); not (if lsp (prompt (strcat "\nUnable to open '" lsp "' for writing.")) (prompt "\nUnable to generate the '.lsp' file.") ) ) (t ;| (while (setq row (read-line Sdes)) (write-line (if (/= "" row) (vl-list->string (append '(34) (apply 'append (subst '(92 34) '(34) (mapcar 'list (vl-string->list row)))) '(34))) row ); if Ddes ); write-line ); while |; (while (setq row (read-line Sdes)) (setq L (cons (if (/= "" row) (vl-list->string (append '(34) (apply 'append (subst '(92 34) '(34) (mapcar 'list (vl-string->list row)))) '(34))) ; (vl-list->string (append '(34) (vl-string->list row) '(34))) row ); if L ) ); L ); while (setq L (reverse L)) (foreach x '("(defun C:test_LispWrapperForDCL ( / *error* dcl des dch dcf )" (defun *error* ( m ) (and (< 0 dch) (unload_dialog dch)) (and (eq 'FILE (type des)) (close des)) (and (eq 'STR (type dcl)) (findfile dcl) (vl-file-delete dcl)) (and m (princ m)) (princ) ); defun *error* "(and" (setq dcl (vl-filename-mktemp nil nil ".dcl")) (setq des (open dcl "W")) "(progn" "(foreach x " L (write-line x des) "); foreach" "T" "); progn" (not (setq des (close des))) (setq dch (load_dialog dcl)) (new_dialog "test" dch) (= 1 (setq dcf (start_dialog))) "); and" (*error* null) ; <- use "null" instead of "nil", else its buggy! (princ) "); defun" ); list (cond ( (eq 'STR (type x)) (and (setq tmp (vl-string->list x)) (not (apply '= (cons 32 tmp))) (write-line x Ddes) ) ) ( (= x 'L) (foreach x (append '("'(") (eval x) '(")")) (write-line x Ddes)) ) ( (vl-consp x) (princ "(" Ddes) (foreach x (list (car x) (cadr x) (caddr x)) (if x (princ (strcat (strcase (vl-prin1-to-string x) t) " ") Ddes) ) ) (mapcar '(lambda (x) (write-line (strcase (vl-prin1-to-string x) t) Ddes)) (cdddr x)) (write-line ")" Ddes) ) ) ); foreach ((lambda (L) (mapcar 'set L (mapcar 'close (mapcar 'eval L)))) '(Sdes Ddes)) ( (lambda ( fpath / shell ) (if fpath (vl-catch-all-apply (function (lambda nil (setq shell (vlax-get-or-create-object "Shell.Application")) (vlax-invoke-method shell 'Open fpath) ) ) ) ) (vl-catch-all-apply 'vlax-release-object (list shell)) ) lsp ) (load lsp) (if C:test_LispWrapperForDCL (C:test_LispWrapperForDCL) (alert "Unable to define the generated lisp!") ) (setq lsp nil) ); t ) (*error* nil) (princ) ); defun test.dcl : // original dcl file name : "test.dcl" /* rlx: "Arbeit macht SpaB" */ test : dialog { label = "RLX (RLX Jan'19)"; : list_box { key = "lb"; } ok_cancel; } test.lsp (converted) : (defun C:test_LispWrapperForDCL ( / *error* dcl des dch dcf ) (defun *error* (m) (and (< 0 dch) (unload_dialog dch)) (and (eq (quote file) (type des)) (close des)) (and (eq (quote str) (type dcl)) (findfile dcl) (vl-file-delete dcl)) (and m (princ m)) (princ) ) (and (setq dcl (vl-filename-mktemp nil nil ".dcl") ) (setq des (open dcl "w") ) (progn (foreach x '( "// original dcl file name : \"test.dcl\"" "/*" " rlx: \"Arbeit macht SpaB\"" "*/" "test : dialog" "{ label = \"RLX (RLX Jan'19)\";" " : list_box { key = \"lb\"; }" " ok_cancel;" "} " ) (write-line x des ) ); foreach T ); progn (not (setq des (close des)) ) (setq dch (load_dialog dcl) ) (new_dialog "test" dch ) (= 1 (setq dcf (start_dialog)) ) ); and (*error* null ) (princ ) ); defun I like the ideas you share from your lunch brakes!
    1 point
×
×
  • Create New...