Leaderboard

Nice one Grrr. Having all the settings right in front of you and ready to use is definitely faster than Layer Manager, especially when you use a large number of layers. I've made this lisp for my own use and, because of my working style (same CTB used for a long time based on colors only, no LineWeight, no True Colors), layer name and the color is just fine. Adding more features makes it slow and you can lose almost any advantage over the Layer Manager. Again, my simple lisp was exactly what I needed. Anyway, the ORIGINAL idea was not the speed! If you test my lisp, when you pre-select some objects then run the lisp, in the end all selected objects will be on the new created layer, and that is how I use it.

Interesting to say the least. It started with the news that Hexagon PPM are the new owners of Bricscad. But my main interest of the day has been the new and improved tools that have been showcased I won't even attempt to describe them, I couldn't do it justice, but if you follow Bricscad keep an eye out in the next couple of days for the videos from the conference there are some truly impressive improvements to what in my mind is already a winning software package. It will be interesting to see what day 2 brings.

Try the following for rectangles at any rotation & orientation: ;; Rectangle in Rectangle - Lee Mac ;; Constructs lines between the vertices of rectangles inside rectangles. (defun c:rr ( / a e i l m p r s v x ) (if (setq s (ssget '((0 . "LWPOLYLINE") (90 . 4) (-4 . "&=") (70 . 1)))) (progn (repeat (setq i (sslength s)) (setq i (1- i) e (entget (ssname s i)) v (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) e)) a (angle (car v) (cadr v)) ) (if (and (equal (distance (car v) (cadr v)) (distance (caddr v) (cadddr v)) 1e-8) (equal (distance (cadr v) (caddr v)) (distance (car v) (cadddr v)) 1e-8) (equal (distance (car v) (caddr v)) (distance (cadr v) (cadddr v)) 1e-8) ) (progn (if (apply 'LM:clockwise-p (mapcar '(lambda ( a b ) a) v '(0 1 2))) (setq v (reverse v)) ) (setq m (list (list (cos a) (sin a)) (list (- (sin a)) (cos a))) r (mapcar '(lambda ( x ) (mxv m x)) v) p (apply 'mapcar (cons 'min r)) ) (while (not (equal p (car r) 1e-8)) (setq r (append (cdr r) (list (car r))) v (append (cdr v) (list (car v))) ) ) (setq l (cons (list r v (cdr (assoc 38 e)) (cdr (assoc 210 e))) l)) ) ) ) (setq l (vl-sort l '(lambda ( a b ) (< (caaar a) (caaar b))))) (while (setq x (car l)) (setq l (vl-remove-if (function (lambda ( y / n z ) (if (and (vl-every '<= (caar x) (caar y) (caddar y) (caddar x)) (equal (setq z (caddr x)) (caddr y) 1e-8) (equal (setq n (cadddr x)) (cadddr y) 1e-8) ) (mapcar (function (lambda ( a b ) (entmake (list '(000 . "LINE") (cons 010 (trans (append a (list z)) n 0)) (cons 011 (trans (append b (list z)) n 0)) ) ) ) ) (cadr x) (cadr y) ) ) ) ) (cdr l) ) ) ) ) ) (princ) ) ;; Clockwise-p - Lee Mac ;; Returns T if p1,p2,p3 are clockwise oriented (defun LM:clockwise-p ( p1 p2 p3 ) (< (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1))) (* (- (cadr p2) (cadr p1)) (- (car p3) (car p1))) ) ) ;; Matrix x Vector - Vladimir Nesterovsky ;; Args: m - nxn matrix, v - vector in R^n (defun mxv ( m v ) (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m) ) (princ)

