Jump to content

Leaderboard

Popular Content

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

  1. Replace the list of strings to your desire one '("one" "two") as in the following routine. (defun c:Test (/ inc lst str brk sel get) ;; Tharwat - Date: 19.10.2020 ;; (setq inc 0 lst '("one" "two") str '("1st" "2nd") ) (while (and (not brk) (princ (strcat "\nSelect " (nth inc str) " text to replace with < " (nth inc lst) " > : ." ) ) ) (and (setq sel (ssget "_+.:S:E:L" '((0 . "*TEXT")))) (entmod (subst (cons 1 (nth inc lst)) (assoc 1 (setq get (entget (ssname sel 0)))) get ) ) (setq inc (1+ inc)) (= inc 2) (setq brk t) ) ) (princ) )
    1 point
  2. rlx.. I am suspecting you have stopped taking life too seriously "Drink less or get glasses".... I might also save this code away, thanks
    1 point
  3. You should have the AutoCAD MAP 3D toolset with AutoCAD 2020. Otherwise you will need a third party convertor AFAIK.
    1 point
  4. 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
  5. That kinda depends wether the same block is both part of your drawing as well as part of your big bada boom block. Routine works by updating the block definition itself so you can't have 'block-A' with entity props byblock in your b.b.b.block and color bylayer in the rest of your drawing.
    1 point
  6. Use google translate Hello all of you! I'm from Vietnam. After learning about Lisp, she was still ignorant, so she came up here asking for help. Currently I am writing lisp export length Pline bar to Block ATT but do not know how to use Function Field of Lee Mac to link to the length. Example: Wall length: 123456m ====> 123456 I want to link field to. Looking forward to your help! Try this (defun c:lens (/ ent obj atlength pt atts att obj2) (while (setq ent (entsel "\nPick object")) (setq obj (vlax-ename->vla-object (car ent))) (setq atlength nil) (if (vlax-property-available-p obj "Circumference") (setq atlength (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-Objectid obj)) ">%).Circumference \\f \"" "%lu2%pr3" "\">%")) ) (if (vlax-property-available-p obj "Length") (setq atlength (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-Objectid obj)) ">%).Length \\f \"" "%lu2%pr3" "\">%")) ) (if (= atlength nil) (alert "object not supported for length") (progn (setq pt (getpoint "\nPick insert point")) (command "-insert" "Block" pt 1 1 0 "" "") (setq obj2 (vlax-ename->vla-object (entlast))) (setq atts (vlax-invoke obj2 'getattributes)) (foreach att atts (if (= (vla-get-tagstring att) "L") (vla-put-textstring att atlength) ) (command "regen") ) ) ) ) (princ) )
    1 point
  7. untested (defun c:t1 () (vl-load-com) (vlax-for b (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-for o b (vla-put-color o 0)(vla-put-linetype o "ByBlock")(vla-put-Lineweight o -1) (vla-put-EntityTransparency o "ByBlock")))(vl-cmdf "_ATTSYNC" "N" "*"))
    1 point
  8. Không được bạn ơi! bạn có thể xem lisp mình gửi lên được không?
    -1 points
×
×
  • Create New...