Author Topic: Stumped?  (Read 4071 times)

0 Members and 1 Guest are viewing this topic.

V-Man

  • Bull Frog
  • Posts: 343
  • I exist therefore I am! Finally Retired!
Stumped?
« 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.

Code: [Select]

 ;;;********** 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
Code: [Select]

// 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;
}
AutoCAD 9 - 2023, AutoCADMap 2008 - 2010, Revit 2012 - 2022, Autocad Civil 3D 2023

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Stumped?
« Reply #1 on: May 06, 2004, 11:00:42 AM »
Here is one that uses a layer list,
sorry don't have time to review your code...

Code: [Select]
//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 */



Code: [Select]
;;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)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Anonymous

  • Guest
Stumped?
« Reply #2 on: May 07, 2004, 11:44:43 AM »
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.

SMadsen

  • Guest
Stumped?
« Reply #3 on: May 07, 2004, 10:03:38 PM »
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:

Code: [Select]
// 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;
}


Code: [Select]
;; 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)
         )
        )
)

Anonymous

  • Guest
Stumped?
« Reply #4 on: May 08, 2004, 10:03:53 AM »
Thanks Stig for the help. I didn't think of combining the list with all of the information. That is exactly what I needed.

SMadsen

  • Guest
Stumped?
« Reply #5 on: May 08, 2004, 07:58:22 PM »
My pleasure ...

Anonymous

  • Guest
Stumped?
« Reply #6 on: May 08, 2004, 08:40:19 PM »
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))

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Stumped?
« Reply #7 on: May 08, 2004, 10:12:21 PM »
Perhaps try something like this  ...

regards.Kerry

Code: [Select]

(defun mysort (lst /)                                      
  (mapcar '(lambda (item) (assoc item lst))
          (acad_strlsort (mapcar 'car lst))
  )
)


Test it to make sure :
Code: [Select]

(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 ...
Code: [Select]

;< snip >

(setq laylist (mysort laylist)
      dcl_id  (load_dialog "layerexample.dcl")
)
;;< snip >
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

Anonymous

  • Guest
Stumped?
« Reply #8 on: May 08, 2004, 11:16:15 PM »
There it is. Thanks for the code. That really did it.