lisp to create layer and invoke colour picker

[woodman78]

Does anyone have a routine for creating layers that would allow the user to enter the layer name and invoke the colour picker window so the user can select a colour for the layer?

 

Thanks.

[pBe]

Does anyone have a routine for creating layers that would allow the user to enter the layer name and invoke the colour picker window so the user can select a colour for the layer?

 

Thanks.

 

 

(defun c:tryme (/ Layername LayerColor)
      (setq Layername (getstring "\nEnter Layer Name:" T)
            LayerColor ([color=blue]acad_colordlg[/color]  1 nil))
  (entmake (list (cons 0 "LAYER")
                (cons 100 "AcDbSymbolTableRecord")
                (cons 100 "AcDbLayerTableRecord")
                (cons 2 Layername)
                (cons 62 LayerColor)      
                (cons 70 0)))
(princ (strcat "\nLayer " (strcase Layername) " Created:"))
(princ)
)

[woodman78]

Thanks pBe, I have modified what you gave me to this:

landowner: dialog
{label = "Landowner Layer Creation";
   : edit_box 
            {
   label = "Enter landowner name :";
   key = "name";
   alignment = centered;
   edit_limit = 45;
   edit_width = 50;
   }

   : button    
   {
   key = "accept";
   label = "OK";
   is_default = true;
   fixed_width = true;
   alignment = centered;
   }

   : errtile
   {
   width = 34;
   }
}

 

(defun c:landowner (/ Layername LayerColor name)
(setq SUCE (getvar "cmdecho"))
 (setq SUOM (getvar "orthomode"))
 (setq SUSM (getvar "osmode"))
 (setq SUAB (getvar "angbase"))
 (setq SUAD (getvar "angdir"))
 (setq SUCL (getvar "clayer"))
 (setq SUCR (getvar "cecolor"))
(setq dcl_id (load_dialog "landowner.dcl"))
    (if (not (new_dialog "landowner" dcl_id))
    (exit)
    );if
(if *name1*
   (set_tile "name" *name1*)
   (set_tile "name" "Default")
 )
(action_tile "name" "(setq *name1* $value)")
(start_dialog)
(unload_dialog dcl_id)
(setq layername (strcat "CCC_LANDOWNER_"*name1*)
            LayerColor (acad_colordlg 1 nil))
  (entmake (list (cons 0 "LAYER")
                (cons 100 "AcDbSymbolTableRecord")
                (cons 100 "AcDbLayerTableRecord")
                (cons 2 Layername)
                (cons 62 LayerColor)      
                (cons 70 0)))
(setvar "clayer" layername)
(command "._pline")
(while (= 1 (logand 1 (getvar "cmdactive")))
(command pause))
 (setq pline (entlast)
   elist (entget pline)
   )
(command "_.draworder" pline "" "_F");<--set pline's draw order to front 
 (setvar "hpname" "honey")
 (setvar "hpscale" 2)
 (command "-hatch" "S" pline "" "") 
 (setvar "hpname" ".")

 (setvar "cmdecho"   SUCE)
 (setvar "orthomode" SUOM)
 (setvar "osmode"    SUSM)
 (setvar "angbase"   SUAB)
 (setvar "angdir"    SUAD)
 (setvar "clayer"    SUCL)
 (setvar "cecolor"    SUCR)

(princ)
)

 

I have been playing around with the colordlg and truecolordlg as well as how to convert an autocad colour to truecolour. At the moment the code allows the user to pick a color and creates a layer with that colour and then a pline and a hatch based on the bylayer colour. Here's what I am hoping to do. Have the user pick the autocad colour as now and set that colour to the layer colour. Then convert the colour to truecolour and add set the luminence up to 80. I want to do this so that the colour of the hatch will be lighter than that of the pline and I was hoping to automate it.

 

Can you help?

[pBe]

........ add set the luminence up to 80.

 

Not sure what you mean by this

 

but for truecolor you can do it this way

 

