OpenDcl 做的一个非模态-图层控制对话框应用实例
本帖最后由 newer 于 2017-6-24 12:40 编辑这是OpenDcl做的一个非模态图层控制 对话框应用实例！先看演示：
它展示了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 文件下载
图层控制源码下载:
对话框控制代码：
;;(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选择目标图层的对象或键入图层名称:"))
(cond
((null e)
(initget "Yes No")
(setq
kd (getkword "\n没有选择任何对象，使用当前层吗<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>")
)
(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选择目标图层的对象或键入图层名称:"))
(cond
((null e)
(initget "Yes No")
(setq
kd (getkword "\n没有选择任何对象，使用当前层吗<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>")
)
(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
icon1
)
(setq state :vlax-true
icon0
)
)
(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
icon2
)
(setq state :vlax-true
icon3
)
)
(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
icon4
)
(setq state :vlax-true
icon5
)
)
(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") !
自动隐藏非模态对话框程序设计时几点提示说明：
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 ，裡面主題[圖層工具]是簡體字為什麼不能改成中文字 为什么 加载运行命令之后 鼠标会静止，再点一下屏幕，才恢复正常。。（我是模仿代码自己做的一个工具，代码完全一样啊，不知道错在哪？）。 本帖最后由 owen7 于 2013-6-16 19:25 编辑
谢谢，最重要的是 自动隐藏，自动显示。 呵呵，OpenDclVlx.VLX 文件好大，:lol 非模态，很有诱惑力，有时间也学习下，二进制读写也很给力 casd 发表于 2013-4-23 21:28 static/image/common/back.gif
非常棒的程序和操作体验，图层选择的时候如果可以穿透图块，取到图块内的图层就更好了。
你说的这个就不是ODCL范畴的了，修改下LISP程序就能做到。 非常棒的程序和操作体验，图层选择的时候如果可以穿透图块，取到图块内的图层就更好了。 SmartStar 发表于 2013-4-23 12:38 static/image/common/back.gif
真给力！OpenDclVlx.VLX是把相应文件转化成二进制文件打包，用的时候在通过二进制转换生成相应的文件吧？
正确的说法是将二进制文件转为文本文件打包，使用时再将文本文件转换为二进制文件还原！ 真给力！OpenDclVlx.VLX是把相应文件转化成二进制文件打包，用的时候在通过二进制转换生成相应的文件吧？ 给G版个建议，演示时候把图形放大些，能说明问题的大小就OK了，把对话框放的大一些。 本帖最后由 牢固 于 2013-4-21 07:54 编辑
XDSoft 发表于 2013-4-21 01:24 static/image/common/back.gif
给G版个建议，演示时候把图形放大些，能说明问题的大小就OK了，把对话框放的大一些。
本身做的Gif是挺大的，也足够清楚，传上来后，可能自动被压缩到适合网页大小了，所以不太清楚！看来做图片还需要考虑网页显示的大小问题！
现在将显示图片缩小了，看起来好多了！ 牢固 发表于 2013-4-21 07:45 static/image/common/back.gif
本身做的Gif是挺大的，也足够清楚，传上来后，可能自动被压缩到适合网页大小了，所以不太清楚！看来做图片 ...
老G，考虑考虑我推荐的 Adobe Captivate 做演示吧，我是用了一次就上手了，很好学，也可以加入文字等说明，想加入你磁性的声音也可以啊。 本帖最后由 牢固 于 2013-4-21 17:36 编辑
XDSoft 发表于 2013-4-21 14:16 static/image/common/back.gif
老G，考虑考虑我推荐的 Adobe Captivate 做演示吧，我是用了一次就上手了，很好学，也可以加入文字等说明 ...
Adobe Captivate 这款软件个头也太大了吧！我发现有一款软件叫做ViewletCam 2.0 的动画录屏软件，个头还不到5M,可以录swf,可以录声音，可以录AVI,也可以录Gif，还可以加文字注释，功能挺全的！另外你把上传文件的大小不超过1M的限制取消了吧，一个动画很容易就超过1M了！