Find all objects that linestyle is set to other than bylayer and move them to new layer

[LDShaw]

I was hoping for an easy button today. At the bottom of this post will be what I am trying to accomplish.
 
1, I need a lsp that finds all objects that linetype is set to other than bylayer.
2. See's what color and lintype are being used

3. Creates a layer that by the linetype name and color.
4. moves objects to those layers. 

Typical object property I will want changed.
layer g-equip
color by layer (green. magenta, yellow, 8)
linetype (dashed, hidden, hidden2)

if it found as an example 

g-equip with a linetype of hidden with a layer color of green. 
it would move all object to a layer it created of
hidden-green
that layer would have the linetype set to hidden. All other properties don't matter.

The reason I need this is for Revit.
I've been tasked to move several 100 details to revit. Part of the move is all traces of autocad gets removed. When you import the dwg's partial explode you lose the linetype if it was set to anything but bylayer.   

[pendean]

While you wait...
REVIT's EXPORT is the creator of the issue for you since AutoCAD does not 'import' revit files. Have you all had a chance to explore possible export solutions in the REVIT forum yet like
https://forums.autodesk.com/t5/revit-architecture-forum/revit-to-dwg-export-line-type-problem/td-p/1...
an the highlighted tip (if an option) here
https://www.autodesk.com/support/technical/article/caas/sfdcarticles/sfdcarticles/DWG-does-not-set-l....

[LDShaw]

I am going to other way dwg to Revit. It's the dwg file that is being imported into Revit Drafting view then a partial explode so I can get to the objects to move to the correct fonts and linestyles in Revit. 

[MrJSmith]

@LDShaw See if this works for you.

(defun c:updateLinesToByLayer ( / MS:createLayer ssList line lineType color newLayerName)
	(defun MS:createLayer (layerName color lttype / ) ;Creates a layer with the given layerName / colors / linetype.
		(if (not (member (strcase layerName) (mapcar 'strcase (tbL-name-List "LAYER")))) ;Have to check with everything same case. It will fail otherwise despite having no case for layers
			(if 
				(entmake
					(list
						'(0 . "LAYER")
						'(100 . "AcDbSymbolTableRecord")
						'(100 . "AcDbLayerTableRecord")
						(cons 2 layerName)
						(cons 70 0) ;on_off 0 or 1
						(cons 62 color)
						(cons 6 lttype) ; line type 
					)
				)
				1 
				nil
			)
			1
		)
	)
	
	(defun ssList (ss / lst ct)
		(if ss
			(progn
				(setq ct 0)
				(repeat (sslength ss)
					(setq 
						lst (cons (ssname ss ct) lst)
						ct (+ ct 1)
					)
				)
			)
		)
	lst
	)
	(or *acad* (setq *acad* (vlax-get-acad-object)))
	(or *acdoc* (setq *acdoc* (vla-get-ActiveDocument *acad*)))
	(or *vlaLayers* (setq *vlaLayers* (vla-get-layers *acdoc*)))
	
	(foreach ent (sslist (ssget "_X" '((0 . "*LINE*"))))
		(setq line (entget ent))
		(if 
			(and 
				(setq lineType (cdr (assoc 6 line))) ;Get line type
				(not (= "BYLAYER" lineType)) ;Check to see if it is not BYLAYER
				(setq layerName (cdr (assoc 8 line))) ;Get Layer Name
				(setq color (vla-get-color (vla-item *vlaLayers* layerName))) ;Get layer color
			)
			(progn
				(setq newLayerName (strcat lineType "-" (itoa color)))
				(if (MS:createLayer newLayerName color lineType)
					(progn
						(setq line (subst (cons 8 newLayerName) (assoc 8 line) line))
						(setq line (subst (cons 6 "BYLAYER") (assoc 6 line) line))
						(entmod line)
					)
					(print (strcat "Failed to create layer: " newLayerName))
				)
			)
		)
	)
)

[LDShaw]

Command: UPDATELINESTOBYLAYER

AutoCAD variable setting rejected:

My guess is it's in here. 

(foreach ent (sslist (ssget "_X" '((0 . "*LINE*"))))
		(setq line (entget ent))
		(if 
			(and 
				(setq lineType (cdr (assoc 6 line))) ;Get line type
				(not (= "BYLAYER" lineType)) ;Check to see if it is not BYLAYER
				(setq layerName (cdr (assoc 8 line))) ;Get Layer Name
				(setq color (vla-get-color (vla-item *vlaLayers* layerName))) ;Get layer color
			)
			(progn
				(setq newLayerName (strcat lineType "-" (itoa color)))
				(if (MS:createLayer newLayerName color lineType)
					(progn
						(setq line (subst (cons 8 newLayerName) (assoc 8 line) line))
						(setq line (subst (cons 6 "BYLAYER") (assoc 6 line) line))
						(entmod line)
					)
					(print (strcat "Failed to create layer: " newLayerName))
				)
			)
		)
	)

---

but it's only a guess. 

[MrJSmith · Accepted solution]

Hmm, not sure about ACAD variable setting rejected....but I did find out I left out a function. Try this.

(defun c:updateLinesToByLayer ( / MS:createLayer ssList line lineType color newLayerName tbL-name-List)
	(defun MS:createLayer (layerName color lttype / ) ;Creates a layer with the given layerName / colors / linetype.
		(if (not (member (strcase layerName) (mapcar 'strcase (tbL-name-List "LAYER")))) ;Have to check with everything same case. It will fail otherwise despite having no case for layers
			(if 
				(entmake
					(list
						'(0 . "LAYER")
						'(100 . "AcDbSymbolTableRecord")
						'(100 . "AcDbLayerTableRecord")
						(cons 2 layerName)
						(cons 70 0) ;on_off 0 or 1
						(cons 62 color)
						(cons 6 lttype) ; line type 
					)
				)
				1 
				nil
			)
			1
		)
	)
	
	(defun ssList (ss / lst ct)
		(if ss
			(progn
				(setq ct 0)
				(repeat (sslength ss)
					(setq 
						lst (cons (ssname ss ct) lst)
						ct (+ ct 1)
					)
				)
			)
		)
	lst
	)
	
	(defun tbL-name-List (tn / td L) ;Can pass it "LAYER or "BLOCK" etc
		(whiLe (setq td (tbLnext tn (not td)))
			(setq L (cons (cdr (assoc 2 td)) L))
		)
		(acad_strlsort L)
	)
	
	(or *acad* (setq *acad* (vlax-get-acad-object)))
	(or *acdoc* (setq *acdoc* (vla-get-ActiveDocument *acad*)))
	(or *vlaLayers* (setq *vlaLayers* (vla-get-layers *acdoc*)))
	
	(foreach ent (sslist (ssget "_X" '((0 . "*LINE*"))))
		(setq line (entget ent))
		(if 
			(and 
				(setq lineType (cdr (assoc 6 line))) ;Get line type
				(not (= "BYLAYER" lineType)) ;Check to see if it is not BYLAYER
				(setq layerName (cdr (assoc 8 line))) ;Get Layer Name
				(setq color (vla-get-color (vla-item *vlaLayers* layerName))) ;Get layer color
			)
			(progn
				(setq newLayerName (strcat lineType "-" (itoa color)))
				(if (MS:createLayer newLayerName color lineType)
					(progn
						(setq line (subst (cons 8 newLayerName) (assoc 8 line) line))
						(setq line (subst (cons 6 "BYLAYER") (assoc 6 line) line))
						(entmod line)
					)
					(print (strcat "Failed to create layer: " newLayerName))
				)
			)
		)
	)
)

[LDShaw]

Looks to work great. Thank YOU!!