Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 10/27/2020 in all areas

  1. Here's a simple example using my Read CSV function: (defun c:txtfromcsv ( / csv des hgt ins itm str sty ) (setq hgt (getvar 'textsize) sty (getvar 'textstyle) ) (cond ( (not (setq csv (getfiled "Select CSV File" "" "csv" 16))) (princ "\n*Cancel*") ) ( (not (setq des (open csv "r"))) (princ "\nUnable to open CSV file for reading.") ) ( t (while (setq str (read-line des)) (setq itm (LM:csv->lst str "," 0)) (if (and (< 3 (length itm)) (snvalid (car itm)) (apply 'and (setq ins (mapcar 'distof (mapcar '(lambda ( a b ) a) (cdr itm) '(0 1 2))))) ) (entmake (list '(000 . "TEXT") (cons 010 ins) (cons 007 sty) (cons 040 hgt) (cons 001 (last itm)) (cons 008 (car itm)) ) ) ) ) (close des) ) ) (princ) ) ;; CSV -> List - Lee Mac ;; Parses a line from a CSV file into a list of cell values. ;; str - [str] string read from CSV file ;; sep - [str] CSV separator token ;; pos - [int] initial position index (always zero) (defun LM:csv->lst ( str sep pos / s ) (cond ( (not (setq pos (vl-string-search sep str pos))) (if (wcmatch str "\"*\"") (list (LM:csv-replacequotes (substr str 2 (- (strlen str) 2)))) (list str) ) ) ( (or (wcmatch (setq s (substr str 1 pos)) "\"*[~\"]") (and (wcmatch s "~*[~\"]*") (= 1 (logand 1 pos))) ) (LM:csv->lst str sep (+ pos 2)) ) ( (wcmatch s "\"*\"") (cons (LM:csv-replacequotes (substr str 2 (- pos 2))) (LM:csv->lst (substr str (+ pos 2)) sep 0) ) ) ( (cons s (LM:csv->lst (substr str (+ pos 2)) sep 0))) ) ) (defun LM:csv-replacequotes ( str / pos ) (setq pos 0) (while (setq pos (vl-string-search "\"\"" str pos)) (setq str (vl-string-subst "\"" "\"\"" str pos) pos (1+ pos) ) ) str ) (princ)
    1 point
  2. If you want to be able to select which blocks you want to update things get a little bit more complex but you asked , so don't blame the dragon. ;;; https://www.cadtutor.net/forum/topic/71349-lisp-to-set-all-properties-inside-a-block-to-byblock/ ;;; Rlx 17 oct 2020 (defun c:t1 ( / max-num-of-rows start-column result-list blk AllBlockObjects AllNestedBlocks n i lst done) (cond ((not (setq blk (car (entsel "\nSelect block to process : ")))) (princ "\nDrink less or get glasses because you missed.")) ((not (vl-consp (setq AllBlockObjects (GetAllBlockObjects blk)))) (princ "\nHope you didn't pay for this block because its empty.")) ((not (vl-consp (setq AllNestedBlocks (GetAllNestedBlocks AllBlockObjects)))) (princ "\nNo nested blocks in this block")) (t (list->toggle:create_dialog (acad_strlsort (rdup (mapcar 'car AllNestedBlocks))) nil "Select nested blocks to pimp") (foreach x result-list (if (= (cdr x) "1")(setq lst (cons (car x) lst)))) (setq i 0)(pimp (vlax-ename->vla-object blk))(setq i (1+ i)) (vlax-for b (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-for o b (cond ((setq n (block-n o)) (if (and (member n lst) (not (member n done))) (progn (pimp o) (setq i (1+ i) done (cons n done))))) (t (pimp o))))) (vl-cmdf "_ATTSYNC" "N" "*") ) ) (princ (strcat "\nUpdated " (if i (itoa i) "nada") " blocks")) (princ) ) (defun pimp (o) (vla-put-color o 0)(vla-put-linetype o "ByBlock") (vla-put-Lineweight o -1)(vla-put-EntityTransparency o "ByBlock")) ; (setq lst (GetAllBlockObjects (car (entsel)))) (defun GetAllBlockObjects ( b / e l) (vlax-for o (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))(cdr (assoc 2 (entget b)))) (setq l (cons o l)))) (defun block-n (o) (if (and (= 'vla-object (type o))(eq (vla-get-objectname o) "AcDbBlockReference")) (if (vlax-property-available-p o 'EffectiveName) (vla-Get-EffectiveName o) (vla-Get-Name o)) nil)) ; (setq lst (GetAllNestedBlocks (GetAllBlockObjects (car (entsel))))) (defun GetAllNestedBlocks ( l / n r ) (foreach o l (if (setq n (block-n o)) (setq r (cons (cons n o) r)))) r) ;remove duplicates (defun rdup ( i / o ) (vl-remove-if '(lambda (x) (cond ((vl-position x o) t) ((setq o (cons x o)) nil))) i)) ;--- List->Toggle --------------------------------------- Begin of List->Toggle ------------------------------------------ List->Toggle --- ; max-num-of-rows / start-column / result-list -> global vars needed because dialog will be recreated if resized (defun list->toggle:create_dialog ( %lst %dflt $msg / max-dialog-width dialog-fn dialog-fp dialog-id action-list split_list-list l collie max-column-length max-str-len number-of-columns max-num-of-colums-per-dialog ) ; limit of the maximum size of dialog and maximum rows per column (setq max-dialog-width 120) (or max-num-of-rows (setq max-num-of-rows 10)) ; start column will be reset when number or rows is changed (or start-column (setq start-column 0)) (or result-list (setq result-list (mapcar '(lambda (x)(cons x "0")) %lst))) ; split_list up list in columns where each column has max-num-of-rows (setq split_list-list (split_list %lst max-num-of-rows) max-str-len (apply 'max (mapcar 'strlen %lst)) number-of-columns (length split_list-list) max-column-length (apply 'max (mapcar 'length split_list-list)) max-num-of-colums-per-dialog (fix (/ max-dialog-width (+ max-str-len 5)))) ; 5 = togglewidth (guess) ; open dialog for writing (setq dialog-fp (open (setq dialog-fn (vl-filename-mktemp ".dcl")) "w")) ; write header (write-line (strcat "split_list:dialog {label=\"" $msg "\";") dialog-fp) ; write body start (write-line ":boxed_row {" dialog-fp) (setq column-index start-column) (if (> (setq n (+ start-column number-of-columns)) max-num-of-colums-per-dialog) (setq n max-num-of-colums-per-dialog)) (repeat n (setq collie (nth column-index split_list-list) l (length collie) ) (write-line ":column {alignment=top;" dialog-fp) (foreach item collie (write-line (strcat ":toggle {label=\"" item "\";key=\"tg_" item "\";}") dialog-fp) (setq action-list (cons item action-list)); used later by action_tile's ) (repeat (- max-num-of-rows l)(write-line ":row {height=1.5;}" dialog-fp)) (write-line "}" dialog-fp) (setq column-index (1+ column-index)) ) ; write body end (write-line "}" dialog-fp) ; write footer (write-line (strcat "spacer;:concatenation {alignment=centered;children_fixed_width=true;" ":button{label=\"&Less Rows\";key=\"bt_less_rows\";mnemonic=\"L\";}" ":button{label=\"&More Rows\";key=\"bt_more_rows\";mnemonic=\"M\";}" ":button{label=\"&Prev.Page\";key=\"bt_prev_page\";mnemonic=\"P\";}" ":button{label=\"&Next Page\";key=\"bt_next_page\";mnemonic=\"N\";}}") dialog-fp) (write-line (strcat "spacer;:concatenation {alignment=centered;:button{label=\"Select All\";key=\"bt_select_all\";}" ":button{label=\"Clear All\";key=\"bt_clear_all\";}:button{label=\"Default\";key=\"bt_default\";}" "spacer;spacer;ok_cancel;}}") dialog-fp) (and (not (setq dialog-fp (close dialog-fp))) (< 0 (setq dialog-id (load_dialog dialog-fn))) (new_dialog "split_list" dialog-id) (progn (mapcar '(lambda (x)(set_tile (strcat "tg_" (car x)) (cdr x))) result-list) (mapcar '(lambda (x)(action_tile (strcat "tg_" (car x)) "(list->toggle:update_tile $key $value)")) result-list) (action_tile "accept" "(done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (action_tile "bt_clear_all" "(list->toggle:set_all_toggles 0)") (action_tile "bt_select_all" "(list->toggle:set_all_toggles 1)") (action_tile "bt_less_rows" "(if (list->toggle:change_rows -1)(done_dialog 2))") (action_tile "bt_more_rows" "(if (list->toggle:change_rows +1)(done_dialog 2))") (action_tile "bt_prev_page" "(if (list->toggle:change_page -1)(done_dialog 3))") (action_tile "bt_next_page" "(if (list->toggle:change_page +1)(done_dialog 3))") (action_tile "bt_default" "(list->toggle:apply_defaults)") (setq drv (start_dialog))(unload_dialog dialog-id)(vl-file-delete dialog-fn) ) ) (cond ((or (= drv 2)(= drv 3))(list->toggle:create_dialog %lst %dflt $msg))) (princ) ) (defun list->toggle:set_all_toggles (i) (foreach tg action-list (set_tile (strcat "tg_" tg) (itoa i))) (setq result-list (mapcar '(lambda (x)(cons x (itoa i))) %lst))) (defun list->toggle:change_rows (i) (if (< 4 (+ max-num-of-rows i) 25) (progn (setq max-num-of-rows (+ max-num-of-rows i))(setq start-column 0)) nil)) (defun list->toggle:change_page (i) (if (and (<= 0 (+ start-column i))(<= (+ start-column i) (- number-of-columns max-num-of-colums-per-dialog ))) (setq start-column (+ start-column i)) nil)) (defun list->toggle:update_tile ($k $v) (setq result-list (subst (cons (substr $k 4) $v) (assoc (substr $k 4) result-list) result-list))) (defun list->toggle:apply_defaults () (if (and (vl-consp result-list) (vl-consp %dflt)) (foreach item %dflt (if (assoc item result-list) (progn (setq result-list (subst (cons item "1") (assoc item result-list) result-list)) (set_tile (strcat "tg_" item) "1"))))) ) ; (lst-strcat '("A" "B" "C") "+") -> "A+B+C" (defun lst-strcat (%l $s) (apply 'strcat (cdr (apply 'append (mapcar (function (lambda (x) (list $s x))) %l))))) ; (split_list '(1 2 3 4 5 6 7 8 9) 4) (split_list '(1 2 ) 4) (defun split_list (l n / _sub) (defun _sub (a b c / r) (if (not (<= 1 c (- (length a) b)))(setq c (- (length a) (1- b)))) (repeat c (setq r (cons (nth (1- b) a) r) b (1+ b)))(reverse r))(if l (cons (_sub l 1 n) (split_list (_sub l (1+ n) nil) n)))) (defun list->toggle:show_result (%l / tmp s) (cond ((or (not (vl-consp %l)) (vl-every ''((x)(= (cdr x) "0")) %l)) "None") ((vl-every ''((x)(= (cdr x) "1")) %l) "All") (t (foreach x %l (if (= (cdr x) "1")(setq tmp (cons (car x) tmp)))) (if (vl-consp tmp)(setq s (lst-strcat (reverse tmp) "+"))) (cond ((not (string-p s)) "Nothing selected") ((> (strlen s) 100) "List too long to show")(t s))) ) ) ; example for subfolder selection (defun getfolder ( msg / fl sh ) (if (and (setq sh (vlax-create-object "Shell.Application")) (setq fl (vlax-invoke sh 'browseforfolder 0 msg 0 ""))) (setq fl (vlax-get-property (vlax-get-property fl 'self) 'path))(setq fl nil))(release_me (list sh)) fl) (defun c:LT-test ( / fol lst dflt max-num-of-rows start-column result-list) (setq dflt '("E" "FGA" "G" "GE" "GX" "HV" "S" "TC" "U")) (if (and (setq fol (getfolder "Targetfolder")) (vl-consp (setq lst (vl-remove-if '(lambda (x)(member x '("." ".."))) (vl-directory-files fol nil -1))))) (progn (list->toggle:create_dialog lst dflt "Select subfolders") (alert (list->toggle:show_result result-list)))) (princ) ) ;--- List->Toggle ---------------------------------------- End of List->Toggle ------------------------------------------- List->Toggle --- Kurpulio2.lsp
    1 point
×
×
  • Create New...