本帖最后由 gaics 于 2020-8-6 09:21 编辑
- (defun c:tt (/ ss i ii ent namelist blkent obj atts att) (vl-load-com)
- (setq ss (ssget))
- (setq i 0)
- (while (< i (sslength ss))
- (setq ent (ssname ss i))
- (changelayer ent)
- (if (= (cdr (assoc 0 (entget ent))) "INSERT")
- (progn (setq obj (vlax-ename->vla-object ent))
- (setq ii 0)
- (if (vla-Get-HasAttributes obj)
- (progn (setq atts (vlax-invoke obj 'getattributes))
- (repeat (length atts)
- (setq att (vlax-vla-object->ename (nth ii atts)))
- (changelayer att)
- (setq ii (1+ ii))
- )
- )
- )
- (setq namelist (delsame (ayGetAllEntInBLK ent)))
- (setq ii 0)
- (repeat (length namelist)
- (setq blkent (nth ii namelist))
- (changelayer blkent)
- (setq ii (1+ ii))
- )
- (entupd ent)
- )
- )
- (setq i (1+ i))
- )
- (princ)
- )
- (defun ayGetAllEntInBLK(BlkEntName / xBlkName xBlkDef entName1 entType entNameList)
- (setq xBlkName (cdr (assoc 2 (entget BlkEntName))))
- (setq xBlkDef (tblobjname "Block" xBlkName))
- (while (setq entName1 (entnext xBlkDef))
- (setq entType (cdr (assoc 0 (entget entName1))))
- (if (= entType "INSERT")
- (progn
- (setq entNameList (cons entName1 entNameList))
- (setq entNameList
- (append (ayGetAllEntInBLK entName1) entNameList)
- )
- )
- (setq entNameList (cons entName1 entNameList))
- )
- (setq xBlkDef entName1)
- )
- entNameList
- )
- (defun delsame (l)
- (if l
- (cons (car l)
- (delsame (vl-remove (car l) (cdr l)))
- )
- )
- )
- (defun changelayer (ent / obj ly co lt)
- (setq obj (vlax-ename->vla-object ent))
- (setq ly (vla-get-layer obj))
- (setq co (vla-get-color obj))
- (setq lt (vla-get-linetype obj))
- (vla-put-layer obj "0")
- (if (= co 256)
- (progn
- (setq co (cdr (assoc 62 (tblsearch "layer" ly))))
- (vla-put-color obj co)
- )
- )
- (if (= lt "ByLayer")
- (progn
- (setq lt (cdr (assoc 6 (tblsearch "layer" ly))))
- (vla-put-linetype obj lt)
- )
- )
- )
|