Help changing a program

[cadd4la]

I'm looking to have some changes to this program I found, so it will not set the layer to nonplot and have the color to be #3 (green). Also, if possible I wish it could change the numbering by one at the end of the layer name (_XXX-changed01, 02, 03, ....) and let you either match the color of the layer you picked or change the layer color by entering the layer color.

(defun c:MLAYCHA ( / i l n s x )    (if (setq s (ssget "_:L" '((8 . "~*XXX-CHANGED0"))))
        (repeat (setq i (sslength s))
            (setq x (vlax-ename->vla-object (ssname s (setq i (1- i))))
                  l (vla-get-layer x)
                  n (strcat l "_XXX-CHANGED0")
            )
            (if (checkmakelayer l n) (vla-put-layer x n))
        )
    )
    (princ)
)
(defun checkmakelayer ( a b )
    (cond
        (   (tblsearch "layer" b))
        (   (setq a (tblobjname "layer" a))
            (setq a (entget a))
            (entmake
                (subst (cons 2 b) (assoc 2 a)
                    (subst '(62 . 204) (assoc 62 a)
                        (vl-remove-if '(lambda ( x ) (or (= 'ename (type (cdr x))) (= 102 (car x)))) a)
                    )
                )
            )
        )
    )
)
(vl-load-com) (princ)

Thanks,

[devitg.89838]

Please upload a sample.dwg

[cadd4la]

Please upload a sample.dwg

Here is the sample.dwg

All the code does is have you pick an existing item on the layer then it moves it to a new layer and names that layer the existing name and then adds _XXX-CHANGED0 at the end.

Thanks,

[devitg.89838]

test it please , do what you ask

(defun to-new-layer(/
ITEM ITEM-LAYER ITEM-OBJ NEWLAYER-NAME
)
;;;All the code does is have you pick an existing item on the layer then it moves it to a new layer
;;;and names that layer the existing name and then adds _XXX-CHANGED0 at the end.

(vl-load-com)
(princ "\n you pick an existing item")
(setq item (ssname (ssget "_:S+.")0)) ;;you pick an existing item
(setq item-layer (cdr ( assoc 8 (entget item)))); item's layer name

(setq item-obj (VLAX-ENAME->VLA-OBJECT item));item as VL object
(setq newlayer-name (strcat item-layer "_XXX-CHANGED0")); the new layer name
(VL-CMDF "_-layer" "m" newlayer-name "");;the new layer
(VLA-PUT-LAYER item-obj newlayer-name) ;; item at the new layer

); end defun to-new-layer

[cadd4la]

test it please , do what you ask

What I can see is you have got the new layer to plot but you have not gotten it to be color 3 or let the user choose a color.

Thanks,

[devitg.89838]

It was your last post #3

All the code does is have you pick an existing item on the layer then it moves it to a new layer and names that layer the existing name and then adds _XXX-CHANGED0 at the end.

[Tharwat]

Hi,

Is this what you are after?

