TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: V-Man on May 06, 2004, 10:24:22 AM
-
Hey guys, I need a little assistance here. I'm trying with this code to gather a list of the layers in the drawing along with their Color and Linetype. What I'm trying to accomplish is through a dialog box have the layers populate the List Box and once the user selects a layer in the List Box the Color and Linetype will automaticall populate the text in a dialog box. Please see code below.
;;;********** Main Function **********
(defun C:Test1 (/)
(setq M:ERR *ERROR* *ERROR* *MERR*
CME (getvar "CMDECHO")
OSM (getvar "OSMODE")
NLA (getvar "CLAYER")
);;setq
(setvar "CMDECHO" 0) (setvar "OSMODE" 0) (setvar "PLINEWID" 0)
;;;********** Make a List of Defined Layers **********
(setq LNAME (cdr (assoc 2 (tblnext "layer" T)))
LALIST (list LNAME)
);;setq
(while (/= LNAME nil)
(setq LNAME (cdr (assoc 2 (tblnext "layer"))))
(if (/= LNAME nil)
(progn
(setq APP (list LNAME)
LALIST (append LALIST APP)
);;setq
);;progn
);;if
);;while
(tblnext "layer" "rewind")
(setq LALIST (acad_strlsort LALIST))
;;;********** Set Up Values **********
(setq DCL_ID (load_dialog "ttest.DCL"))
(if (not (new_dialog "ttest" DCL_ID)) (exit))
(start_list "llist")
(mapcar 'add_list LALIST)
(end_list)
;;;********** Set Tile Section **********
(set_tile "layer" NLA)
(set_tile "error" "Copyright (C) \"Donald Varino 2004\"")
;;;********** Action Tile Section **********
(action_tile "llist" "(setq NLA (nth (atoi $value) LALIST))
(set_tile \"layer\" NLA)")
(action_tile "layer" "(setq NLA $value)")
(action_tile "accept" "(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
;;;********** Start Dialog and Execute Selection **********
(setq NEXT (start_dialog))
(unload_dialog DCL_ID)
(command "_.layer" "set" "0" "")
(setvar "CMDECHO" CME)
(setvar "OSMODE" OSM)
(setq *ERROR* M:ERR M:ERR nil)
(princ)
);end defun
Here's the code for the Dialog Box
// Test1.DCL
test1 : dialog {
label = "Layer Utility";
: row {
: boxed_column {
label = "Select Layer from List";
: list_box {
key = "llist";
}
}
}
spacer;
spacer;
: boxed_column {
label = "Layer Selected";
: text {
key = "layer";
width = 40;
}
:row {
: text {
width = 6;
key = "clrtxt";
value = "Color";
alignment =right;
}
:text{
value = "#";
key = "Clrnum";
width = 6;
alignment =left;
}
:text{
value = "Linetype";
key = "Lintype";
width = 25;
alignment = left;
}
}
}//end boxed column
spacer;
: edit_box {
label = "New Layer Name :";
mnemonic = "N";
fixed_width = false;
key = "layer1";
}
: edit_box {
label = "Layer Prefix? : ";
mnemonic = "P";
fixed_width = true;
key = "nbreaks";
}
: edit_box {
label = "Layer Suffix? : ";
mnemonic = "S";
fixed_width = true;
key = "nbreaks1";
}
spacer;
ok_cancel;
spacer;
errtile;
}
-
Here is one that uses a layer list,
sorry don't have time to review your code...
//SX.DCL Shadow Box
SX : dialog {
label = "Shadow Box" ;
spacer_1 ;
: row {
: boxed_column {
label = "Shaded Part" ;
: image {
aspect_ratio = 0.8 ;
color = 0 ;
fixed_width = true ;
width = 16 ;
key = "image" ;
}
: row {
fixed_width = true ;
alignment = centered ;
: edit_box {
fixed_width = true ;
width = 5 ;
key = "edt_wth" ;
}
} /* row */
} /* boxed_column */
: boxed_column {
label = "Select Layer" ;
: list_box {
key = "llist" ;
}
: row {
: text_part {
label = "Layer for Shadow :" ;
mnemonic = "L" ;
}
: text {
key = "layer" ;
width = 12 ;
}
} /* row */
} /* boxed_column */
} /* row */
spacer_1 ;
ok_cancel ;
: text {
label = "Copyright (c) 2002 Theo Winata and You" ;
alignment = left ;
}
} /* End of SX dialog box */
;;Tip1854 sx.LSP SHADOW BOX (c) 2003 Theodorus Winata
;;; DESCRIPTION
;;; A function to draw shade image. The shown image is in
;;; the SX.SLB file. The dialogue contains a list of layer
;;; selections and an edit box to control the shade. The
;;; dialogue is defined in the SX.DCL file.
;;;
;;; By Theodorus Winata
;;; 1024-89 Avenue S.W.
;;; Calgary, Alberta
;;; Canada T2V 0W4
;;;
;;;********** Function to Set Layer **********
(defun set-layer ()
(command "_.Layer" "set" NLA "")
(princ)
);;set-layer
;;;********** Function to Show Slide Image **********
(defun shade (sld /)
(start_image "image")
(fill_image 0 0 width height 0)
(slide_image 0 0 width height (strcat "SX.slb (" sld ")"))
(end_image)
);;shade
;;;********** Main Function **********
(defun C:SX (/ APP CME DCL_ID EN1 EN2 HEIGHT LALIST LNAME M:ERR NLA
NEXT OSM PLW PT1 PT2 PT3 PT4 PT5 PT6 PT7 SW1 WIDTH)
(setq M:ERR *ERROR* *ERROR* *MERR*
CME (getvar "CMDECHO")
NLA (getvar "CLAYER")
OSM (getvar "OSMODE")
PLW (getvar "PLINEWID")
);;setq
;;;********** Make a List of Defined Layers **********
(setq LNAME (cdr (assoc 2 (tblnext "layer" T)))
LALIST (list LNAME)
);;setq
(while (/= LNAME nil)
(setq LNAME (cdr (assoc 2 (tblnext "layer"))))
(if (/= LNAME nil)
(progn
(setq APP (list LNAME)
LALIST (append LALIST APP)
);;setq
);;progn
);;if
);;while
(tblnext "layer" "rewind")
(setq LALIST (acad_strlsort LALIST))
;;;********** Initialize Dialog Box **********
(setq DCL_ID (load_dialog "SX.dcl"))
(if (not (new_dialog "SX" DCL_ID)) (exit))
(start_list "llist")
(mapcar 'add_list LALIST)
(end_list)
(if (not SW) (setq SW 0.25))
(setq YN "")
(setq WIDTH (dimx_tile "image")
HEIGHT (dimy_tile "image")
);;setq
;;;********** Set Tile Section **********
(set_tile "layer" NLA)
(set_tile "edt_wth" (rtos SW 2 2)) (shade "SHADOW")
;;;********** Action Tile Section **********
(action_tile "llist" "(setq NLA (nth (atoi $value) LALIST))
(set_tile \"layer\" NLA)")
(action_tile "layer" "(setq NLA $value)")
(action_tile "edt_wth" "(setq SW (distof $value 4))
(shade \"SHADOW\")")
(action_tile "accept" "(done_dialog 4)")
(action_tile "cancel" "(done_dialog)")
;;;********** Start Dialog and Execution **********
(setq NEXT (start_dialog))
(unload_dialog DCL_ID)
(if (= NEXT 4)
(while (= YN "")
(progn
(set-layer)
(setvar "CMDECHO" 0) (setvar "PLINEWID" 0) (setvar "OSMODE" 0)
(setq SW1 (/ SW 2)
PT1 (getpoint "\nPick Lower Left Corner: ")
PT2 (getcorner PT1 "\nPick Upper Right Corner: ")
PT3 (list (car PT1) (cadr PT2))
PT4 (list (car PT2) (cadr PT1))
PT5 (list (car (polar PT1 (* pi 2) SW))
(cadr (polar PT1 (* pi 1.5) SW1)))
PT7 (list (car (polar PT2 (* pi 2) SW1))
(cadr (polar PT2 (* pi 1.5) SW)))
PT6 (list (car PT7) (cadr PT5))
);;setq
(command "_.PLINE" PT1 PT3 PT2 PT4 "_C")
(setq EN1 (entlast))
(command "_.PLINE" PT5 "w" SW SW PT6 PT7 "")
(setq EN2 (entlast))
(command "-Group" "" "*" "" EN1 EN2 "")
(setq YN (strcase (getstring "\nAnother box? <Yes>/No: ")))
(if (= YN "Y") (setq YN ""))
(setvar "CMDECHO" CME) (setvar "CLAYER" NLA)
(setvar "OSMODE" OSM) (setvar "PLINEWID" PLW)
(setq *ERROR* M:ERR M:ERR nil)
);;progn
);;while
);;if
(princ)
);;C:SX
(prompt "\nType SX to execute...")
(princ)
-
Well, That basically does what my code does. I need to be able to get the Color and Linetype of the layer selected in the List.
-
Donald,
I'd suggest that you gather all the info you need at once and stuff it into a list. For layer names, colors and ltypes it would read e.g. (("Layer1" 7 "Continuous")("Layer2" 3 "Dashed") ... )
Here's a small dialog and the code to illustrate:
// layerExample
layerDlg : dialog {
: column {
: list_box {
key = "layernames";
height = 12;
width = 30;
}
: row {
: text {
label = "Color:";
}
: text {
key = "color";
}
: image {
key = "showcolor";
fixed_width = true;
width = 2;
aspect_ratio = 1.0;
color = -15;
}
: spacer_1 {}
}
: row {
: text {
label = "LType:";
}
: text {
key = "ltype";
width = 20;
}
}
}
ok_only;
}
;; layerExample.lsp
;; Just a small utility to fill color into an image
;; tile. If color is 9, draw a black frame to prevent
;; it from blending into dialog background color
(defun fillColor (tile col / x y)
(setq x (dimx_tile tile)
y (dimy_tile tile))
(and (not col)(setq col -15))
(start_image tile)
(cond ((/= col 9)
(fill_image 0 0 x y col))
((= col 9)
(fill_image 0 0 x y 0)
(fill_image 1 1 (- x 2) (- y 2) col))
)
(end_image)
)
(defun C:ShowLayers (/ laylist layer dcl_id showInfo)
;; ShowInfo takes care of extracting info from the
;; selected layers sublist and showing the stuff
(defun showInfo (index lst / layerInfo color)
(setq layerInfo (nth (atoi index) lst)
color (cond ((nth (1- (cadr layerInfo))
'("red" "yellow" "green" "cyan" "blue" "magenta" "white")
)
)
((itoa (cadr layerInfo)))
)
)
(set_tile "color" color)
(fillColor "showcolor" (cadr layerInfo))
(set_tile "ltype" (caddr layerInfo))
(princ)
)
;; main routine
;; Get all layers with their colors and ltypes, and stuff
;; it all into one list
(while (setq layer (tblnext "LAYER" (not layer)))
;; insert code here to weed out xref layers and such
(setq laylist (cons (list (cdr (assoc 2 layer))
(abs (cdr (assoc 62 layer)))
(cdr (assoc 6 layer))
)
laylist
)
)
)
;; Insert code to sort list here. In this example, we'll
;; just reverse the list.
(setq laylist (reverse laylist)
dcl_id (load_dialog "layerexample.dcl"))
(cond ((new_dialog "layerDlg" dcl_id)
(start_list "layernames")
;; fill list_box with car values only (i.e. layer names)
(mapcar 'add_list (mapcar 'car laylist))
(end_list)
(action_tile "layernames" "(showInfo $value laylist)")
(start_dialog)
)
)
)
-
Thanks Stig for the help. I didn't think of combining the list with all of the information. That is exactly what I needed.
-
My pleasure ...
-
For some reason I cannot get this to sort the layers. I tried using the following code but no success. Any ideas.
(setq laylist (acad_strlsort laylist))
-
Perhaps try something like this ...
regards.Kerry
(defun mysort (lst /)
(mapcar '(lambda (item) (assoc item lst))
(acad_strlsort (mapcar 'car lst))
)
)
Test it to make sure :
(setq testlist '(("Defpoints" 7 "Continuous") ("Alpha" 3 "Continuous") ("Charlie" 5 "Continuous")("Bravo" 5 "Continuous")))
(mysort testlist)
;;-> (("Alpha" 3 "Continuous") ("Bravo" 5 "Continuous") ("Charlie" 5 "Continuous") ("Defpoints" 7 "Continuous"))
So ... try this ...
;< snip >
(setq laylist (mysort laylist)
dcl_id (load_dialog "layerexample.dcl")
)
;;< snip >
-
There it is. Thanks for the code. That really did it.