OpenDcl 做的一个非模态-图层控制对话框应用实例

牢固 · 发表于 2013-4-20 23:17:33

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 newer 于 2017-6-24 12:40 编辑

这是OpenDcl做的一个非模态图层控制对话框应用实例！先看演示：
图层工具3.gif

它展示了OpenDcl以下几方面的应用技巧：
1、非模态对话框的自动隐藏和打开
2、图形命令控件的事件响应
3、ListView控件的使用方法
4、提供一个OpenDclVlx.VLX程序，使得你在发布OpenDcl对话框应用程序时，不必顾及用户的系统是否安装了OpenDcl插件，该程序会自动安装AutoCAD相应版本的OpenDcl插件，用户只需将OpenDclVlx.VLX放置在CAD支持目录，并在你的程序里添加如下代码加载之：

(if (findfile "OpenDclVlx.VLX")
(load (findfile "OpenDclVlx.VLX")
"加载OpenDclVlx.VLX失败！"
)
(prompt "系统找不到 OpenDclVlx.VLX文件！"
)
)

然后用如下语句加载OpenDcl:

(gxl-AutoLoadODclArx)

加载OpenDcl对话框用如下函数加载:

;;(gxl-Load_ODCL_Project projname reload password alias)
;;功能：加载OpenDcl工程
;;参数：projname = 工程名称字串(后缀为"*.odcl"、"*.odcl.lsp"或不带后缀)或者OpenDcl工程数据表
;; reload = T 强制重载工程 or nil 若已加载，则什么也不干
;; password = 设定密码字串 or nil
;; alias = 替代项目关键字 or nil
;;例如: (gxl-Load_ODCL_Project "LayerOdcl" nil nil nil)

OpenDclVlx.VLX 文件下载

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:OpenDclVlx.part01.rar
下载次数:457 文件大小:999 KB
下载权限: 学生以上 [免费赚D豆]

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:OpenDclVlx.part02.rar
下载次数:492 文件大小:999 KB
下载权限: 学生以上 [免费赚D豆]

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:OpenDclVlx.part03.rar
下载次数:457 文件大小:999 KB
下载权限: 学生以上 [免费赚D豆]

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:OpenDclVlx.part04.rar
下载次数:477 文件大小:974.88 KB
下载权限: 学生以上 [免费赚D豆]

图层控制源码下载:

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:LayerOdcl.lsp
下载次数:365 文件大小:36.27 KB
下载权限: 学生以上 [免费赚D豆]

对话框控制代码：

