Select forced LineTypes and move to a new layer

[Justin_Shields]

Hey everyone, needing help with a script, Lisp, or ssget command to help clean up backgrounds we get from our clients. I know very little on using this language and have pieced together what is below but savvy enough to know how to do what I need. Any help would be greatly appreciated 🙂

Currently we are getting backgrounds with lines with forced linetypes that share the same layer with lines that are bylayer. I believe these drawings are being exported from Revit and the export setting isn't establishing new layers based off the linetypes. What I'm looking for is something that will select these forced linetypes by the layers they are on and add them to a new layer based on the linetype they were on.

Example:

Line is on layer A-GENM but has a forced linetype of Overhead. There are other lines on A-GENM that are ByLayer or Continuous that I want to leave alone. There are also other lines with LineType Overhead but on different layers. So I can't just select all forced Overhead Linetypes. But I'd like to select only the Overhead lines on Layer A-GENM and move them to a new layer called A-GENM-OVHD. Then repeat for each other layer and forced LineType.

I was trying to use something like below to run in a batch script program to several backgrounds. It works except if a drawing doesn't contain any of the lines being asked to select, the script stops. 

-LAYER
N A-FLOR-FIXT-OVHD
N A-GENM-OVHD
L "Overhead" A-FLOR-FIXT-OVHD
L "Overhead" A-GENM-OVHD

CHANGE (SSGET "X" '((6 . "Overhead")(8 . "A-FLOR-FIXT"))) P LA A-FLOR-FIXT-OVHD

CHANGE (SSGET "X" '((6 . "Overhead")(8 . "A-GENM"))) P LA A-GENM-OVHD

[paullimapa · Accepted solution]

it's going to be complicated but check out this code which checks objects inside & outside blocks:

; ChObLtLy selects all objects with ltype
; create new layer name with ltype name suffix
; move object to that layer 
; remove ltype assoc pair
(defun c:ChObLtLy (/ ChLyLt CpLyPr chk_mak_lyr d en ed i lt ly lyn MakLyrNam ss) 
(if(not(car (atoms-family 1 '("vl-load-com"))))(vl-load-com))  
; MakLyrNam creates layer with given name
(defun MakLyrNam (layname / lays)
   (setq lays (vlax-get-property (vlax-get-property (vlax-get-acad-object) 'ActiveDocument) 'Layers))
   (vlax-invoke-method lays 'Add layname)
) ; defun
; CpLyPr Copy Layer Properties from Source to Targer
; modified from: 
; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/copy-layer-properties-from-one-layer-to-another/td-p/1983148
(defun CpLyPr (layname1 layname2 / lay1 lays laylinetype1 laylineweight1 laycolor1)
;(setq lay1 (vlax-ename->vla-object  (car (entsel "\nPick an object for lay1 "))))
 (setq ; layname1 (vla-get-layer lay1)
	lays (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
 )	
 (vlax-for lay lays
  (if (= (vla-get-name lay) layname1)
   (progn
    (setq 
     laylinetype1 (vla-get-linetype lay)
     laylineweight1 (vla-get-lineweight lay)
     laycolor1 (vla-get-color  lay)
    )
   )
  )
 )
; (setq lay2 (vlax-ename->vla-object  (car (entsel "\nPick an object for lay2 "))))
; (setq layname2 (vla-get-layer lay2))
 (vlax-for lay lays
  (if (= (vla-get-name lay) layname2)
    (progn
     (vla-put-color lay laycolor1)
     (vla-put-linetype  lay laylinetype1)
     (vla-put-lineweight lay laylineweight1)
    )
  )
 )
) ; defun
; ChLyLt changes given layer name with given ltype name
(defun ChLyLt (layname laylinetype / lays)
 (setq 
	lays (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
 )
 (vlax-for lay lays
  (if (= (vla-get-name lay) layname)
   (vla-put-linetype lay laylinetype)
  )
 )  
) ; defun
; chk_mak_lyr check if layer exists before proceeding with layer creation functions
(defun chk_mak_lyr (lyold lynew ltyp)
  (if(not(tblsearch "Layer" lynew)) ; chk if new layer exists
   (progn
     (MakLyrNam lynew) ; make new layer
     (CpLyPr lyold lynew) ; copy layer properties ltype lweight & color to new layer
     (ChLyLt lynew ltyp) ; change new layer's ltype to match
   ) ; progn
  ) ; if
) ; defun  
 (setq d 0) ; set # of deleted at 0
 ; check all objects inside of blocks
 (vlax-for blk (vla-get-blocks(vla-get-activedocument (vlax-get-acad-object))) ; select all blocks
    (if 
      (and 
       (= :vlax-false (vlax-get-property blk 'islayout)) ; not layout
       (= :vlax-false (vlax-get-property blk 'isxref))   ; not xref
       (= :vlax-false (vlax-get-property blk 'isdynamicblock)) ; not dynamic
      );end_and
      (vlax-for itm blk
        (if (/= "BYLAYER" (strcase (setq lt (vla-get-Linetype itm))))  ; if ltype defined
          (progn
            (setq ly (vla-get-Layer itm)) ; get layer name
            (setq lyn (strcat ly "-" lt)) ; new layer name adding ltype suffix
            (chk_mak_lyr ly lyn lt) ; chk layer name before making new layer with ltype prop
            (vla-put-Linetype itm "BYLAYER") ; change object's ltype to bylayer
            (vla-put-Layer itm lyn) ; move object to new layer
            (setq d(1+ d)) ; add # of deleted
          )
        )
      ) ; end_for
     ) ; end if
 );end_for
 ; check all objects outside of blocks
 (if (setq ss (ssget "_X")) ; select all objects
    (repeat (setq i (sslength ss))
      (setq en (ssname ss (setq i (1- i))))
      (if (and
            (setq lt (cdr (assoc 6 (setq ed (entget en))))) ; if ltype defined
            (/= (strcase lt) "BYLAYER") ; not bylayer
          )
        (progn
          (setq ly (cdr(assoc 8 ed))) ; get layer name
          (setq lyn (strcat ly "-" lt)) ; new layer name adding ltype suffix
          (chk_mak_lyr ly lyn lt) ; chk layer name before making new layer with ltype prop
          (setq ed (subst(cons 6 "BYLAYER")(assoc 6 ed) ed)) ; change object's ltype to bylayer
          (entmod (subst(cons 8 lyn)(assoc 8 ed) ed)) ; move object to new layer
          (entupd en) ; update entity
          (setq d(1+ d)) ; add # of deleted
        ) ; progn
      ) ; if
    ) ; repeat
 ) ; if objects
 (princ(strcat"\nFound & Changed Total of " (itoa d) " Objects To Layer Name With Ltype Suffix."))(princ)  
) ; defun

[Justin_Shields]

Thank you so much @paullimapa for this solution. It works perfectly! You are a rockstar 😁 

[paullimapa]

Glad to help … cheers!!!