I'm currently updating some of my lisp apps for 2009 - thankfully most remain in working order.
Unfortunately the same can't be said for a few of my material handling functions. I've found that I can attach materials to objects or layers using the following code (amending or adding an assoc 347 value).
The problem occurs when trying to detach the materials, I'm removing the assoc 347 and entmod'ing and all appears to go well, sadly however another entget tells me that the assoc 347 is still there.
Does anybody know if this is this a "feature" or as I suspect, another bug in my logic.
;***************************************************************************************************
; GETMATERIALOWNNER - function to return the owner ename of the supplied material name. *
; ================= (entget (GetMaterialOwner "Test")) *
;***************************************************************************************************
(defun GetMaterialOwner (mat / lst)
(if (setq lst (member (cons 3 mat) (dictsearch (namedobjdict) "ACAD_MATERIAL"))) (cdr (cadr lst)) nil)
)
;***************************************************************************************************
; ATTACHMATERIALBYENTITY - function to attach a specified material to an entity. *
; ====================== (AttachMaterialByEntity (car (entsel "Select Object > ")) "Test") *
; (AttachMaterialByEntity (car (entsel "Select Object > ")) "Global") *
;***************************************************************************************************
(defun AttachMaterialByEntity (en mat / elst owner)
(setq elst (entget en) owner (GetMaterialOwner mat))
(cond ((assoc 347 elst) (entmod (subst (cons 347 owner) (assoc 347 elst) elst)))
(t (entmod (append elst (list (cons 347 owner)))))
)
)
;***************************************************************************************************
; ATTACHMATERIALBYLAYER - function to attach a specified material to a specified layer. *
; ===================== (AttachMaterialByLayer "TIN" "Test") *
;***************************************************************************************************
(defun AttachMaterialByLayer (lay mat / owner laylst)
(if (tblsearch "LAYER" lay)
(progn
(setq owner (GetMaterialOwner mat))
(setq laylst (entget (tblobjname "LAYER" lay)))
(cond ((assoc 347 laylst) (entmod (subst (cons 347 owner) (assoc 347 laylst) laylst)))
(t (entmod (append laylst (list (cons 347 owner)))))
)
)
nil
)
)
; ================== UNDER-NOTED FUNCTIONS NOT WORKING IN 2009 :-( ===============================
;***************************************************************************************************
; DETACHMATERIALBYENTITY - function to dettach any material assigned to an entity. *
; ====================== Entity should then adopt the material assigned to it's layer if present.*
; (DettachMaterialByEntity (setq en (car (entsel "Select Object > ")))) *
;***************************************************************************************************
(defun DettachMaterialByEntity (en / elst)
(setq elst (entget en))
(if (assoc 347 elst)
(entmod (vl-remove (assoc 347 elst) elst))
nil
)
)
;***************************************************************************************************
; DETTACHMATERIALBYLAYER - function to detach any material assigned to the specified layer. *
; ====================== (DettachMaterialByLayer "TIN") *
;***************************************************************************************************
(defun DettachMaterialByLayer (lay / laylst)
(if (tblsearch "LAYER" lay)
(progn
(setq laylst (entget (tblobjname "LAYER" lay)))
(if (assoc 347 laylst)
(entmod (vl-remove (assoc 347 laylst) laylst))
nil
)
)
nil
)
)
