选择图元，则该图元所在的图层置为当前层
选择图中图元，则该图元所在的图层置为当前层;;----------------------
;;将所选实体层置为当前层
;;----------------------
(defun c:dqc (/ ent ent_data clay)
(setq ent (car (entsel (strcat "\n选择物体:"))))
(if (/= nil ent)
(progn
(setq ent_data (entget ent))
(setq clay (cdr (assoc 8 ent_data)))
(setvar "clayer" clay)
(setvar "Cecolor" "ByLayer")
(prompt (strcat "\n成功将图层设为<" clay ">："))
)
)
(princ)
)
楼主求了这么多程序。。。。这些都没学会？？ CAD08版上自带的命令:ai_molc (setvar "clayer" (cdr (assoc 8(entget (car (entsel)))))) adou(读第三声） 我是为了5个明经币来的，现学现卖(defun c:ccc ()
(command "_.undo" "be")
(if (setq e (car (entsel "\n选择需要置为当前层的对象:")))
(progn
(setq obj (vlax-ename->vla-object e))
(setq layer (vlax-get-property obj 'Layer))
(vla-put-ActiveLayer
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(vla-item (vla-get-layers doc) layer)
)
)
)
(command "_.undo" "e")
(princ)
) ;; 命 令 功 能
;; nn 将所选图元图层至为当前层
;; ad 只显示所选图元且仅只有一个，其余冻结
;; fa 将当前文档所有冻结图层打开
;; qw 选择不要冻结的图元，可多选
;; mm 将所选图元，移动到指定图元图层
;; cf 将所选图元，复制到指定图元图层
;;**********************************************************************
(vl-load-com)
(Defun *Collection* ()
(setq *AcadObject* (vlax-get-acad-object)
*DwgObject*(vla-get-activedocument *AcadObject*)
*ModelSpace* (vla-get-modelspace *DwgObject*)
*Layers* (vla-get-layers *DwgObject*)
*Blocks* (vla-get-blocks *DwgObject*)
*LineTypes*(vla-get-linetypes *DwgObject*)
)
)
(if(not(tblsearch "ltype" "CENTER"));;中心线加载
(progn
(*Collection*)
(vlax-invoke-method *LineTypes* 'Load"CENTER" "acadiso.lin")
)
)
(if(not(tblsearch "ltype" "DASHED"));;虚线加载
(progn
(*Collection*)
(vlax-invoke-method *LineTypes* 'Load"DASHED" "acadiso.lin")
)
)
;;将所选图元图层至为当前层**********************************************
(defun c:nn (/ EntityName VlaName CurrentlyLayer Layer *Layers* *DwgObject* *Blocks* *ModelSpace* *AcadObject* *LineTypes*)
(*Collection*)
(if (setq EntityName (Car (Entsel "\n请选择要置为当前层的图元:")))
(progn
(setq VlaName (vlax-ename->vla-object EntityName)
CurrentlyLayer (vla-get-Layer VlaName)
)
(Vlax-For Layer *Layers*
(IF (= (Vla-Get-Name Layer) CurrentlyLayer)
(vla-put-ActiveLayer *DwgObject* Layer)
)
)
)
)
(prin1)
)
;;只显示所选图元且仅只有一个，其余冻结*************************************
(Defun c:ad (/ EntityName VlaName CurrentlyLayer Layer *Layers* *DwgObject* *Blocks* *ModelSpace* *AcadObject* *LineTypes*)
(*Collection*)
(if (setq EntityName (Car (Entsel "\n选择不冻结的图元<仅一个>:")))
(progn
(setq VlaName (vlax-ename->vla-object EntityName)
CurrentlyLayer (vla-get-Layer VlaName)
)
(VLAX-FOR Layer *Layers*
(if (= (vla-get-name Layer) CurrentlyLayer)
(vla-put-ActiveLayer *DwgObject* Layer)
)
)
(VLAX-FOR Layer *Layers*
(if (/= (vla-get-name Layer) CurrentlyLayer)
(vla-put-Freeze Layer -1)
)
)
)
)
(prin1)
)
;;将当前文档所有冻结图层打开**********************************************
(Defun c:fa (/ Layer *Layers* *DwgObject* *Blocks* *ModelSpace* *AcadObject* *LineTypes*)
(*Collection*)
(VLAX-FOR Layer *Layers*
(if (/= (vla-get-Freeze Layer) :vlax-false)
(progn
(vla-put-Freeze Layer 0)
(vla-put-LayerOn Layer -1)
(vla-put-lock Layer 0)
)
)
)
(vlax-invoke-method *DwgObject* 'regen acactiveviewport)
(prin1)
)
;;选择不要冻结的图元，可多选*********************************************
(Defun c:qw(/*Layers* *DwgObject* *Blocks* *ModelSpace* *AcadObject*
selectcollection VlaObjectList index LayerNameList Layer VlaObject)
(*Collection*)
(if (setq selectcollection (ssget))
(progn
(setq index 0 VlaObjectList nil LayerNameList nil)
(repeat (sslength selectcollection)
(setq VlaObjectList
(append VlaObjectList
(list(vlax-ename->vla-object (ssname selectcollection index))))
)
(setq index (1+ index))
)
(foreach VlaObjectVlaObjectList
(setq LayerNameList(append LayerNameList(list (vla-get-layer VlaObject))))
)
(VLAX-FOR Layer*Layers*
(if
(not (= (vla-get-name layer)(vla-get-name (vla-get-activelayer *DwgObject*))))
(if (= (vla-get-name layer) (nth 0 LayerNameList))
(vla-put-activelayer *DwgObject* Layer))
)
)
(VLAX-FOR Layer*Layers*
(if (not (vl-position(vla-get-name Layer)LayerNameList))
(vla-put-freeze Layer -1)
) ;endif
)
) ;end progn
);endif
(prin1)
)
;;将所选图元，移动到指定图元图层
(Defun c:mm(/*Layers* *DwgObject* *Blocks* *ModelSpace* *AcadObject* *LineTypes*
EntityCollection TargetObject index VlaObjectList TargetVlaObject
TargetLayerName VlaObject)
(*Collection*)
(if(setq EntityCollection(ssget))
(if(setq TargetObject(car(entsel "\n 选择目标图层的图元:")));Target 目标
(progn
(setq index 0 VlaObjectList nil)
(repeat (sslength EntityCollection)
(setq VlaObjectList(append VlaObjectList(list(vlax-ename->vla-object(ssname EntityCollection index)))))
(setq index(1+ index))
)
(setq TargetVlaObject(vlax-ename->vla-object TargetObject))
(setq TargetLayerName(vla-get-layer TargetVlaObject))
(foreach VlaObject VlaObjectList
(vla-put-layer VlaObject TargetLayerName)
)
)
)
)
(prin1)
)
;;将所选图元，复制到指定图元图层
(Defun c:cf(/ EntityCollection TargetObject index VlaObjectList TargetVlaObject TargetLayerName VlaObject)
(if(setq EntityCollection(ssget))
(if(setq TargetObject(car(entsel "\n指定复制图元的目标图层:")))
(progn
(setq index 0 VlaObjectList nil)
(repeat (sslength EntityCollection)
(setq VlaObjectList(append VlaObjectList(list(vlax-ename->vla-object(ssname EntityCollection index)))))
(setq index(1+ index))
)
(setq TargetVlaObject(vlax-ename->vla-object TargetObject))
(setq TargetLayerName(vla-get-layer TargetVlaObject))
(foreach VlaObject VlaObjectList
(vla-put-layer (vlax-invoke-method VlaObject 'Copy) TargetLayerName)
)
)
)
)
(prin1)
)
页:
[1]