;;(gxl-AutoLoadODclArx) 自动加载OpenDcl函数
;; By Gu_xl
(if (findfile "OpenDclVlx.VLX")
(load (findfile "OpenDclVlx.VLX")
"加载OpenDclVlx.VLX失败！"
)
(prompt "系统找不到 OpenDclVlx.VLX文件！"
)
)
;;图层工具非模态对话框主程序加载
(defun c:tcc ()
;;自动加载OpenDcl Arx插件
(gxl-AutoLoadODclArx)
;;(gxl-Load_ODCL_Project projname reload password alias)
;;功能：加载OpenDcl工程
;;参数：projname = 工程名称字串(后缀为"*.odcl"、"*.odcl.lsp"或不带后缀)或者OpenDcl工程数据表
;; reload = T 强制重载工程 or nil 若已加载，则什么也不干
;; password = 设定密码字串 or nil
;; alias = 替代项目关键字 or nil
;; By Gu_xl
;(gxl-Load_ODCL_Project "LayerOdcl" nil nil nil) ;_ ODCL文件加载方式
(gxl-Load_ODCL_Project LayerOdcl nil nil nil) ;_ ODCL数据表加载方式
(setq *bLayerOdclFlag t)
(dcl_Form_Show LayerOdcl_Form1)
(if (not (dcl_Form_IsActive LayerOdcl_Form1))
(progn
(dcl_form_show LayerOdcl_Form1)
)
)
(princ)
)
;;初始化对话框
(defun c:LayerOdcl_Form1_OnInitialize (/ POS COL0WIDTH
COL1WIDTH COL2WIDTH
COL3WIDTH LAYERS
)
(setq pos (getenv "图层工具\\对话框初始位置"))
(if pos
(setq pos (read pos)
*LayerOdclFormX (car pos)
*LayerOdclFormY (cadr pos)
)
(setq *LayerOdclFormX 100
*LayerOdclFormY 5
)
)
;;保存对话框位置
(setenv "图层工具\\对话框初始位置"
(strcat "(" (itoa *LayerOdclFormX) " " (itoa *LayerOdclFormY) ")")
)
;;设置对话框位置
(dcl_Control_SetPos LayerOdcl_Form1 *LayerOdclFormX *LayerOdclFormY 70 25)
;;填充对话框
(LayerOdcl_ListViewFill)
(princ)
)
;;填充 ListView 的图层状态函数
(defun LayerOdcl_ListViewFill (/ COL0WIDTH COL1WIDTH COL2WIDTH COL3WIDTH
LAYERS)
(dcl_ListView_Clear LayerOdcl_Form1_ListView1)
;;填充ListView 图层列表
;; calculate the required column widths
(setq Col0Width (dcl_ListView_CalcColWidth
LayerOdcl_Form1_ListView1
"图层名称 "
)
Col1Width (dcl_ListView_CalcColWidth
LayerOdcl_Form1_ListView1
"开 "
)
Col2Width (dcl_ListView_CalcColWidth
LayerOdcl_Form1_ListView1
"冻结 "
)
Col3Width (dcl_ListView_CalcColWidth
LayerOdcl_Form1_ListView1
"锁 "
)
)
;; add columns of the calculated widths
(if (< (dcl_ListView_GetColumnCount LayerOdcl_Form1_ListView1) 4)
(dcl_ListView_AddColumns
LayerOdcl_Form1_ListView1
(list (list "图层名称" 0 Col0Width)
(list "开 " 1 Col1Width)
(list "冻结" 1 Col2Width)
(list "锁 " 1 Col3Width)
)
)
)
(vlax-for la (vla-get-layers
(vla-get-ActiveDocument (vlax-get-acad-object))
)
(setq layers
(cons
(list (vla-get-name la) ;_ 图层名称
""
(if (= (vla-get-layeron la) :vlax-true)
0 ;_ 开
1 ;_ 关
) ;_ 图层开关状态
""
(if (= (vla-get-Freeze la) :vlax-true)
3 ;_ 冻结
2 ;_ 解冻
) ;_ 图层冻结状态
""
(if (= (vla-get-lock la) :vlax-true)
5 ;_ 锁定
4 ;_ 解锁
) ;_ 图层锁定状态
)
layers
)
)
)
(setq *LayerOdclState ;_ 保存图层状态
(vl-sort layers
'(lambda (a b)
(< (car a) (car b))
)
)
)
;;填充ListView
(dcl_ListView_FillList LayerOdcl_Form1_ListView1 *LayerOdclState)
)
;;多文档切换，重新填充ListView
(defun c:LayerOdcl_Form1_OnDocActivated (/ )
(LayerOdcl_ListViewFill)
)
;;窗口移动记录窗口位置
(defun c:LayerOdcl_Form1_OnMove (NewX NewY / pos)
(if (not *bLayerOdclFlag)
(progn
(setq pos (dcl_Control_GetPos LayerOdcl_Form1))
(setq *LayerOdclFormX (car pos)
*LayerOdclFormY (cadr pos))
(setenv "图层工具\\对话框初始位置"
(strcat "(" (itoa *LayerOdclFormX) " " (itoa *LayerOdclFormY) ")"))
(princ)
)
(setq *bLayerOdclFlag nil)
)
)
;;关闭窗口
(defun c:LayerOdcl_Form1_TextButton1_OnClicked (/)
(dcl_Form_close LayerOdcl_Form1)
;;释放变量内存
(foreach a '(*LayerOdclFormX *LayerOdclFormY *LayerOdclState *bLayerOdclFlag)
(set a nil)
)
)
;;鼠标移入窗口,展开对话框
(defun c:LayerOdcl_Form1_OnMouseEntered (/)
(vl-bb-set '*LayerOdclFormExtend* t)
(LayerOdcl_ListViewFill)
(if (null *LayerOdclFormX)
(progn
(setq pos (getenv "图层工具\\对话框初始位置"))
(if pos
(setq pos (read pos)
*LayerOdclFormX
(car pos)
*LayerOdclFormY
(cadr pos)
)
(setq *LayerOdclFormX 100
*LayerOdclFormY 5
)
)
)
)
(dcl_Control_SetPos
LayerOdcl_Form1 *LayerOdclFormX *LayerOdclFormY 512 240)
(princ)
)
;;自动隐藏对话框函数
(defun c:AutoHideLayerOdclForm (/ scr)
(if (not (vl-bb-ref '*LayerOdclFormExtend*))
(progn
;(setq scr (dcl_getscreensize))
(dcl_Control_SetPos LayerOdcl_Form1 *LayerOdclFormX *LayerOdclFormY 70 25)
)
)
(princ)
)
;;立即隐藏对话框函数
(defun c:HideLayerOdclForm ()
(vl-bb-set '*LayerOdclFormExtend* nil)
(dcl_Control_SetPos LayerOdcl_Form1 *LayerOdclFormX *LayerOdclFormY 70 25)
)
;;鼠标离开对话框，则800毫秒后隐藏对话框
(defun c:LayerOdcl_Form1_OnMouseMovedOff (/ )
(vl-bb-set '*LayerOdclFormExtend* nil)
(dcl_delayedinvoke 800 "c:AutoHideLayerOdclForm") ;_ 延迟800毫秒隐藏对话框
(princ)
)
;;**************以下是对话框个命令按钮事件代码*******************************
;;关闭选择层
(defun c:LayerOdcl_Form1_GraphicButton1_OnClicked (/ e a)
(c:HideLayerOdclForm) ;_ 隐藏对话框
(while
(progn
(setvar "ErrNo" 0)
(setq a "\n")
(while (and (null
(setq e (entsel (strcat a "选择要关闭图层的对象:")))
)
(= 7 (getvar "ErrNo"))
)
(setq a "")
(princ "\n**未选中任何对象**请重新")
)
e
)
(vla-put-layeron
(vla-item (vla-get-layers
(vla-get-ActiveDocument (vlax-get-acad-object))
)
(cdr (assoc 8 (entget (car e))))
)
:vlax-false
)
)
(princ)
)
;;关闭选择外图层
(defun c:LayerOdcl_Form1_GraphicButton2_OnClicked (/ ss n la layers objlayers)
(c:HideLayerOdclForm) ;_ 隐藏对话框
(if (setq ss (ssget))
(progn
(repeat (setq n (sslength ss))
(if (not (member (setq la
(cdr (assoc 8 (entget (ssname ss (setq n (1- n))))))
)
layers
)
)
(setq layers (cons la layers))
)
)
(setq
objlayers (vla-get-layers
(vla-get-ActiveDocument (vlax-get-acad-object))
)
)
(vlax-for a objlayers
(if (not (member (vla-get-name a) layers))
(vla-put-layeron a :vlax-false)
)
)
)
)
)
;;关闭当前外层
(defun c:LayerOdcl_Form1_GraphicButton3_OnClicked (/ cla)
(c:HideLayerOdclForm) ;_ 隐藏对话框
(setq cla (getvar 'clayer))
(vlax-for a (vla-get-layers
(vla-get-ActiveDocument (vlax-get-acad-object))
)
(if (/= cla (vla-get-name a))
(vla-put-layeron a :vlax-false)
(vla-put-layeron a :vlax-true)
)
)
)
;;显示所有层
(defun c:LayerOdcl_Form1_GraphicButton4_OnClicked (/)
(c:HideLayerOdclForm) ;_ 隐藏对话框
(vlax-for a (vla-get-layers
(vla-get-ActiveDocument (vlax-get-acad-object))
)
(vla-put-layeron a :vlax-true)
)
)
;;锁定选择层
(defun c:LayerOdcl_Form1_GraphicButton5_OnClicked (/ a e)
(c:HideLayerOdclForm) ;_ 隐藏对话框
(while
(progn
(setvar "ErrNo" 0)
(setq a "\n")
(while (and (null
(setq e (entsel (strcat a "选择要锁定图层的对象:")))
)
(= 7 (getvar "ErrNo"))
)
(setq a "")
(princ "\n**未选中任何对象**请重新")
)
e
)
(vla-put-lock
(vla-item (vla-get-layers
(vla-get-ActiveDocument (vlax-get-acad-object))
)
(cdr (assoc 8 (entget (car e))))
)
:vlax-true
)
)
)
;;锁定选择外图层
(defun c:LayerOdcl_Form1_GraphicButton6_OnClicked (/ SS N LA LAYERS OBJLAYERS)
(c:HideLayerOdclForm) ;_ 隐藏对话框
(if (setq ss (ssget))
(progn
(repeat (setq n (sslength ss))
(if (not (member (setq la
(cdr (assoc 8 (entget (ssname ss (setq n (1- n))))))
)
layers
)
)
(setq layers (cons la layers))
)
)
(setq
objlayers (vla-get-layers
(vla-get-ActiveDocument (vlax-get-acad-object))
)
)
(vlax-for a objlayers
(if (not (member (vla-get-name a) layers))
(vla-put-lock a :vlax-true)
)
)
)
)
)
;;锁定当前外图层
(defun c:LayerOdcl_Form1_GraphicButton7_OnClicked (/ cla)
(c:HideLayerOdclForm) ;_ 隐藏对话框
(setq cla (getvar 'clayer))
(vlax-for a (vla-get-layers
(vla-get-ActiveDocument (vlax-get-acad-object))
)
(if (/= cla (vla-get-name a))
(vla-put-lock a :vlax-true)
(vla-put-lock a :vlax-false)
)
)
)
;;解锁选择层
(defun c:LayerOdcl_Form1_GraphicButton8_OnClicked
(/ SS LAYERS N LA OBJLAYERS)
(c:HideLayerOdclForm) ;_ 隐藏对话框
(while (setq ss (ssget))
(setq layers nil)
(repeat (setq n (sslength ss))
(if (not (member (setq la
(cdr (assoc 8 (entget (ssname ss (setq n (1- n))))))
)
layers
)
)
(setq layers (cons la layers))
)
)
(setq
objlayers (vla-get-layers
(vla-get-ActiveDocument (vlax-get-acad-object))
)
)
(foreach a layers
(vla-put-lock (vla-item objlayers a) :vlax-false)
)
)
)
;;解锁全部图层
(defun c:LayerOdcl_Form1_GraphicButton9_OnClicked ()
(c:HideLayerOdclForm) ;_ 隐藏对话框
(vlax-for a (vla-get-layers
(vla-get-ActiveDocument (vlax-get-acad-object))
)
(vla-put-lock a :vlax-false)
)
)
;;冻结选择图层
(defun c:LayerOdcl_Form1_GraphicButton10_OnClicked (/ SS LAYERS N LA OBJLAYERS cla)
(c:HideLayerOdclForm) ;_ 隐藏对话框
(setq cla (getvar 'clayer))
(while (setq ss (ssget))
(setq layers nil)
(repeat (setq n (sslength ss))
(if (and
(not (member (setq la
(cdr (assoc 8 (entget (ssname ss (setq n (1- n))))))
)
layers
)
)
(/= cla la)
)
(setq layers (cons la layers))
)
)
(setq
objlayers (vla-get-layers
(vla-get-ActiveDocument (vlax-get-acad-object))
)
)
(foreach a layers
(vla-put-Freeze (vla-item objlayers a) :vlax-true)
)
)
)
;;冻结选择外图层
(defun c:LayerOdcl_Form1_GraphicButton11_OnClicked (/ SS LAYERS N LA OBJLAYERS cla)
(c:HideLayerOdclForm) ;_ 隐藏对话框
(setq cla (getvar 'clayer))
(while (setq ss (ssget))
(setq layers nil)
(repeat (setq n (sslength ss))
(if (not (member (setq la
(cdr (assoc 8 (entget (ssname ss (setq n (1- n))))))
)
layers
)
)
(setq layers (cons la layers))
)
)
(setq
objlayers (vla-get-layers
(vla-get-ActiveDocument (vlax-get-acad-object))
)
)
(setq layers (cons cla layers))
(vlax-for a objlayers
(if (not (member (vla-get-name a) layers))
(vla-put-Freeze a :vlax-true)
)
)
)
)
;;冻结当前外图层
(defun c:LayerOdcl_Form1_GraphicButton12_OnClicked (/ cla)
(c:HideLayerOdclForm) ;_ 隐藏对话框
(setq cla (getvar 'clayer))
(vlax-for a (vla-get-layers
(vla-get-ActiveDocument (vlax-get-acad-object))
)
(if (/= cla (vla-get-name a))
(vla-put-Freeze a :vlax-true)
)
)
)
;;显示解锁解冻所有
(defun c:LayerOdcl_Form1_GraphicButton13_OnClicked (/ cla doc)
(c:HideLayerOdclForm) ;_ 隐藏对话框
(setq cla (getvar 'clayer))
(vlax-for a
(vla-get-layers
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
)
(vla-put-layeron a :vlax-true)
(vla-put-lock a :vlax-false)
(if (/= cla (vla-get-name a))
(vla-put-Freeze a :vlax-false)
)
)
(vla-regen doc :vlax-true)
)
;;对象图层匹配
(defun c:LayerOdcl_Form1_GraphicButton14_OnClicked (/ execute s)
(defun execute (SS / E KD CLA N LA DOC)
(initget "Type")
(setq e (entsel "\n选择目标图层的对象或键入图层名称[Type-it]:"))
(cond
((null e)
(initget "Yes No")
(setq
kd (getkword "\n没有选择任何对象，使用当前层吗[Yes/No]<Yes>")
)
(if (= "No" kd)
(execute ss)
(progn
(setq cla (getvar 'clayer))
(sssetfirst nil ss)
;;改变图层，不能直接用Command命令
(dcl_sendstring (strcat (VL-PRIN1-TO-STRING (list 'command "chprop" "p" "" "la" cla "")) "\n"))
)
)
)
((= "Type" e)
(while
(= ""
(setq la (VL-STRING-TRIM " " (getstring "\n键入图层名称:")))
)
)
(if (VL-CATCH-ALL-ERROR-P
(VL-CATCH-ALL-APPLY
'vla-item
(list
(vla-get-layers
(setq doc (vla-get-ActiveDocument
(vlax-get-acad-object)
)
)
)
la
)
)
)
(progn
(initget "Yes No")
(setq kd
(getkword "\n输入图层不存在，要创建它吗?[Yes/No]<Yes>")
)
(if (= kd "No")
(execute ss)
(progn
(vla-add (vla-get-layers (vla-get-ActiveDocument (vlax-get-acad-object))) la)
(sssetfirst nil ss)
(dcl_sendstring (strcat (VL-PRIN1-TO-STRING (list 'command "chprop" "p" "" "la" la "")) "\n"))
)
)
)
(progn
(sssetfirst nil ss)
(dcl_sendstring (strcat (VL-PRIN1-TO-STRING (list 'command "chprop" "p" "" "la" la "")) "\n"))
)
)
)
(t
(setq e (car e))
(gxl-matchProp e ss)
)
)
(princ)
)
(c:HideLayerOdclForm) ;_ 隐藏对话框
(princ "\n选择要改变的对象:")
(setq s (ssget))
(execute s)
(princ)
)
;;移动对象至当前层
(defun c:LayerOdcl_Form1_GraphicButton15_OnClicked (/ ss la)
(c:HideLayerOdclForm) ;_ 隐藏对话框
(if (setq ss (ssget ":L"))
(progn
(setq la (getvar 'clayer))
(sssetfirst nil ss)
(dcl_sendstring (strcat (VL-PRIN1-TO-STRING (list 'command "chprop" "p" "" "la" la "")) "\n"))
)
)
(princ)
)
;;隔离对象所在图层
(defun c:LayerOdcl_Form1_GraphicButton16_OnClicked (/ ss n la a layers)
(c:HideLayerOdclForm) ;_ 隐藏对话框
(if (setq ss (ssget ":L"))
(progn
(repeat (setq n (sslength ss))
(if
(not
(member
(setq
a (cdr (assoc 8 (entget (ssname ss (setq n (1- n))))))
)
layers
)
)
(setq layers (cons a layers))
)
)
(vlax-for la (vla-get-layers
(vla-get-ActiveDocument (vlax-get-acad-object))
)
(if (not (member (vla-get-name la) layers))
(vla-put-lock la :vlax-true)
)
)
)
)
)
;;改层复制
(defun c:LayerOdcl_Form1_GraphicButton17_OnClicked (/ CopyObj)
(defun CopyObj (SS / E KD CLA ENDENT P1 P2 O LA DOC)
(initget "Type")
(setq e (entsel "\n选择目标图层的对象或键入图层名称[Type-it]:"))
(cond
((null e)
(initget "Yes No")
(setq
kd (getkword "\n没有选择任何对象，使用当前层吗[Yes/No]<Yes>")
)
(if (= "No" kd)
(CopyObj ss)
(progn
(setq cla (getvar 'clayer))
(setq p1 (getpoint "\n复制基点:"))
(cond
((null p1)
(sssetfirst nil ss)
(dcl_sendstring
(strcat (VL-PRIN1-TO-STRING
(list 'command "copy" "p" "" "@" "@")
)
"\n"
)
)
)
(p1
(setq p2 (getpoint p1 "\n复制位置点:"))
(setq ss (GXL-SEL-SS->VLA ss))
(if p2
(progn
(setq p1 (vlax-3d-point p1)
p2 (vlax-3d-point p2)
)
(foreach a ss
(setq o (vla-copy a))
(vla-move o p1 p2)
(vla-put-layer o cla)
)
)
(progn
(setq p1 (vlax-3d-point '(0 0 0))
p2 (vlax-3d-point '(0 0 0))
)
(foreach a ss
(setq o (vla-copy a))
(vla-move o p1 p2)
(vla-put-layer o cla)
)
)
)
)
)
)
)
)
((= "Type" e)
(while
(= ""
(setq la (VL-STRING-TRIM " " (getstring "\n键入图层名称:")))
)
)
(if (VL-CATCH-ALL-ERROR-P
(VL-CATCH-ALL-APPLY
'vla-item
(list
(vla-get-layers
(setq doc (vla-get-ActiveDocument
(vlax-get-acad-object)
)
)
)
la
)
)
)
(progn
(initget "Yes No")
(setq kd
(getkword "\n输入图层不存在，要创建它吗?[Yes/No]<Yes>")
)
(if (= kd "No")
(CopyObj ss)
(progn
(vla-add (vla-get-layers
(vla-get-ActiveDocument (vlax-get-acad-object))
)
la
)
(setq p1 (getpoint "\n复制基点:"))
(cond
((null p1)
(sssetfirst nil ss)
(dcl_sendstring
(strcat (VL-PRIN1-TO-STRING
(list 'command "copy" "p" "" "@" "@")
)
"\n"
)
)
)
(p1
(setq p2 (getpoint p1 "\n复制位置点:"))
(setq ss (GXL-SEL-SS->VLA ss))
(if p2
(progn
(setq p1 (vlax-3d-point p1)
p2 (vlax-3d-point p2)
)
(foreach a ss
(setq o (vla-copy a))
(vla-move o p1 p2)
(vla-put-layer o la)
)
)
(progn
(setq p1 (vlax-3d-point '(0 0 0))
p2 (vlax-3d-point '(0 0 0))
)
(foreach a ss
(setq o (vla-copy a))
(vla-move o p1 p2)
(vla-put-layer o la)
)
)
)
)
)
)
)
)
(progn
(setq p1 (getpoint "\n复制基点:"))
(cond
((null p1)
(sssetfirst nil ss)
(dcl_sendstring
(strcat (VL-PRIN1-TO-STRING
(list 'command "copy" "p" "" "@" "@")
)
"\n"
)
)
)
(p1
(setq p2 (getpoint p1 "\n复制位置点:"))
(setq ss (GXL-SEL-SS->VLA ss))
(if p2
(progn
(setq p1 (vlax-3d-point p1)
p2 (vlax-3d-point p2)
)
(foreach a ss
(setq o (vla-copy a))
(vla-move o p1 p2)
(vla-put-layer o la)
)
)
(progn
(setq p1 (vlax-3d-point '(0 0 0))
p2 (vlax-3d-point '(0 0 0))
)
(foreach a ss
(setq o (vla-copy a))
(vla-move o p1 p2)
(vla-put-layer o la)
)
)
)
)
)
)
)
)
(t
(setq la (cdr (assoc 8 (entget (car e)))))
(setq p1 (getpoint "\n复制基点:"))
(cond
((null p1)
(sssetfirst nil ss)
(dcl_sendstring
(strcat
(VL-PRIN1-TO-STRING (list 'command "copy" "p" "" "@" "@"))
"\n"
)
)
)
(p1
(setq p2 (getpoint p1 "\n复制位置点:"))
(setq ss (GXL-SEL-SS->VLA ss))
(if p2
(progn
(setq p1 (vlax-3d-point p1)
p2 (vlax-3d-point p2)
)
(foreach a ss
(setq o (vla-copy a))
(vla-move o p1 p2)
(vla-put-layer o la)
)
)
(progn
(setq p1 (vlax-3d-point '(0 0 0))
p2 (vlax-3d-point '(0 0 0))
)
(foreach a ss
(setq o (vla-copy a))
(vla-move o p1 p2)
(vla-put-layer o la)
)
)
)
)
)
)
)
(princ)
)
(c:HideLayerOdclForm) ;_ 隐藏对话框
(if (setq ss (ssget ":L"))
(CopyObj ss)
)
)
;;图层列表点击事件，响应修改图层状态
(defun c:LayerOdcl_Form1_ListView1_OnClicked
(Row Column / layers l la objlay selectitems)
(setq layers (vla-get-layers
(vla-get-ActiveDocument (vlax-get-acad-object))
)
)
(if (> Column 0)
(progn
(setq l (nth Row *LayerOdclState)
la (car l)
)
(cond ((= 1 Column) ;_ 点击开
(setq objlay (vla-item layers la))
(if (= :vlax-true (vla-get-layeron objlay))
(progn
(vla-put-layeron objlay :vlax-false)
(dcl_ListView_SetItemImage
LayerOdcl_Form1_ListView1
Row
Column
1
)
)
(progn
(vla-put-layeron objlay :vlax-true)
(dcl_ListView_SetItemImage
LayerOdcl_Form1_ListView1
Row
Column
0
)
)
)
)
((= 2 Column) ;_ 点冻结
(if (/= la (getvar 'clayer))
(progn
(setq objlay (vla-item layers la))
(if (= :vlax-true (vla-get-Freeze objlay))
(progn
(vla-put-Freeze objlay :vlax-false)
(dcl_ListView_SetItemImage
LayerOdcl_Form1_ListView1
Row
Column
2
)
)
(progn
(vla-put-Freeze objlay :vlax-true)
(dcl_ListView_SetItemImage
LayerOdcl_Form1_ListView1
Row
Column
3
)
)
)
)
)
)
((= 3 Column) ;_ 点锁定
(setq objlay (vla-item layers la))
(if (= :vlax-true (vla-get-lock objlay))
(progn
(vla-put-lock objlay :vlax-false)
(dcl_ListView_SetItemImage
LayerOdcl_Form1_ListView1
Row
Column
4
)
)
(progn
(vla-put-lock objlay :vlax-true)
(dcl_ListView_SetItemImage
LayerOdcl_Form1_ListView1
Row
Column
5
)
)
)
)
)
)
)
)
;;列表修改图层名称后的响应
(defun c:LayerOdcl_Form1_ListView1_OnEndLabelEdit (NewValue ItemIndex /)
(setq layers (vla-get-layers
(vla-get-ActiveDocument (vlax-get-acad-object))
)
l (nth ItemIndex *LayerOdclState)
la (car l)
)
(setq *LayerOdclState (subst (cons NewValue (cdr l)) l *LayerOdclState))
(vla-put-name (vla-item layers la) NewValue)
)
;;点击标题
(defun c:LayerOdcl_Form1_ListView1_OnColumnClick (Column / layers state state icon Row cla)
(cond
((= 1 Column) ;_ 图层开关列
(if (= :vlax-true
(vla-get-layeron
(vla-item (setq layers
(vla-get-layers
(vla-get-ActiveDocument (vlax-get-acad-object))
)
)
(caar *LayerOdclState)
)
)
)
(setq state :vlax-false
icon 1
)
(setq state :vlax-true
icon 0
)
)
(setq Row 0)
(setq *LayerOdclState
(mapcar
(function
(lambda (x)
(vla-put-layeron (vla-item layers (car x)) state) ;_ 修改图层状态
(dcl_ListView_SetItemImage
LayerOdcl_Form1_ListView1
Row
Column
icon
) ;_ 修改状态图标
(setq Row (1+ Row)) ;_ 步进
(append (list (car x) "" icon) (cdddr x)) ;_ 更新 *LayerOdclState
)
)
*LayerOdclState
)
)
)
((= 2 Column) ;_ 图层冻结列
(if (= :vlax-true
(vla-get-Freeze
(vla-item (setq layers
(vla-get-layers
(vla-get-ActiveDocument (vlax-get-acad-object))
)
)
(caar *LayerOdclState)
)
)
)
(setq state :vlax-false
icon 2
)
(setq state :vlax-true
icon 3
)
)
(setq Row 0
cla (getvar 'clayer)
)
(setq *LayerOdclState
(mapcar
(function
(lambda (x)
(if (/= cla (car x))
(progn
(vla-put-Freeze (vla-item layers (car x)) state) ;_ 修改图层状态
(dcl_ListView_SetItemImage
LayerOdcl_Form1_ListView1
Row
Column
icon
) ;_ 修改状态图标
(setq Row (1+ Row)) ;_ 步进
(list (nth 0 x)
(nth 1 x)
(nth 2 x)
(nth 3 x)
icon
(nth 5 x)
(nth 6 x)
) ;_ 更新 *LayerOdclState
)
x
)
)
)
*LayerOdclState
)
)
)
((= 3 Column) ;_ 图层锁定列
(if (= :vlax-true
(vla-get-lock
(vla-item (setq layers
(vla-get-layers
(vla-get-ActiveDocument (vlax-get-acad-object))
)
)
(caar *LayerOdclState)
)
)
)
(setq state :vlax-false
icon 4
)
(setq state :vlax-true
icon 5
)
)
(setq Row 0)
(setq *LayerOdclState
(mapcar
(function
(lambda (x)
(vla-put-lock (vla-item layers (car x)) state) ;_ 修改图层状态
(dcl_ListView_SetItemImage
LayerOdcl_Form1_ListView1
Row
Column
icon
) ;_ 修改状态图标
(setq Row (1+ Row)) ;_ 步进
(list (nth 0 x) (nth 1 x) (nth 2 x)
(nth 3 x) (nth 4 x) (nth 5 x) icon) ;_ 更新 *LayerOdclState
)
)
*LayerOdclState
)
)
)
)
)

;;(gxl-AutoLoadODclArx) 自动加载OpenDcl函数 
;; By Gu_xl 
(if (findfile "OpenDclVlx.VLX") 
  (load        (findfile "OpenDclVlx.VLX") 
        "加载OpenDclVlx.VLX失败！" 
  ) 
  (prompt "系统找不到 OpenDclVlx.VLX文件！" 
  ) 
) 
;;图层工具非模态对话框主程序加载    
(defun c:tcc  () 
  ;;自动加载OpenDcl Arx插件 
  (gxl-AutoLoadODclArx) 
  ;;(gxl-Load_ODCL_Project projname reload password alias) 
  ;;功能：加载OpenDcl工程 
  ;;参数：projname = 工程名称字串(后缀为"*.odcl"、"*.odcl.lsp"或不带后缀)或者OpenDcl工程数据表 
  ;;      reload =  T 强制重载工程 or nil 若已加载，则什么也不干 
  ;;      password = 设定密码字串 or nil 
  ;;      alias = 替代项目关键字 or nil 
  ;; By Gu_xl 
  ;(gxl-Load_ODCL_Project "LayerOdcl" nil nil nil) ;_ ODCL文件加载方式 
  (gxl-Load_ODCL_Project LayerOdcl nil nil nil) ;_ ODCL数据表加载方式 
  (setq *bLayerOdclFlag t) 
  (dcl_Form_Show LayerOdcl_Form1) 
  (if (not (dcl_Form_IsActive LayerOdcl_Form1)) 
    (progn 
      (dcl_form_show LayerOdcl_Form1) 
       
      ) 
    ) 
  (princ) 
   
  ) 
;;初始化对话框 
(defun c:LayerOdcl_Form1_OnInitialize (/ POS          COL0WIDTH 
                                         COL1WIDTH    COL2WIDTH 
                                         COL3WIDTH    LAYERS 
                                         ) 
  (setq pos (getenv "图层工具\\对话框初始位置")) 
  (if pos 
    (setq pos    (read pos) 
          *LayerOdclFormX (car pos) 
          *LayerOdclFormY (cadr pos) 
          ) 
    (setq *LayerOdclFormX 100 
          *LayerOdclFormY 5 
          ) 
    ) 
  ;;保存对话框位置 
  (setenv "图层工具\\对话框初始位置" 
          (strcat "(" (itoa *LayerOdclFormX) " " (itoa *LayerOdclFormY) ")") 
          ) 
  ;;设置对话框位置 
  (dcl_Control_SetPos LayerOdcl_Form1 *LayerOdclFormX *LayerOdclFormY 70 25) 
  ;;填充对话框 
  (LayerOdcl_ListViewFill) 
  (princ) 
 
  ) 
;;填充 ListView 的图层状态 函数 
(defun LayerOdcl_ListViewFill (/ COL0WIDTH COL1WIDTH COL2WIDTH COL3WIDTH 
                                 LAYERS) 
  (dcl_ListView_Clear LayerOdcl_Form1_ListView1) 
  ;;填充ListView 图层列表 
  ;; calculate the required column widths 
  (setq Col0Width (dcl_ListView_CalcColWidth 
                    LayerOdcl_Form1_ListView1 
                    "图 层 名 称     " 
                    ) 
        Col1Width (dcl_ListView_CalcColWidth 
                    LayerOdcl_Form1_ListView1 
                    "开       " 
                    ) 
        Col2Width (dcl_ListView_CalcColWidth 
                    LayerOdcl_Form1_ListView1 
                    "冻结     " 
                    ) 
        Col3Width (dcl_ListView_CalcColWidth 
                    LayerOdcl_Form1_ListView1 
                    "锁       " 
                    ) 
        ) 
  ;; add columns of the calculated widths 
  (if (< (dcl_ListView_GetColumnCount LayerOdcl_Form1_ListView1) 4) 
  (dcl_ListView_AddColumns 
    LayerOdcl_Form1_ListView1 
    (list (list "图 层 名 称" 0 Col0Width) 
          (list "开  " 1 Col1Width) 
          (list "冻结" 1 Col2Width) 
          (list "锁  " 1 Col3Width) 
          ) 
    ) 
    ) 
  (vlax-for la (vla-get-layers 
                 (vla-get-ActiveDocument (vlax-get-acad-object)) 
                 ) 
    (setq layers 
           (cons 
             (list (vla-get-name la) ;_ 图层名称 
                   "" 
                   (if (= (vla-get-layeron la) :vlax-true) 
                     0 ;_ 开 
                     1 ;_ 关 
                     ) ;_ 图层开关状态 
                   "" 
                   (if (= (vla-get-Freeze la) :vlax-true) 
                     3 ;_ 冻结 
                     2 ;_ 解冻 
                     ) ;_ 图层冻结状态 
                   "" 
                   (if (= (vla-get-lock la) :vlax-true) 
                     5 ;_ 锁定 
                     4 ;_ 解锁 
                     ) ;_ 图层锁定状态 
                   ) 
             layers 
             ) 
          ) 
    ) 
  (setq *LayerOdclState ;_ 保存图层状态 
         (vl-sort layers 
                  '(lambda (a b) 
                     (< (car a) (car b)) 
                     ) 
                  ) 
        ) 
  ;;填充ListView 
  (dcl_ListView_FillList LayerOdcl_Form1_ListView1 *LayerOdclState) 
  ) 
;;多文档切换，重新填充ListView 
(defun c:LayerOdcl_Form1_OnDocActivated (/ ) 
  (LayerOdcl_ListViewFill) 
) 
 
;;窗口移动记录窗口位置 
(defun c:LayerOdcl_Form1_OnMove (NewX NewY / pos) 
  (if (not *bLayerOdclFlag) 
    (progn 
      (setq pos (dcl_Control_GetPos LayerOdcl_Form1)) 
      (setq *LayerOdclFormX (car pos) 
            *LayerOdclFormY (cadr pos)) 
      (setenv "图层工具\\对话框初始位置" 
              (strcat "(" (itoa *LayerOdclFormX) " " (itoa *LayerOdclFormY) ")")) 
      (princ) 
      ) 
    (setq *bLayerOdclFlag nil) 
    ) 
   
) 
 
;;关闭窗口 
(defun c:LayerOdcl_Form1_TextButton1_OnClicked (/) 
  (dcl_Form_close LayerOdcl_Form1) 
  ;;释放变量内存 
  (foreach a '(*LayerOdclFormX *LayerOdclFormY *LayerOdclState *bLayerOdclFlag) 
    (set a nil) 
    ) 
) 
 
;;鼠标移入窗口,展开对话框 
(defun c:LayerOdcl_Form1_OnMouseEntered        (/) 
  (vl-bb-set '*LayerOdclFormExtend* t) 
  (LayerOdcl_ListViewFill) 
  (if (null *LayerOdclFormX) 
    (progn 
      (setq pos (getenv "图层工具\\对话框初始位置")) 
      (if pos 
        (setq pos (read pos) 
              *LayerOdclFormX 
               (car pos) 
              *LayerOdclFormY 
               (cadr pos) 
        ) 
        (setq *LayerOdclFormX 100 
              *LayerOdclFormY 5 
        ) 
      ) 
    ) 
  ) 
  (dcl_Control_SetPos 
    LayerOdcl_Form1 *LayerOdclFormX *LayerOdclFormY 512        240) 
  (princ) 
) 
;;自动隐藏对话框函数 
(defun c:AutoHideLayerOdclForm (/ scr) 
  (if (not (vl-bb-ref '*LayerOdclFormExtend*)) 
    (progn 
      ;(setq scr (dcl_getscreensize)) 
      (dcl_Control_SetPos LayerOdcl_Form1 *LayerOdclFormX *LayerOdclFormY 70 25) 
      ) 
    ) 
  (princ) 
  ) 
;;立即隐藏对话框函数 
(defun c:HideLayerOdclForm () 
  (vl-bb-set '*LayerOdclFormExtend* nil) 
  (dcl_Control_SetPos LayerOdcl_Form1 *LayerOdclFormX *LayerOdclFormY 70 25) 
  ) 
;;鼠标离开对话框，则800毫秒后隐藏对话框 
(defun c:LayerOdcl_Form1_OnMouseMovedOff (/ ) 
  (vl-bb-set '*LayerOdclFormExtend* nil) 
  (dcl_delayedinvoke 800 "c:AutoHideLayerOdclForm") ;_ 延迟800毫秒隐藏对话框 
  (princ) 
) 
;;**************以下是对话框个命令按钮事件代码******************************* 
;;关闭选择层 
(defun c:LayerOdcl_Form1_GraphicButton1_OnClicked (/ e a) 
  (c:HideLayerOdclForm) ;_ 隐藏对话框 
  (while 
    (progn 
      (setvar "ErrNo" 0) 
      (setq a "\n") 
      (while (and (null 
                    (setq e (entsel (strcat a "选择要关闭图层的对象:"))) 
                    ) 
                  (= 7 (getvar "ErrNo")) 
                  ) 
        (setq a "") 
        (princ "\n**未选中任何对象**请重新") 
       ) 
      e 
      ) 
     (vla-put-layeron 
       (vla-item (vla-get-layers 
                   (vla-get-ActiveDocument (vlax-get-acad-object)) 
                   ) 
                 (cdr (assoc 8 (entget (car e)))) 
                 ) 
       :vlax-false 
       ) 
     ) 
 
  (princ) 
  ) 
 
;;关闭选择外图层 
(defun c:LayerOdcl_Form1_GraphicButton2_OnClicked (/ ss n la layers objlayers) 
  (c:HideLayerOdclForm) ;_ 隐藏对话框 
  (if (setq ss (ssget)) 
    (progn 
      (repeat (setq n (sslength ss)) 
        (if (not (member (setq la 
                                (cdr (assoc 8 (entget (ssname ss (setq n (1- n)))))) 
                               ) 
                         layers 
                         ) 
                 ) 
          (setq layers (cons la layers)) 
          ) 
        ) 
      (setq 
        objlayers (vla-get-layers 
                    (vla-get-ActiveDocument (vlax-get-acad-object)) 
                    ) 
        ) 
      (vlax-for a objlayers 
        (if (not (member (vla-get-name a) layers)) 
          (vla-put-layeron a :vlax-false) 
          ) 
        ) 
      ) 
    ) 
  ) 
;;关闭当前外层 
(defun c:LayerOdcl_Form1_GraphicButton3_OnClicked (/ cla) 
  (c:HideLayerOdclForm) ;_ 隐藏对话框 
  (setq cla (getvar 'clayer)) 
  (vlax-for a (vla-get-layers 
                    (vla-get-ActiveDocument (vlax-get-acad-object)) 
                    ) 
    (if (/= cla (vla-get-name a)) 
      (vla-put-layeron a :vlax-false) 
      (vla-put-layeron a :vlax-true) 
      ) 
    ) 
) 
 
;;显示所有层 
(defun c:LayerOdcl_Form1_GraphicButton4_OnClicked (/) 
  (c:HideLayerOdclForm) ;_ 隐藏对话框 
  (vlax-for a (vla-get-layers 
                    (vla-get-ActiveDocument (vlax-get-acad-object)) 
                    ) 
    (vla-put-layeron a :vlax-true) 
    ) 
) 
 
;;锁定选择层 
(defun c:LayerOdcl_Form1_GraphicButton5_OnClicked (/ a e) 
    (c:HideLayerOdclForm) ;_ 隐藏对话框 
  (while 
    (progn 
      (setvar "ErrNo" 0) 
      (setq a "\n") 
      (while (and (null 
                    (setq e (entsel (strcat a "选择要锁定图层的对象:"))) 
                    ) 
                  (= 7 (getvar "ErrNo")) 
                  ) 
        (setq a "") 
        (princ "\n**未选中任何对象**请重新") 
       ) 
      e 
      ) 
     (vla-put-lock 
       (vla-item (vla-get-layers 
                   (vla-get-ActiveDocument (vlax-get-acad-object)) 
                   ) 
                 (cdr (assoc 8 (entget (car e)))) 
                 ) 
       :vlax-true 
       ) 
     ) 
 
) 
 
;;锁定选择外图层 
(defun c:LayerOdcl_Form1_GraphicButton6_OnClicked (/ SS N LA LAYERS OBJLAYERS) 
    (c:HideLayerOdclForm) ;_ 隐藏对话框 
  (if (setq ss (ssget)) 
    (progn 
      (repeat (setq n (sslength ss)) 
        (if (not (member (setq la 
                                (cdr (assoc 8 (entget (ssname ss (setq n (1- n)))))) 
                               ) 
                         layers 
                         ) 
                 ) 
          (setq layers (cons la layers)) 
          ) 
        ) 
      (setq 
        objlayers (vla-get-layers 
                    (vla-get-ActiveDocument (vlax-get-acad-object)) 
                    ) 
        ) 
      (vlax-for a objlayers 
        (if (not (member (vla-get-name a) layers)) 
          (vla-put-lock a :vlax-true) 
          ) 
        ) 
      ) 
    ) 
) 
 
;;锁定当前外图层 
(defun c:LayerOdcl_Form1_GraphicButton7_OnClicked (/ cla) 
    (c:HideLayerOdclForm) ;_ 隐藏对话框 
  (setq cla (getvar 'clayer)) 
  (vlax-for a (vla-get-layers 
                    (vla-get-ActiveDocument (vlax-get-acad-object)) 
                    ) 
    (if (/= cla (vla-get-name a)) 
      (vla-put-lock a :vlax-true) 
      (vla-put-lock a :vlax-false) 
      ) 
    ) 
 
) 
 
;;解锁选择层 
(defun c:LayerOdcl_Form1_GraphicButton8_OnClicked 
       (/ SS LAYERS N LA OBJLAYERS) 
  (c:HideLayerOdclForm) ;_ 隐藏对话框 
  (while (setq ss (ssget)) 
    (setq layers nil) 
    (repeat (setq n (sslength ss)) 
      (if (not (member (setq la 
                              (cdr (assoc 8 (entget (ssname ss (setq n (1- n)))))) 
                             ) 
                       layers 
                       ) 
               ) 
        (setq layers (cons la layers)) 
        ) 
      ) 
    (setq 
      objlayers (vla-get-layers 
                  (vla-get-ActiveDocument (vlax-get-acad-object)) 
                  ) 
      ) 
    (foreach a layers 
      (vla-put-lock (vla-item objlayers a) :vlax-false) 
      ) 
    ) 
  ) 
 
 
 
 
;;解锁全部图层 
(defun c:LayerOdcl_Form1_GraphicButton9_OnClicked () 
    (c:HideLayerOdclForm) ;_ 隐藏对话框 
  (vlax-for a (vla-get-layers 
                    (vla-get-ActiveDocument (vlax-get-acad-object)) 
                    ) 
    (vla-put-lock a :vlax-false) 
    ) 
 
) 
 
;;冻结选择图层 
(defun c:LayerOdcl_Form1_GraphicButton10_OnClicked (/ SS LAYERS N LA OBJLAYERS cla) 
    (c:HideLayerOdclForm) ;_ 隐藏对话框 
  (setq cla (getvar 'clayer)) 
  (while (setq ss (ssget)) 
    (setq layers nil) 
    (repeat (setq n (sslength ss)) 
      (if (and 
            (not (member (setq la 
                              (cdr (assoc 8 (entget (ssname ss (setq n (1- n)))))) 
                             ) 
                       layers 
                       ) 
               ) 
            (/= cla la) 
            ) 
        (setq layers (cons la layers)) 
        ) 
      ) 
    (setq 
      objlayers (vla-get-layers 
                  (vla-get-ActiveDocument (vlax-get-acad-object)) 
                  ) 
      ) 
    (foreach a layers 
      (vla-put-Freeze (vla-item objlayers a) :vlax-true) 
      ) 
    ) 
 
) 
 
;;冻结选择外图层 
(defun c:LayerOdcl_Form1_GraphicButton11_OnClicked (/ SS LAYERS N LA OBJLAYERS cla) 
  (c:HideLayerOdclForm) ;_ 隐藏对话框 
  (setq cla (getvar 'clayer)) 
  (while (setq ss (ssget)) 
    (setq layers nil) 
    (repeat (setq n (sslength ss)) 
      (if (not (member (setq la 
                                (cdr (assoc 8 (entget (ssname ss (setq n (1- n)))))) 
                               ) 
                         layers 
                         ) 
                 ) 
        (setq layers (cons la layers)) 
        ) 
      ) 
    (setq 
      objlayers (vla-get-layers 
                  (vla-get-ActiveDocument (vlax-get-acad-object)) 
                  ) 
      ) 
    (setq layers (cons cla layers)) 
    (vlax-for a objlayers 
      (if (not (member (vla-get-name a) layers)) 
        (vla-put-Freeze a :vlax-true) 
        ) 
      ) 
    ) 
 
  ) 
 
 
 
;;冻结当前外图层 
(defun c:LayerOdcl_Form1_GraphicButton12_OnClicked (/ cla) 
  (c:HideLayerOdclForm) ;_ 隐藏对话框 
  (setq cla (getvar 'clayer)) 
  (vlax-for a (vla-get-layers 
                    (vla-get-ActiveDocument (vlax-get-acad-object)) 
                    ) 
    (if (/= cla (vla-get-name a)) 
      (vla-put-Freeze a :vlax-true) 
      ) 
    ) 
) 
 
;;显示解锁解冻所有 
(defun c:LayerOdcl_Form1_GraphicButton13_OnClicked (/ cla doc) 
  (c:HideLayerOdclForm) ;_ 隐藏对话框 
  (setq cla (getvar 'clayer)) 
  (vlax-for a 
            (vla-get-layers 
              (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) 
              ) 
    (vla-put-layeron a :vlax-true) 
    (vla-put-lock a :vlax-false) 
    (if (/= cla (vla-get-name a)) 
      (vla-put-Freeze a :vlax-false) 
      ) 
    ) 
  (vla-regen doc :vlax-true) 
  ) 
;;对象图层匹配 
(defun c:LayerOdcl_Form1_GraphicButton14_OnClicked (/ execute s) 
  (defun execute (SS / E KD CLA N LA DOC) 
    (initget "Type") 
    (setq e (entsel "\n选择目标图层的对象或键入图层名称[Type-it]:")) 
    (cond 
      ((null e) 
       (initget "Yes No") 
       (setq 
         kd (getkword "\n没有选择任何对象，使用当前层吗[Yes/No]<Yes>") 
         ) 
       (if (= "No" kd) 
         (execute ss) 
         (progn 
           (setq cla (getvar 'clayer)) 
           (sssetfirst nil ss) 
           ;;改变图层，不能直接用Command命令 
           (dcl_sendstring (strcat (VL-PRIN1-TO-STRING (list 'command "chprop" "p" "" "la" cla "")) "\n")) 
           ) 
         ) 
       ) 
      ((= "Type" e) 
       (while 
         (= "" 
            (setq la (VL-STRING-TRIM " " (getstring "\n键入图层名称:"))) 
            ) 
         ) 
       (if (VL-CATCH-ALL-ERROR-P 
             (VL-CATCH-ALL-APPLY 
               'vla-item 
               (list 
                 (vla-get-layers 
                   (setq doc (vla-get-ActiveDocument 
                               (vlax-get-acad-object) 
                               ) 
                         ) 
                   ) 
                 la 
                 ) 
               ) 
             ) 
         (progn 
           (initget "Yes No") 
           (setq kd 
                  (getkword "\n输入图层不存在，要创建它吗?[Yes/No]<Yes>") 
                 ) 
           (if (= kd "No") 
             (execute ss) 
             (progn 
               (vla-add (vla-get-layers (vla-get-ActiveDocument (vlax-get-acad-object))) la) 
               (sssetfirst nil ss) 
             (dcl_sendstring (strcat (VL-PRIN1-TO-STRING (list 'command "chprop" "p" "" "la" la "")) "\n")) 
             ) 
             ) 
           ) 
         (progn 
           (sssetfirst nil ss) 
           (dcl_sendstring (strcat (VL-PRIN1-TO-STRING (list 'command "chprop" "p" "" "la" la "")) "\n")) 
           ) 
         ) 
       ) 
      (t 
       (setq e (car e)) 
       (gxl-matchProp e ss) 
       ) 
      ) 
    (princ) 
    ) 
  (c:HideLayerOdclForm) ;_ 隐藏对话框 
  (princ "\n选择要改变的对象:") 
  (setq s (ssget)) 
  (execute s) 
  (princ) 
  ) 
 
 
 
;;移动对象至当前层 
(defun c:LayerOdcl_Form1_GraphicButton15_OnClicked (/ ss la) 
  (c:HideLayerOdclForm) ;_ 隐藏对话框 
  (if (setq ss (ssget ":L")) 
    (progn 
      (setq la (getvar 'clayer)) 
      (sssetfirst nil ss) 
      (dcl_sendstring (strcat (VL-PRIN1-TO-STRING (list 'command "chprop" "p" "" "la" la "")) "\n")) 
      ) 
    ) 
  (princ) 
) 
 
;;隔离对象所在图层 
(defun c:LayerOdcl_Form1_GraphicButton16_OnClicked (/ ss n la a layers) 
  (c:HideLayerOdclForm) ;_ 隐藏对话框 
  (if (setq ss (ssget ":L")) 
    (progn 
      (repeat (setq n (sslength ss)) 
        (if 
          (not 
            (member 
              (setq 
                a (cdr (assoc 8 (entget (ssname ss (setq n (1- n)))))) 
              ) 
              layers 
            ) 
          ) 
           (setq layers (cons a layers)) 
        ) 
      ) 
      (vlax-for        la (vla-get-layers 
                     (vla-get-ActiveDocument (vlax-get-acad-object)) 
                   ) 
        (if (not (member (vla-get-name la) layers)) 
          (vla-put-lock la :vlax-true) 
        ) 
      ) 
    ) 
  ) 
) 
;;改层复制 
(defun c:LayerOdcl_Form1_GraphicButton17_OnClicked (/ CopyObj) 
  (defun CopyObj (SS / E KD CLA ENDENT P1 P2 O LA DOC) 
    (initget "Type") 
    (setq e (entsel "\n选择目标图层的对象或键入图层名称[Type-it]:")) 
    (cond 
      ((null e) 
       (initget "Yes No") 
       (setq 
         kd (getkword "\n没有选择任何对象，使用当前层吗[Yes/No]<Yes>") 
       ) 
       (if (= "No" kd) 
         (CopyObj ss) 
         (progn 
           (setq cla (getvar 'clayer)) 
           (setq p1 (getpoint "\n复制基点:")) 
           (cond 
             ((null p1) 
              (sssetfirst nil ss) 
              (dcl_sendstring 
                (strcat        (VL-PRIN1-TO-STRING 
                          (list 'command "copy" "p" "" "@" "@") 
                        ) 
                        "\n" 
                ) 
              ) 
             ) 
             (p1 
              (setq p2 (getpoint p1 "\n复制位置点:")) 
              (setq ss (GXL-SEL-SS->VLA ss)) 
              (if p2 
                (progn 
                  (setq        p1 (vlax-3d-point p1) 
                        p2 (vlax-3d-point p2) 
                  ) 
                  (foreach a ss 
                    (setq o (vla-copy a)) 
                    (vla-move o p1 p2) 
                    (vla-put-layer o cla) 
                  ) 
                ) 
                (progn 
                  (setq        p1 (vlax-3d-point '(0 0 0)) 
                        p2 (vlax-3d-point '(0 0 0)) 
                  ) 
                  (foreach a ss 
                    (setq o (vla-copy a)) 
                    (vla-move o p1 p2) 
                    (vla-put-layer o cla) 
                  ) 
                ) 
              ) 
             ) 
           ) 
         ) 
       ) 
      ) 
      ((= "Type" e) 
       (while 
         (= "" 
            (setq la (VL-STRING-TRIM " " (getstring "\n键入图层名称:"))) 
         ) 
       ) 
       (if (VL-CATCH-ALL-ERROR-P 
             (VL-CATCH-ALL-APPLY 
               'vla-item 
               (list 
                 (vla-get-layers 
                   (setq doc (vla-get-ActiveDocument 
                               (vlax-get-acad-object) 
                             ) 
                   ) 
                 ) 
                 la 
               ) 
             ) 
           ) 
         (progn 
           (initget "Yes No") 
           (setq kd 
                  (getkword "\n输入图层不存在，要创建它吗?[Yes/No]<Yes>") 
           ) 
           (if (= kd "No") 
             (CopyObj ss) 
             (progn 
               (vla-add        (vla-get-layers 
                          (vla-get-ActiveDocument (vlax-get-acad-object)) 
                        ) 
                        la 
               ) 
               (setq p1 (getpoint "\n复制基点:")) 
               (cond 
                 ((null p1) 
                  (sssetfirst nil ss) 
                  (dcl_sendstring 
                    (strcat (VL-PRIN1-TO-STRING 
                              (list 'command "copy" "p" "" "@" "@") 
                            ) 
                            "\n" 
                    ) 
                  ) 
                 ) 
                 (p1 
                  (setq p2 (getpoint p1 "\n复制位置点:")) 
                  (setq ss (GXL-SEL-SS->VLA ss)) 
                  (if p2 
                    (progn 
                      (setq p1 (vlax-3d-point p1) 
                            p2 (vlax-3d-point p2) 
                      ) 
                      (foreach a ss 
                        (setq o (vla-copy a)) 
                        (vla-move o p1 p2) 
                        (vla-put-layer o la) 
                      ) 
                    ) 
                    (progn 
                      (setq p1 (vlax-3d-point '(0 0 0)) 
                            p2 (vlax-3d-point '(0 0 0)) 
                      ) 
                      (foreach a ss 
                        (setq o (vla-copy a)) 
                        (vla-move o p1 p2) 
                        (vla-put-layer o la) 
                      ) 
                    ) 
                  ) 
                 ) 
               ) 
             ) 
           ) 
         ) 
         (progn 
           (setq p1 (getpoint "\n复制基点:")) 
           (cond 
             ((null p1) 
              (sssetfirst nil ss) 
              (dcl_sendstring 
                (strcat        (VL-PRIN1-TO-STRING 
                          (list 'command "copy" "p" "" "@" "@") 
                        ) 
                        "\n" 
                ) 
              ) 
             ) 
             (p1 
              (setq p2 (getpoint p1 "\n复制位置点:")) 
              (setq ss (GXL-SEL-SS->VLA ss)) 
              (if p2 
                (progn 
                  (setq        p1 (vlax-3d-point p1) 
                        p2 (vlax-3d-point p2) 
                  ) 
                  (foreach a ss 
                    (setq o (vla-copy a)) 
                    (vla-move o p1 p2) 
                    (vla-put-layer o la) 
                  ) 
                ) 
                (progn 
                  (setq        p1 (vlax-3d-point '(0 0 0)) 
                        p2 (vlax-3d-point '(0 0 0)) 
                  ) 
                  (foreach a ss 
                    (setq o (vla-copy a)) 
                    (vla-move o p1 p2) 
                    (vla-put-layer o la) 
                  ) 
                ) 
              ) 
             ) 
           ) 
         ) 
       ) 
      ) 
      (t 
       (setq la (cdr (assoc 8 (entget (car e))))) 
       (setq p1 (getpoint "\n复制基点:")) 
       (cond 
         ((null p1) 
          (sssetfirst nil ss) 
          (dcl_sendstring 
            (strcat 
              (VL-PRIN1-TO-STRING (list 'command "copy" "p" "" "@" "@")) 
              "\n" 
            ) 
          ) 
         ) 
         (p1 
          (setq p2 (getpoint p1 "\n复制位置点:")) 
          (setq ss (GXL-SEL-SS->VLA ss)) 
          (if p2 
            (progn 
              (setq p1 (vlax-3d-point p1) 
                    p2 (vlax-3d-point p2) 
              ) 
              (foreach a ss 
                (setq o (vla-copy a)) 
                (vla-move o p1 p2) 
                (vla-put-layer o la) 
              ) 
            ) 
            (progn 
              (setq p1 (vlax-3d-point '(0 0 0)) 
                    p2 (vlax-3d-point '(0 0 0)) 
              ) 
              (foreach a ss 
                (setq o (vla-copy a)) 
                (vla-move o p1 p2) 
                (vla-put-layer o la) 
              ) 
            ) 
          ) 
         ) 
       ) 
 
      ) 
    ) 
    (princ) 
  ) 
  (c:HideLayerOdclForm) ;_ 隐藏对话框 
  (if (setq ss (ssget ":L")) 
    (CopyObj ss) 
  ) 
 
) 
 
 
;;图层列表点击事件，响应修改图层状态 
(defun c:LayerOdcl_Form1_ListView1_OnClicked 
       (Row Column / layers l la objlay selectitems) 
  (setq        layers (vla-get-layers 
                 (vla-get-ActiveDocument (vlax-get-acad-object)) 
               ) 
  ) 
  (if (> Column 0) 
    (progn 
      (setq l  (nth Row *LayerOdclState) 
            la (car l) 
      ) 
      (cond ((= 1 Column) ;_ 点击开 
             (setq objlay (vla-item layers la)) 
             (if (= :vlax-true (vla-get-layeron objlay)) 
               (progn 
                 (vla-put-layeron objlay :vlax-false) 
                 (dcl_ListView_SetItemImage 
                   LayerOdcl_Form1_ListView1 
                   Row 
                   Column 
                   1 
                 ) 
               ) 
               (progn 
                 (vla-put-layeron objlay :vlax-true) 
                 (dcl_ListView_SetItemImage 
                   LayerOdcl_Form1_ListView1 
                   Row 
                   Column 
                   0 
                 ) 
               ) 
             ) 
            ) 
            ((= 2 Column) ;_ 点冻结 
              (if (/= la (getvar 'clayer)) 
                (progn 
                  (setq objlay (vla-item layers la)) 
                  (if (= :vlax-true (vla-get-Freeze objlay)) 
                    (progn 
                      (vla-put-Freeze objlay :vlax-false) 
                      (dcl_ListView_SetItemImage 
                        LayerOdcl_Form1_ListView1 
                        Row 
                        Column 
                        2 
                      ) 
                    ) 
                    (progn 
                      (vla-put-Freeze objlay :vlax-true) 
                      (dcl_ListView_SetItemImage 
                        LayerOdcl_Form1_ListView1 
                        Row 
                        Column 
                        3 
                      ) 
                    ) 
                  ) 
                ) 
              ) 
            ) 
            ((= 3 Column) ;_ 点锁定 
              (setq objlay (vla-item layers la)) 
              (if (= :vlax-true (vla-get-lock objlay)) 
                (progn 
                  (vla-put-lock objlay :vlax-false) 
                  (dcl_ListView_SetItemImage 
                    LayerOdcl_Form1_ListView1 
                    Row 
                    Column 
                    4 
                  ) 
                ) 
                (progn 
                  (vla-put-lock objlay :vlax-true) 
                  (dcl_ListView_SetItemImage 
                    LayerOdcl_Form1_ListView1 
                    Row 
                    Column 
                    5 
                  ) 
                ) 
              ) 
            ) 
      ) 
    ) 
  ) 
) 
;;列表修改图层名称后的响应 
(defun c:LayerOdcl_Form1_ListView1_OnEndLabelEdit (NewValue ItemIndex /) 
  (setq        layers (vla-get-layers 
                 (vla-get-ActiveDocument (vlax-get-acad-object)) 
               ) 
        l      (nth ItemIndex *LayerOdclState) 
        la     (car l) 
  ) 
  (setq *LayerOdclState (subst (cons NewValue (cdr l)) l *LayerOdclState)) 
  (vla-put-name (vla-item layers la) NewValue) 
) 
;;点击标题 
(defun c:LayerOdcl_Form1_ListView1_OnColumnClick (Column / layers state state icon Row cla) 
  (cond 
    ((= 1 Column) ;_ 图层开关列 
      (if (= :vlax-true 
             (vla-get-layeron 
               (vla-item (setq layers 
                                (vla-get-layers 
                                  (vla-get-ActiveDocument (vlax-get-acad-object)) 
                                ) 
                         ) 
                         (caar *LayerOdclState) 
               ) 
             ) 
          ) 
        (setq state :vlax-false 
              icon  1 
        ) 
        (setq state :vlax-true 
              icon  0 
        ) 
      ) 
      (setq Row 0) 
      (setq *LayerOdclState 
             (mapcar 
               (function 
                 (lambda (x) 
                   (vla-put-layeron (vla-item layers (car x)) state) ;_ 修改图层状态 
                   (dcl_ListView_SetItemImage 
                     LayerOdcl_Form1_ListView1 
                     Row 
                     Column 
                     icon 
                   ) ;_ 修改状态图标 
                   (setq Row (1+ Row)) ;_ 步进 
                   (append (list (car x) "" icon) (cdddr x)) ;_ 更新 *LayerOdclState 
                 ) 
               ) 
               *LayerOdclState 
             ) 
      ) 
    ) 
    ((= 2 Column) ;_ 图层冻结列 
      (if (= :vlax-true 
             (vla-get-Freeze 
               (vla-item (setq layers 
                                (vla-get-layers 
                                  (vla-get-ActiveDocument (vlax-get-acad-object)) 
                                ) 
                         ) 
                         (caar *LayerOdclState) 
               ) 
             ) 
          ) 
        (setq state :vlax-false 
              icon  2 
        ) 
        (setq state :vlax-true 
              icon  3 
        ) 
      ) 
      (setq Row        0 
            cla        (getvar 'clayer) 
      ) 
      (setq *LayerOdclState 
             (mapcar 
               (function 
                 (lambda (x) 
                   (if (/= cla (car x)) 
                     (progn 
                       (vla-put-Freeze (vla-item layers (car x)) state) ;_ 修改图层状态 
                       (dcl_ListView_SetItemImage 
                         LayerOdcl_Form1_ListView1 
                         Row 
                         Column 
                         icon 
                       ) ;_ 修改状态图标 
                       (setq Row (1+ Row)) ;_ 步进 
                       (list (nth 0 x) 
                             (nth 1 x) 
                             (nth 2 x) 
                             (nth 3 x) 
                             icon 
                             (nth 5 x) 
                             (nth 6 x) 
                       ) ;_ 更新 *LayerOdclState 
                     ) 
                     x 
                   ) 
                 ) 
               ) 
               *LayerOdclState 
             ) 
      ) 
    ) 
    ((= 3 Column) ;_ 图层锁定列 
      (if (= :vlax-true 
             (vla-get-lock 
               (vla-item (setq layers 
                                (vla-get-layers 
                                  (vla-get-ActiveDocument (vlax-get-acad-object)) 
                                ) 
                         ) 
                         (caar *LayerOdclState) 
               ) 
             ) 
          ) 
        (setq state :vlax-false 
              icon  4 
        ) 
        (setq state :vlax-true 
              icon  5 
        ) 
      ) 
      (setq Row 0) 
      (setq *LayerOdclState 
             (mapcar 
               (function 
                 (lambda (x) 
                   (vla-put-lock (vla-item layers (car x)) state) ;_ 修改图层状态 
                   (dcl_ListView_SetItemImage 
                     LayerOdcl_Form1_ListView1 
                     Row 
                     Column 
                     icon 
                   ) ;_ 修改状态图标 
                   (setq Row (1+ Row)) ;_ 步进 
                   (list (nth 0 x) (nth 1 x) (nth 2 x) 
                         (nth 3 x) (nth 4 x)  (nth 5 x) icon) ;_ 更新 *LayerOdclState 
                 ) 
               ) 
               *LayerOdclState 
             ) 
      ) 
    ) 
    ) 
)

程序使用方法：
将OpenDclVlx.VLX 复制到CAD支持目录，然后加载LayerOdcl.lsp文件即可！启动命令:tcc !为了保证多文档打开时程序自动加载，请将LayerOdcl.lsp 添加到启动组或将如下语句添加到acad.lsp中去：(load "layerodcl.lsp") !

牢固 · 发表于 2013-4-23 09:47:38

自动隐藏非模态对话框程序设计时几点提示说明：

1、请将对话框和按钮的Event Invoke的属性设置为 0 ，同步方式，并且在按钮命令事件函数中不能用command 命令方式执行Lisp语句，只能用dcl_sendstring函数来执行command命令，否则会出现command命令无效提示。

2、如果非模态对话框按钮的Event Invoke的属性设置为1 ，异步方式执行，则在按钮命令事件函数中可以使用command 命令方式执行Lisp语句，但是在本例中，因鼠标离开对话框窗口时，在OnMouseMovedOff事件中，会延迟800毫秒执行函数c:AutoHideLayerOdclForm隐藏对话框，因而导致重复进入Lisp的错误提示！为避免此种情况，本例的Event Invoke的属性设置为 0 ，按钮事件函数中一律避免使用command函数命令。

大家可以自己尝试修改下Event Invoke属性和命令的执行方式，自己体会一下其中的奥妙！

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:LayerOdcl.odcl
下载次数:158 文件大小:4.47 KB
下载权限: 学生以上 [免费赚D豆]

A82613035 · 发表于 2013-6-28 18:05:36

LayerOdcl.odcl ，裡面主題[圖層工具]是簡體字為什麼不能改成中文字

owen7 · 发表于 2013-6-16 22:22:36

为什么加载运行命令之后鼠标会静止，再点一下屏幕，才恢复正常。。（我是模仿代码自己做的一个工具，代码完全一样啊，不知道错在哪？）。

owen7 · 发表于 2013-6-16 16:41:51

本帖最后由 owen7 于 2013-6-16 19:25 编辑

谢谢，最重要的是自动隐藏，自动显示。

仲文玉 · 发表于 2013-4-24 11:12:04

呵呵，OpenDclVlx.VLX 文件好大，:lol

仲文玉 · 发表于 2013-4-24 09:55:18

非模态，很有诱惑力，有时间也学习下，二进制读写也很给力

XDSoft · 发表于 2013-4-23 21:29:36

casd 发表于 2013-4-23 21:28

登录/注册后可看大图

非常棒的程序和操作体验，图层选择的时候如果可以穿透图块，取到图块内的图层就更好了。

你说的这个就不是ODCL范畴的了，修改下LISP程序就能做到。

casd · 发表于 2013-4-23 21:28:19

非常棒的程序和操作体验，图层选择的时候如果可以穿透图块，取到图块内的图层就更好了。

Gu_xl · 发表于 2013-4-23 13:10:41

SmartStar 发表于 2013-4-23 12:38

登录/注册后可看大图

真给力！OpenDclVlx.VLX是把相应文件转化成二进制文件打包，用的时候在通过二进制转换生成相应的文件吧？

正确的说法是将二进制文件转为文本文件打包，使用时再将文本文件转换为二进制文件还原！

SmartStar · 发表于 2013-4-23 12:38:14

真给力！OpenDclVlx.VLX是把相应文件转化成二进制文件打包，用的时候在通过二进制转换生成相应的文件吧？

XDSoft · 发表于 2013-4-21 01:24:51

给G版个建议，演示时候把图形放大些，能说明问题的大小就OK了，把对话框放的大一些。

牢固 · 发表于 2013-4-21 07:45:55

本帖最后由牢固于 2013-4-21 07:54 编辑

XDSoft 发表于 2013-4-21 01:24

登录/注册后可看大图

给G版个建议，演示时候把图形放大些，能说明问题的大小就OK了，把对话框放的大一些。

本身做的Gif是挺大的，也足够清楚，传上来后，可能自动被压缩到适合网页大小了，所以不太清楚！看来做图片还需要考虑网页显示的大小问题！
现在将显示图片缩小了，看起来好多了！

XDSoft · 发表于 2013-4-21 14:16:48

牢固发表于 2013-4-21 07:45

登录/注册后可看大图

本身做的Gif是挺大的，也足够清楚，传上来后，可能自动被压缩到适合网页大小了，所以不太清楚！看来做图片 ...

老G，考虑考虑我推荐的 Adobe Captivate 做演示吧，我是用了一次就上手了，很好学，也可以加入文字等说明，想加入你磁性的声音也可以啊。

牢固 · 发表于 2013-4-21 17:34:32

本帖最后由牢固于 2013-4-21 17:36 编辑

XDSoft 发表于 2013-4-21 14:16

登录/注册后可看大图

老G，考虑考虑我推荐的 Adobe Captivate 做演示吧，我是用了一次就上手了，很好学，也可以加入文字等说明 ...

Adobe Captivate 这款软件个头也太大了吧！我发现有一款软件叫做ViewletCam 2.0 的动画录屏软件，个头还不到5M,可以录swf,可以录声音，可以录AVI,也可以录Gif，还可以加文字注释，功能挺全的！另外你把上传文件的大小不超过1M的限制取消了吧，一个动画很容易就超过1M了！

[分享] OpenDcl 做的一个非模态-图层控制对话框应用实例

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分

本帖被以下淘专辑推荐:

相关帖子

点评

账号		自动登录	找回密码
密码			立即注册