Leaderboard

Still working on monster project , maybe not 24/7 but 12/7 comes pretty close IT must hate me because old document control program was suddenly shut down , long live the new program , yeah oh dear... , new program is action based , sounds nice but sadly... well save that for another time. Anyways , it has been decided that button open document' is too dangerous from now on. So now we can check out document but have to search and open it by hand. To speed things up tried to find a faster way and decided to lay & hatch another egg. Dynamic Input (DIP) works like auto-complete when typing something in google. It doesn't use an edit_box but works kinda like grread but for dcl. I have included little test function (c:t1) . Just load my egg , euh , program and start typing something like "ansi" and see what happens (hopefully) Just one limitation , you cant use tab , space or enter which are used by dcl itself. So if you need a space type ' (quote character) Well even though its weekend , its back to work for me , I feel like a freeking cinderella pfff p.s. if any bugs please go via forum and don't PM me because have no time for private mail p.s.s input is a list and output is a list. What you do with this list is your own thing. ;;; DIP - Dynamic Input , Rlx Sep'23 ;;; sort of (grread) for dcl with exception for space, tab & enter which are reserved by dcl ;;; haven't (yet) found a way to catch character for space. ;;; So gonna use ' (quote) for space, not ideal but it is what it is (vl-load-com) (defun dip ( %lst / dip-list dip-width key-lst imb-str capslock bksp bksl qmrk eb-txt f p d r ib dialog-list drv lb-sel return-list) (setq dip-list %lst) ;;; make sure all elements are strings (setq dip-list (mapcar 'vl-princ-to-string dip-list)) ;;; find length of longest member (setq dip-width (car (vl-sort (mapcar 'strlen dip-list) '>))) ;;; create key codes (setq key-lst (vl-remove-if '(lambda (x)(member x '(34 92))) (append (gnum 33 95) (gnum 123 125)))) (setq imb-str ":image_button {color=dialog_background;width=0.1;height=0.1;fixed_height=true;key=\"ib_") ;;; see if acet-sys-keystate function is available (setq capslock (member 'acet-sys-keystate (atoms-family 0)) eb-txt "" bksp (strcat ":image_button {color=dialog_background;width=0.1;height=0.1;" "fixed_height=true;key=\"ib_bksp\";label=\"&\010\";}") bksl (strcat ":image_button {mnemonic=\"\\\\\";color=dialog_background;width=0.1;" "height=0.1;fixed_height=true;key=\"ib_bksl\";label=\"&\\\\\";}") qmrk (strcat ":image_button {mnemonic=\"\\\"\";color=dialog_background;width=0.1;" "height=0.1;fixed_height=true;key=\"ib_qmrk\";label=\"&\\\"\";}") ) (and (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w")) (mapcar '(lambda (x) (write-line x p)) (append (list "dip:dialog {label=\"DIP - Dynamic Input (Rlx Sep'23)\";:row {") (crim) (list bksp bksl qmrk "}") (list ":image_button {color=141;height=1;fixed_height=true;key=\"ib_ib\";}" ":text_part {key=\"tp\";height=1;width=40;}" ) (list (strcat ":list_box {height=25;width=" (itoa (fix (* dip-width 0.75))) ";key=\"lb\";multiple_select=true;}") "ok_cancel;" "}") ) ) (not (setq p (close p))) (< 0 (setq d (load_dialog f))) (new_dialog "dip" d) (progn (upd_lbox) (action_tile "ib_bksp" "(upd_txtp $key)") (action_tile "ib_bksl" "(upd_txtp $key)") (action_tile "ib_qmrk" "(upd_txtp $key)") (stim) (action_tile "lb" "(setq lb-sel $value)") (action_tile "accept" "(done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq drv (start_dialog)) (unload_dialog d) (vl-file-delete f) ) ) (cond ((= drv 0)) ((= drv 1) (cond ((and (boundp lb-sel) (vl-consp dialog-list)) (setq return-list (mapcar '(lambda (x)(nth (atoi x) dialog-list)) (SplitStr lb-sel "")))) ((vl-consp dialog-list) (setq return-list dialog-list)) (t (setq return-list nil)) ) ) (t (setq return-list nil)) ) return-list ) ;;; create image_buttons : (setq lst (gimb)) (defun crim () (mapcar '(lambda (x)(strcat imb-str (chr x) "\";label=\"&" (chr x) "\";}")) key-lst)) ;;; start image_buttons (defun stim () (foreach x key-lst (action_tile (strcat "ib_" (chr x)) "(upd_txtp $key)"))) ;;; update edit_box , k = key (ib_$) (defun upd_txtp ( k / s l) (cond ;;; backspace ((and (eq k "ib_bksp") (> (setq l (strlen eb-txt)) 1)) (setq eb-txt (substr eb-txt 1 (1- l)))) ;;; backslash ((eq k "ib_bksl") (setq eb-txt (strcat eb-txt "\\"))) ;;; quotation mark ((eq k "ib_qmrk") (setq eb-txt (strcat eb-txt "\""))) ;;; use ' for space ((eq k "ib_'") (setq eb-txt (strcat eb-txt " "))) (t (setq eb-txt (strcat eb-txt (case (substr k 4))))) ) (if (wcmatch (strcase eb-txt t) "*bksp")(setq eb-txt "")) (start_image "ib_ib") (fill_image 0 0 (dimx_tile "ib_ib") (dimy_tile "ib_ib") 141) (end_image) (set_tile "ib_ib" eb-txt) (mode_tile k 2) (upd_lbox) ) (defun upd_lbox ( / filter) (if (not (vl-consp dip-list)) (setq dip-list '("void"))) (cond ((= eb-txt "") (setq dialog-list dip-list)) (t (setq filter (strcat "*" eb-txt "*")) (setq dialog-list (vl-remove-if-not '(lambda (x)(wcmatch (strcase x) (strcase filter))) dip-list)) ) ) (start_list "lb") (mapcar 'add_list dialog-list) (end_list) (set_tile "tp" (strcat " selected " (itoa (length dialog-list)) " of " (itoa (length dip-list)))) ) ;;; helper functions ;;; determine status caps lock for when typing filter (even though filter uses strcase) (defun case (s) (cond ((null s) "") ((not (eq (type s) 'STR)) "") ((null capslock) s) (t (if (= (acet-sys-keystate 20) 0) (strcase s t) (strcase s))))) ;;; generate number (gnum 1 5) -> '(1 2 3 4 5) (defun gnum (s e / i l) (and (numberp s)(numberp e)(setq i s)(while (<= i e)(setq l (cons i l) i (1+ i)))) (reverse l)) ; (SplitStr "a,b" ",") -> ("a" "b") (defun SplitStr (s d / p) (if (setq p (vl-string-search d s))(cons (substr s 1 p)(SplitStr (substr s (+ p 1 (strlen d))) d))(list s))) ;;; d = directory , e = extension like "*.dwg" , f = flag include subfolders (any value or nil) (defun alf (d e f) (setq d (vl-string-right-trim "/" (vl-string-translate "\\" "/" d))) (if f (apply 'append (cons (if (vl-directory-files d e)(mapcar '(lambda (x) (strcat d "/" x)) (vl-directory-files d e))) (mapcar '(lambda (x) (alf (strcat d "/" x) e f))(vl-remove ".." (vl-remove "." (vl-directory-files d nil -1)))))) (mapcar '(lambda (x) (strcat d "/" x))(vl-directory-files d e 1)))) ;;; test function (defun c:t1 () (setq lst (dip (alf (car (fnsplitl (findfile "acad.exe"))) "*.dwg" t))))

(mapcar '(lambda ( x ) (* x 1000.0)) ptlst)

You don't need another script. But here's one anyway. Maybe it helps someone who needs parts of this code some day command Test2 (vl-load-com) ;; if no parameter if given, then a list of all layers is given. ;; if a layer is given, the function returns True when the layer is "On", "not frozen" and "not locked". Else nil is returned (defun get_layers (lay / lyr table ret) (setq ret T) (vlax-for lyr (vla-get-layers (vla-get-activedocument (vlax-get-acad-object) ) ) (if (= (vla-get-name lyr) lay) (if (and (= :vlax-true (vla-get-layeron lyr)) (= :vlax-false (vla-get-freeze lyr)) (= :vlax-false (vla-get-lock lyr)) ) (setq ret T) (setq ret nil) ) ) (setq table (cons (vla-get-name lyr) table)) ) (if lay ret table ) ) (defun c:test ( / ) (get_layers nil) ) (defun c:test2 ( / ss ss2 i) (setq ss (ssget "_X" (list (cons 0 "*POLYLINE")))) (setq i 0) (setq ss2 (ssadd)) (repeat (sslength ss) (setq obj (ssname ss i)) (if (get_layers (cdr (assoc 8 (entget obj)))) ;; will skip things of layers that are off/frozen/locked (setq ss2 (ssadd (ssname ss i) ss2)) ) (setq i (+ i 1)) ) (sssetfirst nil ss2) (princ) )

Try this. It will ask you to select the blocks on the screen and will fill the empty or blank attributes with numbers - this can be changed. Post a sample drawing, this LISP can be modified further but that basic of what you want are here (defun c:test ( / MySS acounter acount MyObj BlkAtts n) (defun LM:vl-getattributevalues ( blk ) ;;blk is object ;; refer to Lee Macs website (mapcar '(lambda ( att ) (cons (vla-get-tagstring att) (vla-get-textstring att))) (vlax-invoke blk 'getattributes)) ) (defun LM:vl-setattributevalue ( blk tag val ) ;;refer to Lee Macs website (setq tag (strcase tag)) (vl-some '(lambda ( att ) (if (= tag (strcase (vla-get-tagstring att))) (progn (vla-put-textstring att val) val) ) ) (vlax-invoke blk 'getattributes) ) ) (setq MySS (ssget '((0 . "INSERT")))) ;;Select only blocks ;; (setq MySS (ssget '((0 . "INSERT")(2 . blkname)))) ;;Select only named blocks if block name supplied (setq acounter 0) ;; A counter for looping through the selection set (while (< acounter (sslength MySS)) ;; Start loop through selected blocks (setq MyObj (vlax-ename->vla-object (ssname MySS acounter))) ;; Get the block object (setq BlkAtts (LM:vl-getattributevalues MyObj)) ;; use Lee Mac lisp above to list attributes and values (setq acount 0) ;; A count for each empty attribute (foreach n BlkAtts ;; Loop through the block atributes (if (= (cdr n) "") ;; If block attribute is empty (LM:vl-setattributevalue MyObj (car n) (rtos acount)) ;; set it to a value ) ; end if (setq acount (+ acount 1)) ;;increment the value to attribute ) ; end foreach (setq acounter (+ acounter 1)) ;; increment the selection set counter ) ; end while )

(defun c:TH2 (/ ss pnt) (while (setq ss (ssget ":L" '((0 . "TEXT") ))) ;Selects only text on unlocked layers (foreach txt (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (setq pnt (trans (cdr (assoc 10 (entget txt))) 0 1)) (setpropertyvalue txt "Height" 2) (setpropertyvalue txt "WIDTHFACTOR" 0.8) ; ADD THIS LINE ) ) (princ) ) And for another routine (vlax-put-property obj 'height 2) ; Set the height value to 2 in this obj. (vlax-put-property obj 'WIDTHFACTOR 0.8) ; Set the WIDTH value to .8 in this obj. <<<< ADD THIS LINE