(defun c:mlaycha (/ i l n s x c r d e)
  (if (and (setq s (ssget "_:L" '((8 . "~*XXX-CHANGED0"))))
           (setq r 0 c (acad_colordlg 256))
      )
    (repeat (setq i (sslength s))
      (setq x (ssname s (setq i (1- i)))
            e (entget x)
            l (assoc 8 e)
            n (strcat (cdr l) "_XXX-CHANGED" (itoa r))
            r (1+ r)
            d (list '(290 . 0) (cons 62 c))
      )
      (if (tblsearch "LAYER" n)
        (entmod (append (entget (tblobjname "LAYER" n)) d))
        (entmake (append (list '(0 . "LAYER")
                               '(100 . "AcDbSymbolTableRecord")
                               '(100 . "AcDbLayerTableRecord")
                               (cons 2 n)
                               '(70 . 0)
                         )
                         d
                 )
        )
      )
      (entmod (subst (cons 8 n) l e))
    )
  )
  (princ)
)

[devitg.89838]

test it , it do what you ask now , the color apply to item not to layer .

(DEFUN CHANGE-LAYER-NAME-AND-COLOR (/
ACAD-OBJ
ADOC
COLOR
ITEM
ITEM-LAYER
ITEM-OBJ
LAYER-COLL
MODEL
NEWLAYER
NEWLAYER-NAME
)
(VL-LOAD-COM)

(SETQ ACAD-OBJ (VLAX-GET-ACAD-OBJECT)) ;_ el programa ACAD
(SETQ ADOC (VLA-GET-ACTIVEDOCUMENT ACAD-OBJ)) ;_ el DWG que esta abierto-
(SETQ MODEL (VLA-GET-MODELSPACE ADOC))
(SETQ LAYER-COLL (VLA-GET-LAYERS ADOC))
(PRINC "\n you pick an existing item")
(SETQ ITEM (SSNAME (SSGET "_:S+.") 0))
;;you pick an existing item
(SETQ ITEM-LAYER (CDR (ASSOC 8 (ENTGET ITEM)))) ; item's layer name

(SETQ ITEM-OBJ (VLAX-ENAME->VLA-OBJECT ITEM)) ;item as VL object
(SETQ NEWLAYER-NAME (STRCAT ITEM-LAYER "_XXX-CHANGED0")) ; the new layer name
(VL-CMDF "_-layer" "m" NEWLAYER-NAME "")
;;the new layer
(VLA-PUT-LAYER ITEM-OBJ NEWLAYER-NAME)
;; item at the new layer
(SETQ NEWLAYER (VLA-ITEM LAYER-COLL NEWLAYER-NAME))
(VLA-PUT-PLOTTABLE NEWLAYER :VLAX-TRUE)
(SETQ COLOR (ACAD_COLORDLG 3))
(VLA-PUT-COLOR ITEM-OBJ COLOR)
)

[cadd4la]

Hi,

Is this what you are after?

(defun c:mlaycha (/ i l n s x c r d e)
  (if (and (setq s (ssget "_:L" '((8 . "~*XXX-CHANGED0"))))
           (setq r 0 c (acad_colordlg 256))
      )
    (repeat (setq i (sslength s))
      (setq x (ssname s (setq i (1- i)))
            e (entget x)
            l (assoc 8 e)
            n (strcat (cdr l) "_XXX-CHANGED" (itoa r))
            r (1+ r)
            d (list '(290 . 0) (cons 62 c))
      )
      (if (tblsearch "LAYER" n)
        (entmod (append (entget (tblobjname "LAYER" n)) d))
        (entmake (append (list '(0 . "LAYER")
                               '(100 . "AcDbSymbolTableRecord")
                               '(100 . "AcDbLayerTableRecord")
                               (cons 2 n)
                               '(70 . 0)
                         )
                         d
                 )
        )
      )
      (entmod (subst (cons 8 n) l e))
    )
  )
  (princ)
)

Tharwat,

Thank you so much, your code lets me choose a new color like I asked, can you also have the new layer be plotable?

And finally, if possible can you have the code ask for a number from 1-9 to be added to XXX-CHANGED0 i.e. XXX-CHANGED01, XXX-CHANGED02, etc or have it have a number increase by one starting at 01?

Thanks,

[Tharwat]

Tharwat,

Thank you so much, your code lets me choose a new color like I asked, can you also have the new layer be plotable?

And finally, if possible can you have the code ask for a number from 1-9 to be added to XXX-CHANGED0 i.e. XXX-CHANGED01, XXX-CHANGED02, etc or have it have a number increase by one starting at 01?

Thanks,

You are welcome anytime.

Please try the following and hope it would meet your needs.

(defun c:crtchglay (/ i l n s x c y r d e)
  ;; Tharwat - Date: 08.Mar.2018	;;
  (if
    (and (setq s (ssget "_:L" '((8 . "~*XXX-CHANGED0"))))
         (setq r
                (getstring
                  "\nSpeficy a number from [1-9] or [01-09] <enter to exit> :"
                )
         )
         (or (numberp (read r))
             (progn (princ "\nInvalid input!. Please try again.") nil)
         )
         (setq y (and (= (strlen r) 2) (wcmatch r "0*"))
               c (acad_colordlg 256)
         )
    )
     (repeat (setq i (sslength s))
       (setq x (ssname s (setq i (1- i)))
             e (entget x)
             l (assoc 8 e)
             n (strcat (cdr l) "_XXX-CHANGED" r)
             d (list '(290 . 1) (cons 62 c))
             r (1+ (atoi r))
             r (if (and y (< r 10))
                 (strcat "0" (itoa r))
                 (itoa r)
               )
       )
       (if (tblsearch "LAYER" n)
         (entmod (append (entget (tblobjname "LAYER" n)) d))
         (entmake (append (list '(0 . "LAYER")
                                '(100 . "AcDbSymbolTableRecord")
                                '(100 . "AcDbLayerTableRecord")
                                (cons 2 n)
                                '(70 . 0)
                          )
                          d
                  )
         )
       )
       (entmod (subst (cons 8 n) l e))
     )
  )
  (princ)
)