Hi Stefan, I pointed that out, because the coding is good but I couldn't recognise who's style it was. For a long time (few years) a "quick layer" routine was on my todolist, but finally got the skills to write one myself (per mine requirements). And finally managed to utilise my ImageButtonColorPrompt subfoo, as it got rusty in my archive. ( @rlx might like it, since I took the idea from one of his DCL routines ) ; QuickLayer - Grrr ; Credits to Lee Mac (defun C:test ( / layers tmpL *error* dcl des dch dcf lnm col rtn ) (setq layers ((lambda ( / d L ) (while (setq d (tblnext "LAYER" (not d))) (setq L (cons (cdr (assoc 2 d)) L))) L))) (setq tmpL '( (87 114 105 116 116 101 110 32 98 121 32 71 114 114 114) (_Transparency ( k def / i L ) (repeat (setq i 91) (setq L (cons (itoa (setq i (1- i))) L))) (start_list k) (mapcar 'add_list L) (end_list) (set_tile k (itoa (vl-position def L))) L ) (_Plottable ( k def / L ) (start_list k) (mapcar 'add_list (setq L '("Yes" "No"))) (end_list) L ) (_Lineweight ( k def / r ) (start_list k) (mapcar 'add_list (mapcar '(lambda (x) ( (lambda (xx / tmp) (cond ( (= 3 (length (setq tmp (vl-string->list xx)))) (apply '(lambda (a b c) (vl-list->string (list a 46 b c))) tmp) ) ( (= 11 (strlen xx)) (substr xx 5) ) ( xx ) ) ) (substr (vl-prin1-to-string x) 7) ) ) (setq r '( acLnWtByLayer acLnWtByBlock acLnWtByLwDefault acLnWt000 acLnWt005 acLnWt009 acLnWt013 acLnWt015 acLnWt018 acLnWt020 acLnWt025 acLnWt030 acLnWt035 acLnWt040 acLnWt050 acLnWt053 acLnWt060 acLnWt070 acLnWt080 acLnWt090 acLnWt100 acLnWt106 acLnWt120 acLnWt140 acLnWt158 acLnWt200 acLnWt211 ) ) ) ) (end_list) (set_tile k (itoa (vl-position def r))) r ) (_Linetype ( k def / d L ) (while (setq d (tblnext "LTYPE" (not d))) (setq L (cons (cdr (assoc 2 d)) L))) (if L (progn (setq L (acad_strlsort L)) (start_list k) (mapcar 'add_list L) (end_list) (set_tile k (itoa (vl-position def L))) L ) ) ) ) ) (defun *error* ( msg ) (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 msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\nError: " msg)))) (princ) ) (cond ( (not (and (setq dcl (vl-filename-mktemp nil nil ".dcl")) (setq des (open dcl "w")) (mapcar (function (lambda (x) (princ (strcat "\n" x) des))) '("test : dialog " "{ label = \"Quick Layer\"; width = 36; spacer_1;" " : boxed_column" " { label = \"Input Layer Name\"; " " : edit_box { key = \"lnm\"; fixed_width = false; }" " spacer;" " }" " spacer_1;" " : boxed_column" " { alignment = centered; label = \"Layer Properties\"; children_fixed_width = false;" " spacer;" " : row" " { " " : text { label = \"Color\"; alignment = left; }" " : spacer { width = 2.0; }" " : image_button { key = \"col\"; width = 2.4; aspect_ratio = 1.8; color = graphics_background; fixed_width = false; } " " }" " : popup_list { label = \"Transparency\"; key = \"trn\"; edit_width = 6; }" " : popup_list { label = \"Plottable?\"; key = \"plt\"; edit_width = 6; }" " : popup_list { label = \"Lineweight\"; key = \"lw\"; edit_width = 16; }" " : popup_list { label = \"Linetype\"; key = \"lt\"; edit_width = 16; }" " spacer_1;" " : row { alignment = centered; spacer; : toggle { label = \"Current?\"; key = \"cur\"; alignment = centered; value = 1; } } " " spacer_1; " " }" " spacer_1; ok_cancel; errtile;" "}" ) ) (not (setq des (close des))) (< 0 (setq dch (load_dialog dcl))) ) ) (prompt "\nUnable to write or load the DCL file.") ) ( (not (new_dialog "test" dch)) (prompt "\nUnable to display the dialog") ) ( (progn (mode_tile "lnm" 2) (ImageButtonColorPrompt "col" 20 'col) (setq tmpL (apply 'mapcar (cons ''(( x k d ) ((cdr x) k d)) (cons (cdr tmpL) '(("trn" "plt" "lw" "lt") ("0" "Yes" acLnWtByLayer "Continuous")))))) (foreach x '(lnm accept) (action_tile (strcase (vl-prin1-to-string x) t) (vl-prin1-to-string '( (lambda ( lnm / tmp ) (setq tmp (strcase lnm)) (cond ( (not (snvalid lnm)) (set_tile "error" (strcat "Invalid layer name: " lnm)) (if (= $key "lnm") (set_tile $key $data) (mode_tile "lnm" 2)) ) ( (setq tmp (vl-some '(lambda (x) (if (= tmp (strcase x)) x)) layers)) (set_tile "error" (strcat "Layer \"" tmp "\" exists!")) (if (= $key "lnm") (set_tile $key $data) (mode_tile "lnm" 2)) ) (t (if (= $key "lnm") (client_data_tile $key lnm)) (set_tile "error" (strcat "Layername \"" lnm "\" is fine")) (if (or (/= $key "lnm") (and (= $key "lnm") (= 1 $reason)) ) (progn (setq rtn (append (list (cons 'col col)) (mapcar ''((x) (cons x (get_tile (strcase (vl-prin1-to-string x) t)))) '(lnm cur)) (mapcar ''((k a) (cons (read k) (nth (atoi (get_tile k)) a))) '("trn" "plt" "lw" "lt") tmpL) ) ) (done_dialog 1) ) ) ) ) ) (get_tile "lnm") ) ) ) ) (/= 1 (setq dcf (start_dialog))) ) (prompt "\nUser cancelled or terminated the dialog.") ) ( ( '(( / f L ) (setq f '((k L)(cdr (assoc k L)))) (setq L (list (f 'lnm rtn) (f 'col rtn) (f 'lt rtn) (eval (f 'lw rtn)) (= "Yes" (f 'plt rtn)) (atoi (f 'trn rtn)) (= "1" (f 'cur rtn)))) (apply 'CreateLayer L) ) ) ) ) (*error* nil) (princ) ) ; This one is assembled by Grrr... ; key - [STR] key of an image_button ; def - [INT] ACI value for the very first default color prompt ; sym - [SYM] symbol name to bound the value ; the return value is stored in the specified symbol ; Note1: the specified ACI color is stored in the tile's $data (so it would be default for further inputs) ; Note2: for true colors its recomended (LM:True->ACI) function ; Usage example: (ImageButtonColorPrompt "img1" 20 'col) '(87 114 105 116 116 101 110 32 98 121 32 71 114 114 114) (defun ImageButtonColorPrompt ( key def sym ) (action_tile key (strcat "(setq " (vl-prin1-to-string sym) " " " (" " (lambda ( def )" (vl-prin1-to-string (quote ( (lambda ( / tmp val ) (if (setq tmp (acad_truecolordlg (cond ( (and $data (/= $data "") (setq tmp (read $data))) (cond ( (assoc 430 tmp) ) ( (assoc 420 tmp) ) ( (assoc 62 tmp) ) ) ) (def) (1) ) t ) ) ( (lambda ( k col / w h ) (setq w (1- (dimx_tile k))) (setq h (1- (dimy_tile k))) (start_image k) (fill_image 0 0 w h col) (end_image) (client_data_tile $key (vl-prin1-to-string tmp)) tmp ) $key (cond ( (and LM:True->ACI (setq val (cdr (assoc 420 tmp)))) (LM:True->ACI val) ) ( (cdr (assoc 62 tmp)) ) ) ) ) ) ) ) ) " )" (cond (def (vl-prin1-to-string def)) ("nil")) " )" ")" ) ) ) ; This one is assembled by Grrr from Lee Mac's subfunctions here and there... '(67 114 101 100 105 116 115 32 116 111 32 76 101 101 32 77 97 99) (defun CreateLayer ( name colour linetype lineweight plot transparency makecurrent / rtn ) (regapp "accmtransparency") (if (not (tblobjname "LAYER" name)) (setq rtn (entmake (append '((0 . "LAYER")(100 . "AcDbSymbolTableRecord")(100 . "AcDbLayerTableRecord")(70 . 0)) (list (cons 2 name) (cons 6 (if (tblsearch "LTYPE" linetype) linetype "Continuous")) ) colour (list (cons 290 (if plot 1 0)) (cons 370 lineweight) ) (if transparency (list (list -3 (list "accmtransparency" (cons 1071 ( (lambda ( x ) (logior (fix (* 2.55 (- 100 x))) 33554432)) transparency ))))) ) ) ) ) ) (if makecurrent (setvar 'clayer name)) rtn ) ;; True -> ACI - Lee Mac ;; Args: c - [int] True Colour (defun LM:True->ACI ( c / o r ) (apply 'LM:RGB->ACI (LM:True->RGB c)) ) ;; RGB -> ACI - Lee Mac ;; Args: r,g,b - [int] Red, Green, Blue values (defun LM:RGB->ACI ( r g b / c o ) (if (setq o (vla-getinterfaceobject (LM:acapp) (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2)))) (progn (setq c (vl-catch-all-apply '(lambda ( ) (vla-setrgb o r g b) (vla-get-colorindex o)))) (vlax-release-object o) (if (vl-catch-all-error-p c) (prompt (strcat "\nError: " (vl-catch-all-error-message c))) c ) ) ) ) ;; True -> RGB - Lee Mac ;; Args: c - [int] True Colour (defun LM:True->RGB ( c ) (mapcar '(lambda ( x ) (lsh (lsh (fix c) x) -24)) '(8 16 24)) ) ;; Application Object - Lee Mac ;; Returns the VLA Application Object (defun LM:acapp nil (eval (list 'defun 'LM:acapp 'nil (vlax-get-acad-object))) (LM:acapp) )