Lisp create layer by colors linetype ...

March 13, 2022

Hello...i need please a lisp that create or put in the correct layer the various elements .

.example :if i have on layer 0 a red line ..i want create a layer with a new name with red color

Ex2:if i have an object on layer 1 and it has color green and linetype center and linetypescale 1.5 the lisp will create a new layer with this settings.

So if it will find a layer that exist it put on that layer .

I hope it clear

March 13, 2022

Sort of understand what you want, need more detail new layer names, NEW-1-cent-1-5 ?

March 14, 2022

Hello Bigal. Something standard maybe ... just numbers or A00001. maybe I'll edit it later. thanks

March 14, 2022

(vl-load-com)
(defun c:classify ( / ss ssl index obj color linetype linetypescale str layertable newlayername)
 (princ "\n select object to classify")
 (setq layertable (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))))
 (if (setq ss (ssget))
    (progn
      (setq ssl 0)
      (setq ssl (sslength ss))
      (setq index 0)
      (setq str "")
      (repeat ssl
        (setq obj (vlax-ename->vla-object (cdr (assoc -1 (entget (ssname ss index))))))
        (setq color (vla-get-color obj))
        (if (= color 256) ; if by layer
           (setq color (cdr (assoc 62 (tblsearch "LAYER" (vla-get-layer obj)))))
        )
        (setq color (vl-princ-to-string color))
        (setq linetype (vl-princ-to-string (vla-get-linetype obj)))
        (if (= linetype "ByLayer") ; if by layer
           (setq linetype (cdr (assoc 6 (tblsearch "LAYER" (vla-get-layer obj)) ) ) ) 
        )
        (setq linetype (vl-princ-to-string linetype))
        (setq linetypescale (vl-princ-to-string (vla-get-linetypescale obj)))
        (setq str (strcat "color-" color "_lt-" linetype "_lts-" linetypescale))
        
        (if (= (tblsearch "LAYER" str) nil)
           (progn 
             (setq newlayername (vla-add layertable str))
             (vla-put-color newlayername color)
             (vla-put-linetype newlayername linetype)
             ;(vla-put-linetypescale newlayername linetypescale)
             (vlax-put-property obj 'layer str)
             (vla-put-color obj 256)
             (vla-put-linetype obj "ByLayer")
           ); end of progn
           (progn
             (setq newlayername (vla-item layertable str))
             (vlax-put-property obj 'layer str)
             (vla-put-color obj 256)
             (vla-put-linetype obj "ByLayer")
           ); end of progn
        ); end of if    

        (setq index (+ index 1))
      );end of repeat
    );end of progn
  );end of if
(princ)
);end of defun

how about approach like this.

- code updated, layer cannot have linetype scale value. my mistake.

works like below

Edited March 14, 2022 by exceed

March 14, 2022

I asked @pBe to help me on this before...

see if this works for you...

;;;    Color to Bylayer    ;;;
(Defun c:ctl (  / _makelay LayerColor i ss)
;;;        pBe 19 Mar 2015        ;;;  
(defun makelay (l c)
    (entmake
      (list
    (cons 0 "LAYER")
    (cons 100 "AcDbSymbolTableRecord")
    (cons 100 "AcDbLayerTableRecord")
    (cons 2 l)
    (cons 70 0)
    (cons 62 (if (zerop c) 7 c))
      )
    )
  )  
(defun _LayerColor (e lst)
  (if  (setq f (assoc (setq c (cdr (assoc 62 e))) lst))
    (progn
         (if (not (tblsearch "LAYER" (setq ln (cdr f))))
         (makelay ln (car f)))
            (entmod (append e (list (cons 8 ln)'(62 . 256))))
      )
    (progn
      (makelay (itoa c) c)
      (setq lst (cons (cons c (itoa c)) lst))
      (_LayerColor e lst)
    )
  )
  lst
)
(or clist  
    (setq clist '((0 . "ColorByBlock")(1 . "Red")(2 . "Yellow")
          (3 . "Green")(4 . "Cyan") (5 . "Blue")(6 . "Magenta")
          (7 .  "White")))) 
(if (setq ss (ssget "X" '((8 . "0") (-4 . "/=") (62 . 256))))
  (repeat (setq i (sslength ss))
    (setq l (entget (ssname ss (setq i (1- i)))))
    (setq clist (_LayerColor l clist))
  )
)
  (princ)
  )

March 14, 2022

thanks in advance for help me but :

Command: (LOAD "C:/Users/Utente/Dropbox/Lavoro/backup/AUTOCAD/Lisp/Layer/classify.lsp") ; error: extra right paren on input

all this requests, because i want view all drawings elements in a temporary color (purple) and when i edit a block i want view real colors.

you could do something that remembers the original color of the elements before editing the block.

When finished of edit block and come back to drawing i see all again in purple color (temporary color)

Edited March 14, 2022 by jim78b

March 14, 2022

not happen nothing, i want thet it work even inside blocks... thanks in advance

March 15, 2022

23 hours ago, jim78b said:

thanks in advance for help me but :

Command: (LOAD "C:/Users/Utente/Dropbox/Lavoro/backup/AUTOCAD/Lisp/Layer/classify.lsp") ; error: extra right paren on input

all this requests, because i want view all drawings elements in a temporary color (purple) and when i edit a block i want view real colors.

you could do something that remembers the original color of the elements before editing the block.

When finished of edit block and come back to drawing i see all again in purple color (temporary color)

For such a purpose, there is a way to implement it without using a layer.

This Lisp uses hyperlinks.

1. input "0" outside a block before work, all blocks and not blocks store [color, line type, line type scale] in hyperlinks.

then make it all, purple and continuous and linetypescale 1.0.

2. input "`" in block editor, it will return to the original color and delete hyperlinks

If you type 0 before closing the block editor, all objects in the block return to purple.

It doesn't matter if you input 0 outside the block editor.

; make it color - 2022.03.15 exceed
; this lisp use object's hyperlink property
; command list 
; ` = make it color (return to origin) leftside of "1" key
; 1 = make it red
; 2 = make it yellow
; 3 = make it green
; 4 = make it cyan
; 5 = make it blue
; 6 = make it magenta
; 7 = make it white
; 8 = make it gray
; 9 = make it light gray
; 0 = make it purple

(defun c:` () (ex:mic) (princ)) ;make it color (return to origin)
(defun c:1 () (ex:mip 1) (princ)) ;make it red 
(defun c:2 () (ex:mip 2) (princ)) ;make it yellow
(defun c:3 () (ex:mip 3) (princ)) ;make it green
(defun c:4 () (ex:mip 4) (princ)) ;make it cyan
(defun c:5 () (ex:mip 5) (princ)) ;make it blue
(defun c:6 () (ex:mip 6) (princ)) ;make it magenta
(defun c:7 () (ex:mip 7) (princ)) ;make it white
(defun c:8 () (ex:mip 8) (princ)) ;make it gray
(defun c:9 () (ex:mip 9) (princ)) ;make it lightgray
(defun c:0 () (ex:mip 200) (princ)) ;make it purple

(vl-load-com)

(defun ex:mip ( setcolor / setcolor_txt c_lyrs lock_lst *error* ss ssl index obj color linetype linetypescale str en check index1 obj1 en1 ssblk ssblkindex blkent blk ent enx obj2 color2 linetype2 linetypescale2 str2 hlinks2 )
   (setvar 'cmdecho 0)
   (LM:startundo (LM:acdoc))
    (defun *error* ( msg )
        (rh:relock_lyrs lock_lst)
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (setvar 'cmdecho 1)
        (princ)
    )

  (setq c_lyrs (vla-get-layers (LM:acdoc)))
  (setq lock_lst (rh:lock_lyr_list c_lyrs))
  (rh:unlock_lyrs lock_lst)

 (cond 
   ((= setcolor 1) (setq setcolor_txt "red") )
   ((= setcolor 2) (setq setcolor_txt "yellow") )
   ((= setcolor 3) (setq setcolor_txt "green") )
   ((= setcolor 4) (setq setcolor_txt "cyan") )
   ((= setcolor 5) (setq setcolor_txt "blue") )
   ((= setcolor 6) (setq setcolor_txt "magenta") )
   ((= setcolor 7) (setq setcolor_txt "white") )
   ((= setcolor 8) (setq setcolor_txt "gray") )
   ((= setcolor 9) (setq setcolor_txt "lightgray") )
   ((= setcolor 200) (setq setcolor_txt "purple") )
 );end of cond

 (princ "\n make it ") 
 (princ setcolor_txt)
 (princ " - processing ") 

 (if (setq ss (ssget "X"))
    (progn
      (setq ssl 0)
      (setq ssl (sslength ss))
      (setq index 0)
      (setq str "")
      (repeat ssl
        (setq en (ssname ss index))
        (setq obj (vlax-ename->vla-object (cdr (assoc -1 (entget en)))))
        ;(vlax-for x (vla-get-hyperlinks obj) (vla-delete x))
        (setq old_str "")
        (vlax-for each (vlax-get-property obj 'Hyperlinks)
            (setq old_str (strcat (vla-get-url each)))
          ) 
          ;(princ "\n old_str - ")
          ;(princ old_str)
        (if (/= (substr old_str 1 3) "MIP")
        (progn
        ;(princ "\n modify")
        (setq color (vl-princ-to-string (vla-get-color obj)))
        (setq linetype (vl-princ-to-string (vla-get-linetype obj)))
        (setq linetypescale (vl-princ-to-string (vla-get-linetypescale obj)))
        (setq str (strcat "MIP/" color "/" linetype "/" linetypescale))
        (setq hlinks (vlax-get-property obj 'Hyperlinks))
        (vla-add hlinks str)
        )
        (progn
        ;(princ "\n stay")
        (vla-add (vlax-get-property obj 'Hyperlinks) old_str)
        )
        )
        (setq index (+ index 1))
      );end of repeat
      (setq index1 0)
      (repeat ssl
        (setq en1 (ssname ss index1))
        (setq obj1 (vlax-ename->vla-object (cdr (assoc -1 (entget en1)))))
        (setq check (vlax-property-available-p obj1 "Color" T))
	(if check
		(vlax-put-property obj1 'Color setcolor)
	) 
        (vla-put-linetype obj1 "continuous")
        (vla-put-linetypescale obj1 1)
        (setq index1 (+ index1 1))
      );end of repeat
    );end of progn
  );end of if



(if (setq ssblk (ssget "x" '((0 . "insert")) ))
  (progn
    (setq ssblkl (sslength ssblk))
    (setq ssblkindex 0)
    (repeat ssblkl
      (setq blkent (entget (ssname ssblk ssblkindex)))
      (setq blk (cdr (assoc 2 blkent)))
      (if (setq ent (tblobjname "BLOCK" blk))
        (progn
        (while (and (setq ent (entnext ent)))
          (setq enx (entget ent))
          (setq obj2 (vlax-ename->vla-object (cdr (assoc -1 enx))))
          ;(vlax-for x (vla-get-hyperlinks obj2) (vla-delete x))
          (setq old_str2 "")
          (vlax-for each (vlax-get-property obj2 'Hyperlinks)
            (setq old_str2 (strcat (vla-get-url each)))
          ) 
          ;(princ "\n old_str2 - ")
          ;(princ old_str2)
        (if (/= (substr old_str2 1 3) "MIP")
          (progn
            ;(princ "\n modify")
            (setq color2 (vl-princ-to-string (vla-get-color obj2)))
            (setq linetype2 (vl-princ-to-string (vla-get-linetype obj2)))
            (setq linetypescale2 (vl-princ-to-string (vla-get-linetypescale obj2)))
            (setq str2 (strcat "MIP/" color2 "/" linetype2 "/" linetypescale2))
            (setq hlinks2 (vlax-get-property obj2 'Hyperlinks))
            (vla-add hlinks2 str2)
          )
          (progn
          ;(princ "\n stay")
          (vla-add (vlax-get-property obj2 'Hyperlinks) old_str2)
          )
        )
        );end of while        
      );end of progn
    );end of if
    (setq ssblkindex (+ ssblkindex 1))
   );end of repeat
    (setq ssblkindex 0)
    (repeat ssblkl
      (setq blkent (entget (ssname ssblk ssblkindex)))
      (setq blk (cdr (assoc 2 blkent)))
      (if (setq ent (tblobjname "BLOCK" blk))
        (progn
        (while (and (setq ent (entnext ent)))
          (setq enx (entget ent))
          (setq obj2 (vlax-ename->vla-object (cdr (assoc -1 enx))))
          (setq check (vlax-property-available-p obj2 "Color" T))
  	(if check
		(vlax-put-property obj2 'Color setcolor)
	) 
          (vla-put-linetype obj2 "continuous")
          (vla-put-linetypescale obj2 1)
        );end of while
      );end of progn
    );end of if
    (setq ssblkindex (+ ssblkindex 1))
   );end of repeat
);end of progn
);end of if

(rh:relock_lyrs lock_lst)

(princ "\n make it ") 
(princ setcolor_txt)
(princ " - complete!") 

(LM:endundo (LM:acdoc))
(setvar 'cmdecho 1)
(princ)
);end of defun



(defun ex:mic ( / c_lyrs lock_lst *error* ssblk ssblkl ssblkindex blk ent enx str2 obj2 hlinks2 strlist2 color2 linetype2 linetypescale2 check ss ssl index obj color linetype linetypescale str layertable newlayername en check strlist )
   (setvar 'cmdecho 0)
   (LM:startundo (LM:acdoc))
    (defun *error* ( msg )
        (rh:relock_lyrs lock_lst)
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (setvar 'cmdecho 1)
        (princ)
    )


  (setq c_lyrs (vla-get-layers (LM:acdoc)))
  (setq lock_lst (rh:lock_lyr_list c_lyrs))
  (rh:unlock_lyrs lock_lst)

(princ "\n make it color (return to origin) - processing ")
(if (setq ssblk (ssget "x" '((0 . "insert")) ))
  (progn
    (setq ssblkl (sslength ssblk))
    (setq ssblkindex 0)
    (repeat ssblkl
      (setq blkent (entget (ssname ssblk ssblkindex)))
      (setq blk (cdr (assoc 2 blkent)))
      (if (setq ent (tblobjname "BLOCK" blk))
        (progn
        (while (and (setq ent (entnext ent)))
          (setq enx (entget ent))
          (setq str2 "")
          (setq obj2 (vlax-ename->vla-object (cdr (assoc -1 enx))))
          (setq hlinks2 (vlax-get-property obj2 'Hyperlinks))
          (vlax-for each hlinks2
            (setq str2 (strcat (vla-get-url each)))
          ) 
          (if (/= str2 "")
             (progn 
               (setq strlist2 '())
               (setq strlist2 (LM:str->lst str2 "/"))
               (setq color2 (cadr strlist2))
               (setq linetype2 (caddr strlist2))
               (setq linetypescale2 (nth 3 strlist2))
               (setq check (vlax-property-available-p obj2 "Color" T))
               (if check
   	     (vlax-put-property obj2 'Color color2)
               ) 
               (vla-put-linetype obj2 linetype2)
               (vla-put-linetypescale obj2 linetypescale2)
               (vlax-for x (vla-get-hyperlinks obj2) (vla-delete x)) 
             ); end of progn
           );end of if
        );end of while        
      );end of progn
    );end of if
    (setq ssblkindex (+ ssblkindex 1))
   );end of repeat
);end of progn
);end of if


 (if (setq ss (ssget "X" '((-3 ("PE_URL")))))
    (progn
      (setq ssl 0)
      (setq ssl (sslength ss))
      (setq index 0)
      (setq str "")
      (repeat ssl
        (setq en (ssname ss index))
        (setq obj (vlax-ename->vla-object (cdr (assoc -1 (entget en)))))
        (setq hlinks (vlax-get-property obj 'Hyperlinks))
        (vlax-for each hlinks 
          (setq str (strcat (vla-get-url each)))
        )
        (setq strlist (LM:str->lst str "/"))
        (setq color (cadr strlist))
        (setq linetype (caddr strlist))
        (setq linetypescale (nth 3 strlist))
        (setq check (vlax-property-available-p obj "Color" T))
	(if check
		(vlax-put-property obj 'Color color)
	) 
        (vla-put-linetype obj linetype)
        (vla-put-linetypescale obj linetypescale)
        (vlax-for x (vla-get-hyperlinks obj) (vla-delete x))
        (setq index (+ index 1))
      );end of repeat
    );end of progn
  );end of if


(rh:relock_lyrs lock_lst)

(princ "\n make it color (return to origin)") 
(princ " - complete!") 


(LM:endundo (LM:acdoc))
(setvar 'cmdecho 1)
(princ)
);end of defun






;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)


;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)



;; String to List  -  Lee Mac
;; Separates a string using a given delimiter
;; str - [str] String to process
;; del - [str] Delimiter by which to separate the string
;; Returns: [lst] List of strings
 
(defun LM:str->lst ( str del / pos )
    (if (setq pos (vl-string-search del str))
        (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del))
        (list str)
    )
)

; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/create-list-of-locked-layers-lock-amp-unlock-again/m-p/9306234/highlight/true#M395697
;; unlock all layers : requires list of locked layer objects 
(defun rh:unlock_lyrs (lst)
  (mapcar '(lambda (x) (vlax-put-property x 'lock :vlax-false)) lst)
);end_defun
  
;; relock all previously locked layers : requires list of locked layer objects  
(defun rh:relock_lyrs (lst)
  (mapcar '(lambda (x) (vlax-put-property x 'lock :vlax-true)) lst)
);end_defun

;return list of locked layer objects : requires layer collection
(defun rh:lock_lyr_list (lyrs / lst)
  (if (= "AcDbLayerTable" (vlax-get-property lyrs 'objectname))
    (vlax-map-collection lyrs  '(lambda (x) (if (= :vlax-true (vlax-get-property x 'lock)) (setq lst (cons x lst)))))
  );end_if
  lst
);end_defun




(princ "\n make it color - loading complete")
(princ "\n command [ ` - return / 1 - red / 2 - yellow / 3 - green / 4 - cyan / 5 - blue / 6 - magenta / 7 - white / 8 - gray / 9 - light gray / 0 - purple ]")

Edited March 15, 2022 by exceed
code updated 2 (for locked layer) / code updated 3 (no overwrite MIP) and add color option / code updated 4 add 0 command purple

March 15, 2022

Wow..so with this wonderful lisp i don't change anything and just enough load your lisp before every command right ?if so you are the best .tomorrow i will try .

Does it work in silent mode without show to select right?

Edited March 15, 2022 by jim78b

March 15, 2022

6 hours ago, jim78b said:

Wow..so with this wonderful lisp i don't change anything and just enough load your lisp before every command right ?if so you are the best .tomorrow i will try .

Does it work in silent mode without show to select right?

Yes. This Lisp runs without selection.

When executed 0~9&` outside the block editor, it is executed for the entire drawing,

and when executed 0~9&` inside the block editor, it is executed for the objects in the block.

If the drawing has a large capacity, it may take a long time to execute because all objects are modified.

I tested and succeeded in executing the aerial plot plan drawing of 10mb capacity.

An error may occur when blocks in the block like overlapping blocks. It's not something I have the ability to fix yet.

so, you may need a selection range option for avoid this case.

In that case, just delete the "X" after all ssget.

in unique case, if you use hyperlinks on drawings already, it will be overwritten with data from MIP and MIC

+

in this lisp, have to use BEDIT, instead of REFEDIT

because in REFEDIT, ssget picks all object outside of block.

Edited March 15, 2022 by exceed

March 15, 2022

I think you are very kind to help me and very good. I would not be lacking in courtesy if I ask you if you can fix that little defect of the nested blocks.

In my work i use only refedit! :(. i mean if i use refedit object outside are not affected,

important that I run the command before editing the block so if I use refedit inside the colors of the entities are the original ones right?

have a nice day

March 15, 2022

hello i test the lisp, is very slow...and seem not work for all blocks, as in attached figure you see the green blocks and title block that doesn't change its color.

the ' not return on the original state, i don't know if i must reload the lisp...

make it purple - processing
Error: Automation Error. XData size exceeded
Command:
Command: *Cancel*

Edited March 15, 2022 by jim78b

March 16, 2022

hello your lisp classify.lsp give me this error

; error: ActiveX Server returned the error: unknown name: LinetypeScale

if i copy code in command line, works but not do nothing in nestedd blocks

best regards

Edited March 16, 2022 by jim78b

March 17, 2022

exceed welcome to use this

Have you looked at ( setq colnum (acad_colordlg 1) pick any color probably what I would use saves need more defuns.

or

(if (not AH:Butts)(load "Multi Radio buttons.lsp"))
(if (= but nil)(setq but 1))
(ah:butts but "V" '("Choose a color" "yellow" "green" "cyan" "blue" "magenta" "white" "gray" "light" "gray" "purple")) 
; the variable BUT inside the code holds the button selected value can use that for this post

Multi GETVALS.lsp

Edited March 17, 2022 by BIGAL

March 17, 2022

i don't know how load this lisp

March 17, 2022

Its for exceed to add to his lisp if he wants.

March 17, 2022

; make it color - 2022.03.15 exceed
; this lisp use object's hyperlink property
; command list 
; ` = make it color (return to origin) leftside of "1" key
; 1 = make it red
; 2 = make it yellow
; 3 = make it green
; 4 = make it cyan
; 5 = make it blue
; 6 = make it magenta
; 7 = make it white
; 8 = make it gray
; 9 = make it light gray
; 0 = make it purple

; set 1 object(or block) only
(defun c:` () (ex:mics) (princ)) ;make it color (return to origin)
(defun c:1 () (ex:mips 1) (princ)) ;make it red 
(defun c:2 () (ex:mips 2) (princ)) ;make it yellow
(defun c:3 () (ex:mips 3) (princ)) ;make it green
(defun c:4 () (ex:mips 4) (princ)) ;make it cyan
(defun c:5 () (ex:mips 5) (princ)) ;make it blue
(defun c:6 () (ex:mips 6) (princ)) ;make it magenta
(defun c:7 () (ex:mips 7) (princ)) ;make it white
(defun c:8 () (ex:mips 8) (princ)) ;make it gray
(defun c:9 () (ex:mips 9) (princ)) ;make it lightgray
(defun c:0 () (ex:mips 200) (princ)) ;make it purple

; set all of object in this drawing
(defun c:`` () (ex:mic) (princ)) ;make it color (return to origin)
(defun c:11 () (ex:mip 1) (princ)) ;make it red 
(defun c:22 () (ex:mip 2) (princ)) ;make it yellow
(defun c:33 () (ex:mip 3) (princ)) ;make it green
(defun c:44 () (ex:mip 4) (princ)) ;make it cyan
(defun c:55 () (ex:mip 5) (princ)) ;make it blue
(defun c:66 () (ex:mip 6) (princ)) ;make it magenta
(defun c:77 () (ex:mip 7) (princ)) ;make it white
(defun c:88 () (ex:mip 8) (princ)) ;make it gray
(defun c:99 () (ex:mip 9) (princ)) ;make it lightgray
(defun c:00 () (ex:mip 200) (princ)) ;make it purple


(vl-load-com)

(defun ex:mip ( setcolor / blkss blk ent edata blknames setcolor_txt c_lyrs lock_lst *error* ss ssl index obj color linetype linetypescale str en check index1 obj1 en1 ssblk ssblkindex blkent blk ent enx obj2 color2 linetype2 linetypescale2 str2 hlinks2 )
   (setvar 'cmdecho 0)
   (LM:startundo (LM:acdoc))
    (defun *error* ( msg )
        (rh:relock_lyrs lock_lst)
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (setvar 'cmdecho 1)
        (princ)
    )

  (setq c_lyrs (vla-get-layers (LM:acdoc)))
  (setq lock_lst (rh:lock_lyr_list c_lyrs))
  (rh:unlock_lyrs lock_lst)

 (cond 
   ((= setcolor 1) (setq setcolor_txt "red") )
   ((= setcolor 2) (setq setcolor_txt "yellow") )
   ((= setcolor 3) (setq setcolor_txt "green") )
   ((= setcolor 4) (setq setcolor_txt "cyan") )
   ((= setcolor 5) (setq setcolor_txt "blue") )
   ((= setcolor 6) (setq setcolor_txt "magenta") )
   ((= setcolor 7) (setq setcolor_txt "white") )
   ((= setcolor 8) (setq setcolor_txt "gray") )
   ((= setcolor 9) (setq setcolor_txt "lightgray") )
   ((= setcolor 200) (setq setcolor_txt "purple") )
 );end of cond

 (princ "\n make it ") 
 (princ setcolor_txt)
 (princ " - processing ") 

 (if (setq ss (ssget "X"))
    (progn
      (setq ssl 0)
      (setq ssl (sslength ss))
      (setq index 0)
      (setq str "")
      (repeat ssl
        (setq en (ssname ss index))
        (setq obj (vlax-ename->vla-object (cdr (assoc -1 (entget en)))))
        ;(vlax-for x (vla-get-hyperlinks obj) (vla-delete x))
        (setq old_str "")
        (vlax-for each (vlax-get-property obj 'Hyperlinks)
            (setq old_str (strcat (vla-get-url each)))
          ) 
          ;(princ "\n old_str - ")
          ;(princ old_str)
        (if (/= (substr old_str 1 3) "MIP")
        (progn
        ;(princ "\n modify")
        (setq color (vl-princ-to-string (vla-get-color obj)))
        (setq linetype (vl-princ-to-string (vla-get-linetype obj)))
        (setq linetypescale (vl-princ-to-string (vla-get-linetypescale obj)))
        (setq str (strcat "MIP/" color "/" linetype "/" linetypescale))
        (setq hlinks (vlax-get-property obj 'Hyperlinks))
        (vla-add hlinks str)
        )
        (progn
        ;(princ "\n stay")
        (vla-add (vlax-get-property obj 'Hyperlinks) old_str)
        )
        )
        (setq index (+ index 1))
      );end of repeat
      (setq index1 0)
      (repeat ssl
        (setq en1 (ssname ss index1))
        (setq obj1 (vlax-ename->vla-object (cdr (assoc -1 (entget en1)))))
        (setq check (vlax-property-available-p obj1 "Color" T))
	(if check
		(vlax-put-property obj1 'Color setcolor)
	) 
        (vla-put-linetype obj1 "continuous")
        (vla-put-linetypescale obj1 1)
        (setq index1 (+ index1 1))
      );end of repeat
    );end of progn
  );end of if



(if (setq blkss (ssget "x" '((0 . "insert")) ))
  (progn
    (repeat (setq inc (sslength blkss)); get names from initial selection
      (setq blk (ssname blkss (setq inc (1- inc))))
      (nametolist blk)
    ); repeat
  (while (setq blk (car blknames)); as long as there's another Block name in list
    ;; [done this way instead of via (repeat) or (foreach), so it can add nested Blocks' names to the list]
    (setq ent (tblobjname "block" blk)); Block definition as entity
    (while (setq ent (entnext ent)); then -- proceed through sub-entities in definition
      (setq edata (entget ent))
      (if (member '(0 . "INSERT") edata) (nametolist ent)); if nested Block, add name to end of list
        (setq obj (vlax-ename->vla-object ent))
        (setq old_str "")
        (vlax-for each (vlax-get-property obj 'Hyperlinks)
            (setq old_str (strcat (vla-get-url each)))
          ) 
          ;(princ "\n old_str - ")
          ;(princ old_str)
        (if (/= (substr old_str 1 3) "MIP")
          (progn
            ;(princ "\n modify")
            (setq color (vl-princ-to-string (vla-get-color obj)))
            (setq linetype (vl-princ-to-string (vla-get-linetype obj)))
            (setq linetypescale (vl-princ-to-string (vla-get-linetypescale obj)))
            (setq str (strcat "MIP/" color "/" linetype "/" linetypescale))
            (setq hlinks (vlax-get-property obj 'Hyperlinks))
            (vla-add hlinks str)
          );end of progn
          (progn
           ;(princ "\n stay")
           (vla-add (vlax-get-property obj 'Hyperlinks) old_str)
          );end of progn
        );end of if
        (if (vlax-property-available-p obj 'Linetype)
         	 (vla-put-linetype obj "continuous")
        )
        (vla-put-color obj setcolor); color ByLayer
        (vla-put-linetypescale obj1 1)
    ); while -- sub-entities
    (setq blknames (cdr blknames)); take first one off
  ); while
);end of progn
);end of if

(rh:relock_lyrs lock_lst)
(vla-regen (LM:acdoc) acallviewports)
(princ "\n make it ") 
(princ setcolor_txt)
(princ " - complete!") 

(LM:endundo (LM:acdoc))
(setvar 'cmdecho 1)
(princ)
);end of defun

;mip for single selection 
(defun ex:mips ( setcolor / blkss blk ent edata blknames setcolor_txt c_lyrs lock_lst *error* ss ssl index obj color linetype linetypescale str en check index1 obj1 en1 ssblk ssblkindex blkent blk ent enx obj2 color2 linetype2 linetypescale2 str2 hlinks2 )
   (setvar 'cmdecho 0)
   (LM:startundo (LM:acdoc))
    (defun *error* ( msg )
        (rh:relock_lyrs lock_lst)
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (setvar 'cmdecho 1)
        (princ)
    )

  (setq c_lyrs (vla-get-layers (LM:acdoc)))
  (setq lock_lst (rh:lock_lyr_list c_lyrs))
  (rh:unlock_lyrs lock_lst)

 (cond 
   ((= setcolor 1) (setq setcolor_txt "red") )
   ((= setcolor 2) (setq setcolor_txt "yellow") )
   ((= setcolor 3) (setq setcolor_txt "green") )
   ((= setcolor 4) (setq setcolor_txt "cyan") )
   ((= setcolor 5) (setq setcolor_txt "blue") )
   ((= setcolor 6) (setq setcolor_txt "magenta") )
   ((= setcolor 7) (setq setcolor_txt "white") )
   ((= setcolor 8) (setq setcolor_txt "gray") )
   ((= setcolor 9) (setq setcolor_txt "lightgray") )
   ((= setcolor 200) (setq setcolor_txt "purple") )
 );end of cond

 (princ "\n make it ") 
 (princ setcolor_txt)
 (princ " - processing ") 

 (if (setq ss (ssget ":S"))
    (progn
      (setq ssl 0)
      (setq ssl (sslength ss))
      (setq index 0)
      (setq str "")
      (repeat ssl
        (setq en (ssname ss index))
        (setq obj (vlax-ename->vla-object (cdr (assoc -1 (entget en)))))
        ;(vlax-for x (vla-get-hyperlinks obj) (vla-delete x))
        (setq old_str "")
        (vlax-for each (vlax-get-property obj 'Hyperlinks)
            (setq old_str (strcat (vla-get-url each)))
          ) 
          ;(princ "\n old_str - ")
          ;(princ old_str)
        (if (/= (substr old_str 1 3) "MIP")
        (progn
        ;(princ "\n modify")
        (setq color (vl-princ-to-string (vla-get-color obj)))
        (setq linetype (vl-princ-to-string (vla-get-linetype obj)))
        (setq linetypescale (vl-princ-to-string (vla-get-linetypescale obj)))
        (setq str (strcat "MIP/" color "/" linetype "/" linetypescale))
        (setq hlinks (vlax-get-property obj 'Hyperlinks))
        (vla-add hlinks str)
        )
        (progn
        ;(princ "\n stay")
        (vla-add (vlax-get-property obj 'Hyperlinks) old_str)
        )
        )
        (setq index (+ index 1))
      );end of repeat
      (setq index1 0)
      (repeat ssl
        (setq en1 (ssname ss index1))
        (setq obj1 (vlax-ename->vla-object (cdr (assoc -1 (entget en1)))))
        (setq check (vlax-property-available-p obj1 "Color" T))
	(if check
		(vlax-put-property obj1 'Color setcolor)
	) 
        (vla-put-linetype obj1 "continuous")
        (vla-put-linetypescale obj1 1)
        (setq index1 (+ index1 1))
      );end of repeat
    );end of progn
  );end of if



(if (setq blkss (ssget "P" '((0 . "insert")) ))
  (progn
    (repeat (setq inc (sslength blkss)); get names from initial selection
      (setq blk (ssname blkss (setq inc (1- inc))))
      (nametolist blk)
    ); repeat
  (while (setq blk (car blknames)); as long as there's another Block name in list
    ;; [done this way instead of via (repeat) or (foreach), so it can add nested Blocks' names to the list]
    (setq ent (tblobjname "block" blk)); Block definition as entity
    (while (setq ent (entnext ent)); then -- proceed through sub-entities in definition
      (setq edata (entget ent))
      (if (member '(0 . "INSERT") edata) (nametolist ent)); if nested Block, add name to end of list
        (setq obj (vlax-ename->vla-object ent))
        (setq old_str "")
        (vlax-for each (vlax-get-property obj 'Hyperlinks)
            (setq old_str (strcat (vla-get-url each)))
          ) 
          ;(princ "\n old_str - ")
          ;(princ old_str)
        (if (/= (substr old_str 1 3) "MIP")
          (progn
            ;(princ "\n modify")
            (setq color (vl-princ-to-string (vla-get-color obj)))
            (setq linetype (vl-princ-to-string (vla-get-linetype obj)))
            (setq linetypescale (vl-princ-to-string (vla-get-linetypescale obj)))
            (setq str (strcat "MIP/" color "/" linetype "/" linetypescale))
            (setq hlinks (vlax-get-property obj 'Hyperlinks))
            (vla-add hlinks str)
          );end of progn
          (progn
           ;(princ "\n stay")
           (vla-add (vlax-get-property obj 'Hyperlinks) old_str)
          );end of progn
        );end of if
        (if (vlax-property-available-p obj 'Linetype)
         	 (vla-put-linetype obj "continuous")
        )
        (vla-put-color obj setcolor); color ByLayer
        (vla-put-linetypescale obj1 1)
    ); while -- sub-entities
    (setq blknames (cdr blknames)); take first one off
  ); while
);end of progn
);end of if

(rh:relock_lyrs lock_lst)
(vla-regen (LM:acdoc) acallviewports)
(princ "\n make it ") 
(princ setcolor_txt)
(princ " - complete!") 

(LM:endundo (LM:acdoc))
(setvar 'cmdecho 1)
(princ)
);end of defun

(defun ex:mic ( / blkss blk ent edata blknames c_lyrs lock_lst *error* ssblk ssblkl ssblkindex blk ent enx str2 obj2 hlinks2 strlist2 color2 linetype2 linetypescale2 check ss ssl index obj color linetype linetypescale str layertable newlayername en check strlist )
   (setvar 'cmdecho 0)
   (LM:startundo (LM:acdoc))
    (defun *error* ( msg )
        (rh:relock_lyrs lock_lst)
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (setvar 'cmdecho 1)
        (princ)
    )


  (setq c_lyrs (vla-get-layers (LM:acdoc)))
  (setq lock_lst (rh:lock_lyr_list c_lyrs))
  (rh:unlock_lyrs lock_lst)

(princ "\n make it color (return to origin) - processing ")
(if (setq blkss (ssget "x" '((0 . "insert")) ))
  (progn
    (repeat (setq inc (sslength blkss)); get names from initial selection
      (setq blk (ssname blkss (setq inc (1- inc))))
      (nametolist blk)
    ); repeat
    (while (setq blk (car blknames)); as long as there's another Block name in list
    ;; [done this way instead of via (repeat) or (foreach), so it can add nested Blocks' names to the list]
    (setq ent (tblobjname "block" blk)); Block definition as entity
    (while (setq ent (entnext ent)); then -- proceed through sub-entities in definition
      (setq edata (entget ent))
      (if (member '(0 . "INSERT") edata) (nametolist ent)); if nested Block, add name to end of list
        (setq obj2 (vlax-ename->vla-object ent))
        (setq str2 "")
        (setq hlinks2 (vlax-get-property obj2 'Hyperlinks))
        (vlax-for each hlinks2
            (setq str2 (strcat (vla-get-url each)))
        ) 
        (if (/= str2 "")
          (progn 
            (setq strlist2 '())
            (setq strlist2 (LM:str->lst str2 "/"))
            (setq color2 (cadr strlist2))
            (setq linetype2 (caddr strlist2))
            (setq linetypescale2 (nth 3 strlist2))
            (setq check (vlax-property-available-p obj2 "Color" T))
               (if check
   	     (vlax-put-property obj2 'Color color2)
               ) 
            (vla-put-linetype obj2 linetype2)
            (vla-put-linetypescale obj2 linetypescale2)
            (vlax-for x (vla-get-hyperlinks obj2) (vla-delete x)) 
          ); end of progn
        );end of if
    ); while -- sub-entities
    (setq blknames (cdr blknames)); take first one off
  ); while

);end of progn
);end of if


 (if (setq ss (ssget "X" '((-3 ("PE_URL")))))
    (progn
      (setq ssl 0)
      (setq ssl (sslength ss))
      (setq index 0)
      (setq str "")
      (repeat ssl
        (setq en (ssname ss index))
        (setq obj (vlax-ename->vla-object (cdr (assoc -1 (entget en)))))
        (setq hlinks (vlax-get-property obj 'Hyperlinks))
        (vlax-for each hlinks 
          (setq str (strcat (vla-get-url each)))
        )
        (setq strlist (LM:str->lst str "/"))
        (setq color (cadr strlist))
        (setq linetype (caddr strlist))
        (setq linetypescale (nth 3 strlist))
        (setq check (vlax-property-available-p obj "Color" T))
	(if check
		(vlax-put-property obj 'Color color)
	) 
        (vla-put-linetype obj linetype)
        (vla-put-linetypescale obj linetypescale)
        (vlax-for x (vla-get-hyperlinks obj) (vla-delete x))
        (setq index (+ index 1))
      );end of repeat
    );end of progn
  );end of if


(rh:relock_lyrs lock_lst)
(vla-regen (LM:acdoc) acallviewports)
(princ "\n make it color (return to origin)") 
(princ " - complete!") 


(LM:endundo (LM:acdoc))
(setvar 'cmdecho 1)
(princ)
);end of defun




;mic for single selection
(defun ex:mics ( / ssorigin blkss blk ent edata blknames c_lyrs lock_lst *error* ssblk ssblkl ssblkindex blk ent enx str2 obj2 hlinks2 strlist2 color2 linetype2 linetypescale2 check ss ssl index obj color linetype linetypescale str layertable newlayername en check strlist )
   (setvar 'cmdecho 0)
   (LM:startundo (LM:acdoc))
    (defun *error* ( msg )
        (rh:relock_lyrs lock_lst)
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (setvar 'cmdecho 1)
        (princ)
    )


  (setq c_lyrs (vla-get-layers (LM:acdoc)))
  (setq lock_lst (rh:lock_lyr_list c_lyrs))
  (rh:unlock_lyrs lock_lst)

(setq ssorigin (ssget ":s"))
(princ "\n make it color (return to origin) - processing ")
(if (setq blkss (ssget "P" '((0 . "insert")) ))
  (progn
    (repeat (setq inc (sslength blkss)); get names from initial selection
      (setq blk (ssname blkss (setq inc (1- inc))))
      (nametolist blk)
    ); repeat
    (while (setq blk (car blknames)); as long as there's another Block name in list
    ;; [done this way instead of via (repeat) or (foreach), so it can add nested Blocks' names to the list]
    (setq ent (tblobjname "block" blk)); Block definition as entity
    (while (setq ent (entnext ent)); then -- proceed through sub-entities in definition
      (setq edata (entget ent))
      (if (member '(0 . "INSERT") edata) (nametolist ent)); if nested Block, add name to end of list
        (setq obj2 (vlax-ename->vla-object ent))
        (setq str2 "")
        (setq hlinks2 (vlax-get-property obj2 'Hyperlinks))
        (vlax-for each hlinks2
            (setq str2 (strcat (vla-get-url each)))
        ) 
        (if (/= str2 "")
          (progn 
            (setq strlist2 '())
            (setq strlist2 (LM:str->lst str2 "/"))
            (setq color2 (cadr strlist2))
            (setq linetype2 (caddr strlist2))
            (setq linetypescale2 (nth 3 strlist2))
            (setq check (vlax-property-available-p obj2 "Color" T))
               (if check
   	     (vlax-put-property obj2 'Color color2)
               ) 
            (vla-put-linetype obj2 linetype2)
            (vla-put-linetypescale obj2 linetypescale2)
            (vlax-for x (vla-get-hyperlinks obj2) (vla-delete x)) 
          ); end of progn
        );end of if
    ); while -- sub-entities
    (setq blknames (cdr blknames)); take first one off
  ); while

);end of progn
);end of if

(command "_.SELECT" ssorigin "")
 (if (setq ss (ssget "P" '((-3 ("PE_URL")))))
    (progn
      (setq ssl 0)
      (setq ssl (sslength ss))
      (setq index 0)
      (setq str "")
      (repeat ssl
        (setq en (ssname ss index))
        (setq obj (vlax-ename->vla-object (cdr (assoc -1 (entget en)))))
        (setq hlinks (vlax-get-property obj 'Hyperlinks))
        (vlax-for each hlinks 
          (setq str (strcat (vla-get-url each)))
        )
        (setq strlist (LM:str->lst str "/"))
        (setq color (cadr strlist))
        (setq linetype (caddr strlist))
        (setq linetypescale (nth 3 strlist))
        (setq check (vlax-property-available-p obj "Color" T))
	(if check
		(vlax-put-property obj 'Color color)
	) 
        (vla-put-linetype obj linetype)
        (vla-put-linetypescale obj linetypescale)
        (vlax-for x (vla-get-hyperlinks obj) (vla-delete x))
        (setq index (+ index 1))
      );end of repeat
    );end of progn
  );end of if


(rh:relock_lyrs lock_lst)
(vla-regen (LM:acdoc) acallviewports)
(princ "\n make it color (return to origin)") 
(princ " - complete!") 


(LM:endundo (LM:acdoc))
(setvar 'cmdecho 1)
(princ)
);end of defun





;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)


;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)



;; String to List  -  Lee Mac
;; Separates a string using a given delimiter
;; str - [str] String to process
;; del - [str] Delimiter by which to separate the string
;; Returns: [lst] List of strings
 
(defun LM:str->lst ( str del / pos )
    (if (setq pos (vl-string-search del str))
        (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del))
        (list str)
    )
)

; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/create-list-of-locked-layers-lock-amp-unlock-again/m-p/9306234/highlight/true#M395697
;; unlock all layers : requires list of locked layer objects 
(defun rh:unlock_lyrs (lst)
  (mapcar '(lambda (x) (vlax-put-property x 'lock :vlax-false)) lst)
);end_defun
  
;; relock all previously locked layers : requires list of locked layer objects  
(defun rh:relock_lyrs (lst)
  (mapcar '(lambda (x) (vlax-put-property x 'lock :vlax-true)) lst)
);end_defun

;return list of locked layer objects : requires layer collection
(defun rh:lock_lyr_list (lyrs / lst)
  (if (= "AcDbLayerTable" (vlax-get-property lyrs 'objectname))
    (vlax-map-collection lyrs  '(lambda (x) (if (= :vlax-true (vlax-get-property x 'lock)) (setq lst (cons x lst)))))
  );end_if
  lst
);end_defun


;;  BlockSParts0Bylayer.lsp
;;  = change all Parts of definitions of Selected Block(s) [other
;;    than on Layer Defpoints] to Layer 0 with Color ByLayer
;;  Kent Cooper, 3 November 2014

;; Modified by Alan h OCT 2020
;; now does linetype only
  (defun nametolist (blk / blkobj blkname); get Block name and put it into list of names
    (if (= (logand (cdr (assoc 70 (entget blk))) 4) 0) ; not an Xref
      (progn
        (setq
          blkobj (vlax-ename->vla-object blk)
          blkname
            (vlax-get-property blkobj
              (if (vlax-property-available-p blkobj 'EffectiveName) 'EffectiveName 'Name)
                ; to work with older versions that don't have dynamic Blocks
            ); ...get-property & blkname
        ); setq
        (if
          (not (member blkname blknames)); name not already in list
          (setq blknames (append blknames (list blkname))); then -- add to end of list
        ); if
      ); progn
    ); if
  ); defun -- nametolist





(princ "\n make it color - loading complete")
(princ "\n command [ ` - return / 1 - red / 2 - yellow / 3 - green / 4 - cyan / 5 - blue / 6 - magenta / 7 - white / 8 - gray / 9 - light gray / 0 - purple ]")

1. can edit nested block also, this is Kent Cooper's code.

2. can edit 1 select option.

0 - 1 selection

00 - all of drawing.

so, in front of REFEDIT MODE or inside of REFEDIT MODE also can do this.

If this Lisp is running on heavy drawings, you can split it up and run it.

3. Exceeding the capacity of xdata seems to be a different problem.

This Lisp will not hit the limits of xdata because it writes "color, line type, line type scale" in one line of text.

10 hours ago, BIGAL said:
exceed welcome to use this

Have you looked at ( setq colnum (acad_colordlg 1) pick any color probably what I would use saves need more defuns.

or
(if (not AH:Butts)(load "Multi Radio buttons.lsp"))
(if (= but nil)(setq but 1))
(ah:butts but "V" '("Choose a color" "yellow" "green" "cyan" "blue" "magenta" "white" "gray" "light" "gray" "purple")) 
; the variable BUT inside the code holds the button selected value can use that for this post 
Multi GETVALS.lsp 2.75 kB · 16 downloads

thank you. I'll study DCL because I've only experienced merging divided .dcl files into one .lsp only once. You seem to have made it easy to understand.

March 17, 2022

sorry i am confused now, what is the right listing? if I edit a block in place those outside become purple I hope?

March 17, 2022

one stroke key is for ONE

double stroke key is for ALL

1. before REFEDIT

00 - make all drawing purple

2. in REFEDIT

` - make it original color (1 block)

3. after REFCLOSE

0 - make it purple (1 block)

As you've experienced, this routine or change layer thread's routine takes time.

so if it's simply an invisible problem for instant work only,

Lisp that changes the background color with a "tab key" might be better.

;; Modified from the original by Lee Mac 13 JAN 2019
;; cadtutor.net/forum/topic/66670-cursor-color-changing-lisp/
;; Post 5

;; Cycles the background from black (000), thru all shades
;;   of grey (250/251/8/252/253/9/254) to white (255).

(defun c:BCTAB ( / d l )
    (setq l '(000 3355443 5987163 8421504 8684676 11382189 12632256 14079702 16777215)
          d  (vla-get-display (vla-get-preferences (vlax-get-acad-object)))
    )
    (princ "\nPress TAB to cycle BACKGROUND colors <done>: ")
    (while (equal '(2 9) (grread nil 10))
        (vla-put-GraphicsWinModelBackgrndColor d (car (setq l (append (cdr l) (list (car l))))))
    )
    (princ)
)

or locked layer fading control command

laylockfadectl, -90 (can see like unlocked layer) ~ 90 (can't see anything)

Edited March 17, 2022 by exceed

March 17, 2022

Later i will try thanks a lot . Important that when use refedit object outside are purple .

Sign In

Lisp create layer by colors linetype ...

Recommended Posts

jim78b

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

exceed

exceed

BIGAL

Posted Images

BIGAL

jim78b

exceed

nod684

jim78b

jim78b

exceed

jim78b

exceed

jim78b

jim78b

jim78b

BIGAL

jim78b

BIGAL

exceed

jim78b

exceed

jim78b

Join the conversation

exceed

exceed

BIGAL

Tutorials

Forums

Activity