[color=slategray](unload_dialog dcl_id)[/color]
[color=slategray](setq layername (strcat "CCC_LANDOWNER_"*name1*)[/color]
            [color=slategray]LayerColor [/color][color=blue](acad_truecolordlg '(62 . 7) nil))[/color]
  [color=slategray](entmake [/color][color=blue](vl-remove nil[/color]
[color=slategray](list (cons 0 "LAYER")[/color]
[color=slategray]              (cons 100 "AcDbSymbolTableRecord")[/color]
[color=slategray]              (cons 100 "AcDbLayerTableRecord")[/color]
[color=slategray]              (cons 2 Layername)[/color]
                [color=blue](car LayerColor) [/color]
[color=blue]              (if (> (length LayerColor) 1)[/color]
[color=blue]                  (car (cdr LayerColor))) [/color] 
               [color=slategray] (cons 70 0)[color=blue])[/color]))[/color]
[color=slategray](setvar "clayer" layername)[/color]
[color=slategray]........................[/color]

 

When selecting the color from the palette you have an option to select Truecolor or Index Color

 

What i dont understand is the luminence value, are you wanting the pline boundary and the hatch on diffrerent colors? if so. one of them would be color by entity and one would remain bylayer

 

 

[color=slategray](command pause))[/color]
[color=slategray](setq pline (entlast)[/color]
[color=slategray] elist (entget pline)[/color]
[color=slategray] )[/color]
[color=blue](command "_chprop" pline "" "_color" (cdr (car LayerColor)) "" "")[/color]
[color=slategray](command "_.draworder" pline "" "_F")[/color]

 

This will convert the pline to index color and the hatch will remain bylayer

 

Otherwise create a separate layer for the hatch if you want the all colors to remain bylayer

 

So.. how do you set the luminence by the way? can you show me how?

[Lee Mac]

Luminance is the 'L' in the HSL colour model :wink:

Edited June 3, 2011 by Lee Mac

[woodman78]

Thanks pBe, that is great. That is exactly what I want but the other way around. I want the pline to remain bylayer and the hatch to be index colour.

The luminence I'm talking about is the slide on the RGB tab in colour dialog. I want to set a standard offset value to that if a user picks red from the index colour dialog, it gets converted to RGB and this becomes the bylayer colour. The luminence value of the main index colours in CAd in 50. So a new colour is then created were the luminence is increased to say 80 so that the new colour is a lighter shade of the index colour. There may be a very easy way of doing this and even of explaining it but this is what I am hoping to do.

 

[woodman78]

That's a lot shorter way of describing it but yes LeeMac thats what I want. Thanks.

[pBe]

Luminence is the 'L' in the HSL colour model :wink:

 

but of course it is

 

but i'm still clueless though

 

I'll look it up later Lee, Thanks

[Lee Mac]

This might be a slightly cleaner way to approach it:

 

(defun c:test ( / layer lst )

 (setq layer "Layer1")

 (if (setq lst (acad_truecolordlg '(62 . 7) nil))
   (entmake
     (list
       (cons 0 "LAYER")
       (cons 100 "AcDbSymbolTableRecord")
       (cons 100 "AcDbLayerTableRecord")
       (cons 2 layer)
       (cons 70 0)
       (cond
         ( (assoc 420 lst) )
         ( (assoc  62 lst) )
       )
     )
   )
 )
 (princ)
)

[pBe]

This might be a slightly cleaner way to approach it:

 

(cond
( (assoc 420 lst) )
( (assoc 62 lst) )

 

Indeed it is

[Lee Mac]

Woodman,

 

Are you wanting to control the Luminance of the colour independent of the user's colour selection? I.e. Use the Hue/Saturation values from the selection, but set the luminance to a specific value?

[woodman78]

Hi LeeMac,

That sounds about right. I want to retain the colour but for it to be a lighter shade of the original and was hoping to do this with the luminance. I was hoping to add a standard value of 30 or something like that to the luminance to create the lighter colours.

Thanks.

[Lee Mac]

I want to retain the colour but for it to be a lighter shade of the original and was hoping to do this with the luminance. I was hoping to add a standard value of 30 or something like that to the luminance to create the lighter colours.

 

Try something along these lines:

 

;; Arguments:
;; tc  - TrueColour value (Integer)
;; lum - Luminance value (Integer 0 <= lum <= 100)
;; Returns: TrueColour value with Luminance set to value specified

(defun SetLuminance ( tc lum / hsl )
 ( (lambda ( hsl ) (apply 'LM:RGB->True (LM:HSL->RGB (car hsl) (cadr hsl) lum)))
   (apply 'LM:RGB->HSL (LM:True->RGB tc))
 )
)

You will need to pick up the necessary subfunctions from here.

 

Below is a demonstration of how to call the above subfunction to set the Luminance of the selected TrueColor value to 50, retaining the values for Hue/Saturation (assuming the user picks a TrueColour value from the dialog - if not, the ACI colour will need to be converted to TrueColour before being supplied to the above sub):

 

(defun c:test ( / layer lst )

 (setq layer "Layer1")

 (if (setq lst (acad_truecolordlg '(62 . 7) nil))
   (entmake
     (list
       (cons 0 "LAYER")
       (cons 100 "AcDbSymbolTableRecord")
       (cons 100 "AcDbLayerTableRecord")
       (cons 2 layer)
       (cons 70 0)
       (cons 420 (SetLuminance (cdr (assoc 420 lst)) 50))
     )
   )
 )
 (princ)
)

[woodman78]

Thanks LeeMac and pBe for your help. I've been trying to integrate your code LeeMac but have been struggling.

 

This is what I have but I think the

(cons 420 (SetLuminance (cdr (assoc 420 lst)) 50))

should be going in after the pline command no???

 

(defun c:landowner (/ Layername LayerColor name)
(setq SUCE (getvar "cmdecho"))
 (setq SUOM (getvar "orthomode"))
 (setq SUSM (getvar "osmode"))
 (setq SUAB (getvar "angbase"))
 (setq SUAD (getvar "angdir"))
 (setq SUCL (getvar "clayer"))
 (setq SUCR (getvar "cecolor"))
(setq dcl_id (load_dialog "landowner.dcl"))
    (if (not (new_dialog "landowner" dcl_id))
    (exit)
    );if
(if *name1*
   (set_tile "name" *name1*)
   (set_tile "name" "Default")
 )
(action_tile "name" "(setq *name1* $value)")
(start_dialog)
(unload_dialog dcl_id)
(setq layername (strcat "CCC_LANDOWNER_"*name1*)
            LayerColor (acad_truecolordlg '(62 . 7) nil))
  (entmake (list (cons 0 "LAYER")
                (cons 100 "AcDbSymbolTableRecord")
                (cons 100 "AcDbLayerTableRecord")
                (cons 2 Layername)
                (car LayerColor) 
              (if (> (length LayerColor) 1)
                  (car (cdr LayerColor)))     
                (cons 70 0)
       (cons 420 (SetLuminance (cdr (assoc 420 lst)) 50))
   )
     )
)

(setvar "clayer" layername)
(command "._pline")
(while (= 1 (logand 1 (getvar "cmdactive")))
(command pause))
 (setq pline (entlast)
   elist (entget pline)
   )
(command "_chprop" pline "" "_color" (cdr (car LayerColor)) "" "")
(command "_.draworder" pline "" "_F");<--set pline's draw order to front 

 (setvar "hpname" "honey")
 (setvar "hpscale" 2)
 (command "-hatch" "S" pline "" "") 
 (setvar "hpname" ".")

 (setvar "cmdecho"   SUCE)
 (setvar "orthomode" SUOM)
 (setvar "osmode"    SUSM)
 (setvar "angbase"   SUAB)
 (setvar "angdir"    SUAD)
 (setvar "clayer"    SUCL)
 (setvar "cecolor"    SUCR)

(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun SetLuminance ( tc lum / hsl )
 ( (lambda ( hsl ) (apply 'LM:RGB->True (LM:HSL->RGB (car hsl) (cadr hsl) lum)))
   (apply 'LM:RGB->HSL (LM:True->RGB tc))
 )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; RGB -> HSL - Lee Mac 2011
;; Args: r,g,b - Red,Green,Blue values

(defun LM:RGB->HSL ( r g b / _round d h l m n s )

 (setq r (/ r 255.)
       g (/ g 255.)
       b (/ b 255.)
       n (min r g b)
       m (max r g b)
       d (- m n)
       l (/ (+ m n) 2.)
 )
 (defun _round ( n )
   (fix (+ n (if (minusp n) -0.5 0.5)))
 )
 (mapcar '_round
   (cond
     ( (zerop d)
       (list 0 0 (* m 100))
     )
     (t
       (setq s (if (< l 0.5) (/ d (+ m n)) (/ d (- 2. m n))))
       (setq h
         (cond
           ( (= g m) (+ (/ (- b r) d) 2))
           ( (= b m) (+ (/ (- r g) d) 4))
           ( (/ (- g b) d))
         )
       )
       (list (rem (+ 360 (* h 60)) 360) (* s 100) (* l 100))
     )
   )
 )
)

;; RGB -> True - Lee Mac 2011
;; Args: r,g,b - Red,Green,Blue values

(defun LM:RGB->True ( r g b )
 (+
   (lsh (fix r) 16)
   (lsh (fix g)  
   (fix b)
 )
)

;; HSL -> RGB - Lee Mac 2011
;; Args: 0 <= h <= 360, 0 <= s,l <= 100

(defun LM:HSL->RGB ( h s l / _sub _round u v )

 (setq h (/ h 360.)
       s (/ s 100.)
       l (/ l 100.)
 )
 (defun _sub ( u v h )
   (setq h (rem (1+ h) 1))
   (cond
     ( (< (* 6 h) 1) (+ u (* 6 h (- v u))))
     ( (< (* 2 h) 1) v)
     ( (< (* 3 h) 2) (+ u (* 6 (- (/ 2. 3.) h) (- v u))))
     ( u )
   )
 )
 (defun _round ( n )
   (fix (+ n (if (minusp n) -0.5 0.5)))
 )
 (mapcar '_round
   (mapcar '* '(255 255 255)
     (cond
       ( (zerop s)
         (list l l l)
       )
       ( (zerop l)
        '(0 0 0)
       )
       (t
         (setq v (if (< l 0.5) (* l (1+ s)) (- (+ l s) (* l s)))
               u (- (* 2 l) v)
         )
         (mapcar '(lambda ( h ) (_sub u v h)) (list (+ h (/ 1. 3.)) h (- h (/ 1. 3.))))
       )
     )
   )
 )
)

;; True -> RGB - Lee Mac 2011
;; Args: c - True Colour

(defun LM:True->RGB ( c )
 (list
   (lsh (lsh (fix c)   -24)
   (lsh (lsh (fix c) 16) -24)
   (lsh (lsh (fix c) 24) -24)
 )
)

 

I get an error on running it.

[Lee Mac]

This is what I have but I think the

(cons 420 (SetLuminance (cdr (assoc 420 lst)) 50))

should be going in after the pline command no???

 

No, check my example, this line is for setting the layer colour.

 

(defun c:landowner (/ Layername LayerColor name)
[color=red](setq SUCE (getvar "cmdecho"))
 (setq SUOM (getvar "orthomode"))
 (setq SUSM (getvar "osmode"))
 (setq SUAB (getvar "angbase"))
 (setq SUAD (getvar "angdir"))
 (setq SUCL (getvar "clayer"))
 (setq SUCR (getvar "cecolor"))[/color]
(setq dcl_id (load_dialog "landowner.dcl"))
    (if (not (new_dialog "landowner" dcl_id))
    (exit)
    );if
(if *name1*
   (set_tile "name" *name1*)
   (set_tile "name" "Default")
 )
(action_tile "name" "(setq *name1* $value)")
(start_dialog)
(unload_dialog dcl_id)
(setq layername (strcat "CCC_LANDOWNER_"*name1*)
            LayerColor (acad_truecolordlg '(62 . 7) nil))
  (entmake (list (cons 0 "LAYER")
                (cons 100 "AcDbSymbolTableRecord")
                (cons 100 "AcDbLayerTableRecord")
                (cons 2 Layername)
[color=blue]                 (car LayerColor) 
              (if (> (length LayerColor) 1)
                  (car (cdr LayerColor)))     [/color]
                (cons 70 0)
       (cons 420 (SetLuminance (cdr (assoc 420 lst)) 50))
   )
     )
)

(setvar "clayer" layername)
(command "._pline")
(while (= 1 (logand 1 (getvar "cmdactive")))
(command pause))
 (setq pline (entlast)
   elist (entget pline)
   )
(command "_chprop" pline "" "_color" (cdr (car LayerColor)) "" "")
(command "_.draworder" pline "" "_F");<--set pline's draw order to front 

 (setvar "hpname" "honey")
 (setvar "hpscale" 2)
 (command "-hatch" "S" pline "" "") 
 (setvar "hpname" ".")

[color=red]  (setvar "cmdecho"   SUCE)
 (setvar "orthomode" SUOM)
 (setvar "osmode"    SUSM)
 (setvar "angbase"   SUAB)
 (setvar "angdir"    SUAD)
 (setvar "clayer"    SUCL)
 (setvar "cecolor"    SUCR)[/color]

(princ)
)

 

I'm not sure why you have the parts marked in red, since you don't change most of those system variables.

 

Also, you seem to be trying to set the layer colour twice (marked in green).

 

I can't test the following since I don't have your DCL etc, but change the top part of your code to this:

 

(defun c:landowner ( / elast id lst name old vars )

 (setq vars '("CLAYER" "HPNAME" "HPSCALE")
       old   (mapcar 'getvar vars)
 )
 (cond
   ( (or
       (<= (setq id (load_dialog "landowner.dcl")) 0)
       (not (new_dialog "landowner" id))
     )
     (princ "\n--> Error Loading Dialog.")
   )
   (t
     (set_tile "name" (cond (*name1*) ("Default")))
     (action_tile "name" "(setq *name1* $value)")
    
     (if
       (and
         (= 1 (start_dialog))
         (setq lst (acad_truecolordlg '(62 . 7) nil))
       )
       (progn
         (setq name (strcat "CCC_LANDOWNER_"*name1*))

         (if (null (tblsearch "LAYER" name))
           (entmake
             (list
               (cons 0 "LAYER")
               (cons 100 "AcDbSymbolTableRecord")
               (cons 100 "AcDbLayerTableRecord")
               (cons 2 name)
               (cons 70 0)
               (cond
                 ( (assoc 420 lst)
                   (cons 420 (SetLuminance (cdr (assoc 420 lst)) 50))
                 )
                 ( (assoc 62 lst) )
               )
             )
           )
         )
         (setvar 'CLAYER name)

         (setq elast (entlast))
         (command "_.pline")
         (while (= 1 (logand 1 (getvar 'CMACTIVE))) (command pause))

         (if (not (equal elast (setq elast (entlast))))
           (progn
             (command "_.draworder" elast "" "_F")
             (setvar 'HPNAME "honey")
             (setvar 'HPSCALE 2)
             (command "_.-hatch" "_S" elast "" "")
             (setvar 'HPNAME ".")
           )
         )
       )
     )
   )
 )
 (if (< 0 id) (unload_dialog id))
 (mapcar 'setvar vars old)
 (princ)
)

 

I'm not sure why you are changing the colour of the Polyline when you have set the layer colour - surely the colour should be ByLayer?

[woodman78]

LeeMac, I ran this but there are a few things. When I choose the colour from the Truecolour dialog the Luminence is adjusted alright but it assigns that colour immediately as bylayer and so the pline is the lighter colour. I has intended that the chosen colour be assigned to the pline and the lighter colour then be assinged to the hatch.

 

The hatch command doesn't work either. When I close the pline it just ends. and it doesn't appear to set the hatch variables.

 

I've included mt DCL in case you get a chance to test.

 

Thanks LeeMac for your work.

 

landowner: dialog
{label = "Landowner Layer Creation";
   : edit_box 
            {
   label = "Enter landowner name :";
   key = "name";
   alignment = centered;
   edit_limit = 45;
   edit_width = 50;
   }

   : button    
   {
   key = "accept";
   label = "OK";
   is_default = true;
   fixed_width = true;
   alignment = centered;
   }

   : errtile
   {
   width = 34;
   }
}

[Lee Mac]

Try the attached LISP & DCL.

landowner.lsp

landowner.dcl

[woodman78]

That is excellent. Thanks LeeMac. Will save me a lot of time when doing landowner maps.

 

Thanks again.

[woodman78]

Just looking at it and as said about using ACI it would make more sense to have the user select an ACI and convert it to True. I have changed the line

 

(setq lst (acad_colordlg 1 nil))

 

to call the ACI dialog and added in the subfunction:

;; ACI -> True - Lee Mac 2011
;; Args: c - ACI (AutoCAD Colour Index) Colour

(defun LM:ACI->True ( c / cObj tc ) (vl-load-com)
 (if
   (and (<= 1 c 255)
     (setq cObj
       (vla-getInterfaceObject (vlax-get-acad-object)
         (strcat "AutoCAD.AcCmColor." (substr (getvar 'ACADVER) 1 2))
       )
     )
     (not
       (vl-catch-all-error-p
         (vl-catch-all-apply 'vla-put-ColorIndex (list cObj c))
       )
     )
   )
   (setq tc (LM:RGB->True (vla-get-Red cObj) (vla-get-Green cObj) (vla-get-Blue cObj)))
 )
 (if cObj (vlax-release-object cObj))
 tc
)

 

but how do I pass the lst variable to the subfunction?

[Lee Mac]

Perhaps it could have been worth mentioning that before I rewrote the whole code... but then I suppose I'm the mug for rewriting it in the first place.

 

Change:

 

               (cond
                 ( (assoc 420 lst)
                   (cons 420 (SetLuminance (cdr (assoc 420 lst)) 50))
                 )
                 ( (assoc 62 lst) )
               )

 

To:

 

(cons 420 (SetLuminance (LM:ACI->True lst) 50)

 

And:

 

(entmod (append (entget elast) (list (cond ((assoc 420 lst)) ((assoc 62 lst))))))

 

To:

 

(entmod (append (entget elast) (list (cons 62 lst))))