[原创]：实战 OpenDCL

eachy · 发表于 2009-1-6 17:09:09

下面这几个函数是经过整理的自动加载及其他几个常用处理函数，可以命名为 OpenDCL.lsp 作为公用 OpenDCL 函数库

自动加载是建立在安装 OpenDCL Runtime 的基础上，没有测试将 Opendcl.xx.arx 拷贝到 Suport 目录下的情况

(defun _Load_ODCL_Runtime (/ loaderp proc_arch arxname arxpath errmsg)
(or
dcl_getversionex
(and
(setq arxpath
(vl-registry-read
(strcat
"HKEY_LOCAL_MACHINE\"
(vlax-product-key)
"\\Applications\\OpenDCL"
)
"Loader"
)
)
(setq loaderp t)
(wcmatch (strcase arxpath) "*`.ARX")
(arxload arxpath nil)
dcl_getversionex
)
(and
(setq arxname
(strcat "OpenDCL"
(if
(and
(setq proc_arch
(getenv "PROCESSOR_ARCHITECTURE")
)
(< 1 (strlen proc_arch))
(eq "64"
(substr
proc_arch
(1- (strlen proc_arch))
)
)
)
".x64."
"."
)
(substr (getvar "acadver") 1 2)
".arx"
)
)
(setq arxpath (findfile arxname))
(arxload arxpath nil)
dcl_getversionex
)
(and
loaderp
(= 2 (boole 1 (getvar "DEMANDLOAD") 2))
(vl-catch-all-apply 'vl-cmdf '("opendcl"))
dcl_getversionex
)
(progn
(princ
(strcat
"Error: "
(if arxpath
(strcat arxpath " <failed to load>")
"OpenDCL runtime <not found>"
)
".\n"
)
)
nil
)
)
dcl_getversion
)
(defun _Load_ODCL_Embedded_Project
(string password alias / bytes rtype string)
(vl-catch-all-apply 'vl-cmdf '("opendcl"))
(cond
((null dcl_project_import)
(princ
"OpenDCL version 4.0, beta 18 or newer is required.\n"
)
nil
)
((eq 'str (type password))
(if (eq 'str (type alias))
(dcl_project_import string password alias)
(dcl_project_import string password)
)
)
((dcl_project_import string))
)
(princ)
)
(defun odcl-listview-ItemStrings (lst / n)
(setq n 0)
(mapcar '(lambda (x)
(list x (setq n (1+ n)))
)
lst
)
)
(defun odcl-listview-filllist (form lst /)
(dcl_listview_filllist
form
(odcl-listview-ItemStrings lst)
)
)
(defun odcl-setnil (lst /)
(foreach x lst
(set x nil)
)
)

(defun _Load_ODCL_Runtime (/ loaderp proc_arch arxname arxpath errmsg) 
  (or 
    dcl_getversionex 
    (and 
      (setq arxpath 
             (vl-registry-read 
               (strcat 
                 "HKEY_LOCAL_MACHINE\" 
                 (vlax-product-key) 
                 "\\Applications\\OpenDCL" 
               ) 
               "Loader" 
             ) 
      ) 
      (setq loaderp t) 
      (wcmatch (strcase arxpath) "*`.ARX") 
      (arxload arxpath nil) 
      dcl_getversionex 
    ) 
    (and 
      (setq arxname 
             (strcat "OpenDCL" 
                     (if 
                       (and 
                         (setq proc_arch 
                                (getenv "PROCESSOR_ARCHITECTURE") 
                         ) 
                         (< 1 (strlen proc_arch)) 
                         (eq "64" 
                             (substr 
                               proc_arch 
                               (1- (strlen proc_arch)) 
                             ) 
                         ) 
                       ) 
                        ".x64." 
                        "." 
                     ) 
                     (substr (getvar "acadver") 1 2) 
                     ".arx" 
             ) 
      ) 
      (setq arxpath (findfile arxname)) 
      (arxload arxpath nil) 
      dcl_getversionex 
    ) 
    (and 
      loaderp 
      (= 2 (boole 1 (getvar "DEMANDLOAD") 2)) 
      (vl-catch-all-apply 'vl-cmdf '("opendcl")) 
      dcl_getversionex 
    ) 
    (progn 
      (princ 
        (strcat 
          "Error: " 
          (if arxpath 
            (strcat arxpath " <failed to load>") 
            "OpenDCL runtime <not found>" 
          ) 
          ".\n" 
        ) 
      ) 
      nil 
    ) 
  ) 
  dcl_getversion 
) 
(defun _Load_ODCL_Embedded_Project 
       (string password alias / bytes rtype string) 
  (vl-catch-all-apply 'vl-cmdf '("opendcl")) 
  (cond 
    ((null dcl_project_import) 
     (princ 
       "OpenDCL version 4.0, beta 18 or newer is required.\n" 
     ) 
     nil 
    ) 
    ((eq 'str (type password)) 
     (if (eq 'str (type alias)) 
       (dcl_project_import string password alias) 
       (dcl_project_import string password) 
     ) 
    ) 
    ((dcl_project_import string)) 
  ) 
  (princ) 
) 
(defun odcl-listview-ItemStrings (lst / n) 
  (setq n 0) 
  (mapcar '(lambda (x) 
             (list x (setq n (1+ n))) 
           ) 
          lst 
  ) 
) 
(defun odcl-listview-filllist (form lst /) 
  (dcl_listview_filllist 
    form 
    (odcl-listview-ItemStrings lst) 
  ) 
) 
(defun odcl-setnil (lst /) 
  (foreach x lst 
    (set x nil) 
  ) 
)

eachy · 发表于 2009-1-6 17:35:13

初步的 Lisp 文件

;;按下 ESC，关闭对话框并卸载
(defun c:Insblock_Form1_OnCancel (/)
(dcl_MessageBox
"To Do: code must be added to event handler\r\nc:Insblock_Form1_OnCancel"
"To do"
)
)
;;卸载对话框
(defun c:Insblock_Form1_OnClose (UpperLeftX UpperLeftY /)
(dcl_MessageBox
"To Do: code must be added to event handler\r\nc:Insblock_Form1_OnClose"
"To do"
)
)
;;对话框打开时初始化对话框，主要完成块名列表的填充
(defun c:Insblock_Form1_OnInitialize (/)
(dcl_MessageBox
"To Do: code must be added to event handler\r\nc:Insblock_Form1_OnInitialize"
"To do"
)
)
;;双击块名列表时在匿名/有名块间切换
(defun c:Insblock_Form1_Blklst_OnDblClicked (/)
(dcl_MessageBox
"To Do: code must be added to event handler\r\nc:Insblock_Form1_Blklst_OnDblClicked"
"To do"
)
)
;;拖动块名执行插入
(defun c:Insblock_Form1_Blklst_OnDragnDropToAutoCAD
(DropPoint Viewport /)
(dcl_MessageBox
"To Do: code must be added to event handler\r\nc:Insblock_Form1_Blklst_OnDragnDropToAutoCAD"
"To do"
)
)
;;右击事件
(defun c:Insblock_Form1_Blklst_OnRightClick (/)
(dcl_MessageBox
"To Do: code must be added to event handler\r\nc:Insblock_Form1_Blklst_OnRightClick"
"To do"
)
)
;;列表选择变化时预览区变化
(defun c:Insblock_Form1_Blklst_OnSelChanged (ItemIndex Value /)
(dcl_MessageBox
"To Do: code must be added to event handler\r\nc:Insblock_Form1_Blklst_OnSelChanged"
"To do"
)
)
;;主程序
(defun c:Ea:INS (/ string)
(setq string
'("YWt6A90LAADMldNsBuLDKDcxKj9ugD7ocDVKOve65u727/3mH2Oe+P73dczn1vd3TL2y/nJyf7qb"
"nK/9CVEETlAPKTKinK/toIJ/gH5tOxFgIr7RhHPRoVU2plyDjISLqSsjIyODK7MSI+YhPohL+U/w"
"V7ruOHgP8lx5vtk8vvb8SgDV7BY4agsCXNa5bhSuNlLNSxae1rewS80xXL+vXsFPnD/k8i3d9504"
"sKczabocU5s3lDmHM6ZLNxQ6zGh5R00ak0qO94YNDyTUnfR2hQSwW897uxwqwlBsEbUfDO71Et1W"
"gW5xSPdPqrwCPqfcWtUchO75Pk0p0lelwK4tLZiO0rahRhKLIVeCJJ/pdIEPhfe+IjvfkdKSyVma"
"gv/9gMMqvMXXenFNM8qk2XOZ10ES/a40ohdRG2bpHkD4iPzXCMDgm7aCO7/c1eopuscgzRt+UMJ9"
"ltjK44i5VzUuuaJyJ/7nd5/j1ctWTEfHB/GCPo4eQFWFaTwGiZSS9bh2HUo8sa2SUbUwweub9R8S"
"N1n6zdoVr9pV7gVlm0U7xbWvUGm42Tr+DMH6fAeAX0P0CkXHUkzTcCl28FQ0s1SCPJ9c+7k90OkK"
"3+FKl1k7mnStYgnOMb/CDYWw16rGWwjQVcXjVj/e52OUYkNw4WzE691G2iHZLM0/p5ELlaF00AkP"
"zYTzNIHV3IUgm7EP+WF2QNQsiea8I3RhL8Y7k9GtE+HsKdUG6PhWKctM5/3ajdajHwulU9M7IdTU"
"B9DWgyqfGXRBd5+DlY0d7LfrtPBM5r53iCAXtK7BSLBRN5DKYWFx8VRCmLlVmdmOT92amWpA17AL"
"M5+tZfEJYZ3iHJgyeRwQyBOiEMGzuwgk6JzkjJCP8owBsJnp+Zmjh1PBwNUGAo0BBEIi26iBDo/r"
"sOjCI0xuaiMsjByolXfgHBizW5HQNKPrNN5QD5VTF8T6oy8Aoi0IYUeDk/xhRSL3GzSeA/t9W66A"
"5ZYvht9UB8OUosnjAQy+M1EXFVYfCMFsO68s+0ko9IABt/bXgyhUX0lqoJpq64hxBR/qeA=="
)
);_ Odcl 对话框文件
(if (ybl-table "block");_有块的时候才执行对话框
(if (and (_Load_ODCL_Runtime) ;_load arx
(_Load_ODCL_Embedded_Project string nil nil) ;_project_load
)
(progn
(if
(null
(or (dcl_Form_IsActive Insblock_form1);_文件名_窗体名
(dcl_Form_Show Insblock_form1)
)
)
(princ "Failed to show form: Insblk_form1")
)
)
)
(princ "\nNo Blockdef Found in thisdrawing!")
)
(princ)
)

;;按下 ESC，关闭对话框并卸载 
(defun c:Insblock_Form1_OnCancel (/) 
  (dcl_MessageBox 
    "To Do: code must be added to event handler\r\nc:Insblock_Form1_OnCancel" 
    "To do" 
  ) 
) 
;;卸载对话框 
(defun c:Insblock_Form1_OnClose        (UpperLeftX UpperLeftY /) 
  (dcl_MessageBox 
    "To Do: code must be added to event handler\r\nc:Insblock_Form1_OnClose" 
    "To do" 
  ) 
) 
;;对话框打开时初始化对话框，主要完成块名列表的填充 
(defun c:Insblock_Form1_OnInitialize (/) 
  (dcl_MessageBox 
    "To Do: code must be added to event handler\r\nc:Insblock_Form1_OnInitialize" 
    "To do" 
  ) 
) 
;;双击块名列表时在 匿名/有名块间切换 
(defun c:Insblock_Form1_Blklst_OnDblClicked (/) 
  (dcl_MessageBox 
    "To Do: code must be added to event handler\r\nc:Insblock_Form1_Blklst_OnDblClicked" 
    "To do" 
  ) 
) 
;;拖动块名执行插入 
(defun c:Insblock_Form1_Blklst_OnDragnDropToAutoCAD 
       (DropPoint Viewport /) 
  (dcl_MessageBox 
    "To Do: code must be added to event handler\r\nc:Insblock_Form1_Blklst_OnDragnDropToAutoCAD" 
    "To do" 
  ) 
) 
;;右击事件 
(defun c:Insblock_Form1_Blklst_OnRightClick (/) 
  (dcl_MessageBox 
    "To Do: code must be added to event handler\r\nc:Insblock_Form1_Blklst_OnRightClick" 
    "To do" 
  ) 
) 
;;列表选择变化时预览区变化 
(defun c:Insblock_Form1_Blklst_OnSelChanged (ItemIndex Value /) 
  (dcl_MessageBox 
    "To Do: code must be added to event handler\r\nc:Insblock_Form1_Blklst_OnSelChanged" 
    "To do" 
  ) 
) 
;;主程序 
(defun c:Ea:INS        (/ string) 
  (setq        string 
         '("YWt6A90LAADMldNsBuLDKDcxKj9ugD7ocDVKOve65u727/3mH2Oe+P73dczn1vd3TL2y/nJyf7qb" 
           "nK/9CVEETlAPKTKinK/toIJ/gH5tOxFgIr7RhHPRoVU2plyDjISLqSsjIyODK7MSI+YhPohL+U/w" 
           "V7ruOHgP8lx5vtk8vvb8SgDV7BY4agsCXNa5bhSuNlLNSxae1rewS80xXL+vXsFPnD/k8i3d9504" 
           "sKczabocU5s3lDmHM6ZLNxQ6zGh5R00ak0qO94YNDyTUnfR2hQSwW897uxwqwlBsEbUfDO71Et1W" 
           "gW5xSPdPqrwCPqfcWtUchO75Pk0p0lelwK4tLZiO0rahRhKLIVeCJJ/pdIEPhfe+IjvfkdKSyVma" 
           "gv/9gMMqvMXXenFNM8qk2XOZ10ES/a40ohdRG2bpHkD4iPzXCMDgm7aCO7/c1eopuscgzRt+UMJ9" 
           "ltjK44i5VzUuuaJyJ/7nd5/j1ctWTEfHB/GCPo4eQFWFaTwGiZSS9bh2HUo8sa2SUbUwweub9R8S" 
           "N1n6zdoVr9pV7gVlm0U7xbWvUGm42Tr+DMH6fAeAX0P0CkXHUkzTcCl28FQ0s1SCPJ9c+7k90OkK" 
           "3+FKl1k7mnStYgnOMb/CDYWw16rGWwjQVcXjVj/e52OUYkNw4WzE691G2iHZLM0/p5ELlaF00AkP" 
           "zYTzNIHV3IUgm7EP+WF2QNQsiea8I3RhL8Y7k9GtE+HsKdUG6PhWKctM5/3ajdajHwulU9M7IdTU" 
           "B9DWgyqfGXRBd5+DlY0d7LfrtPBM5r53iCAXtK7BSLBRN5DKYWFx8VRCmLlVmdmOT92amWpA17AL" 
           "M5+tZfEJYZ3iHJgyeRwQyBOiEMGzuwgk6JzkjJCP8owBsJnp+Zmjh1PBwNUGAo0BBEIi26iBDo/r" 
           "sOjCI0xuaiMsjByolXfgHBizW5HQNKPrNN5QD5VTF8T6oy8Aoi0IYUeDk/xhRSL3GzSeA/t9W66A" 
           "5ZYvht9UB8OUosnjAQy+M1EXFVYfCMFsO68s+0ko9IABt/bXgyhUX0lqoJpq64hxBR/qeA==" 
          ) 
  );_ Odcl 对话框文件 
  (if (ybl-table "block");_有块的时候才执行对话框 
    (if        (and (_Load_ODCL_Runtime) ;_load arx 
             (_Load_ODCL_Embedded_Project string nil nil) ;_project_load 
        ) 
      (progn 
        (if 
          (null 
            (or        (dcl_Form_IsActive Insblock_form1);_文件名_窗体名 
                (dcl_Form_Show Insblock_form1) 
            ) 
          ) 
           (princ "Failed to show form: Insblk_form1") 
        ) 
      ) 
    ) 
    (princ "\nNo Blockdef Found in thisdrawing!") 
  ) 
  (princ) 
)

露水2 · 发表于 2009-1-6 21:08:23

自动加载是建立在安装 OpenDCL Runtime 的基础上，没有测试将 Opendcl.xx.arx 拷贝到 Suport 目录下的情况
好试了试好像不行

carrot1983 · 发表于 2009-1-7 13:07:39

使用opendcl5.0版本的。
需要用到OpenDCL.**.arx和RxInstall.dll放在搜索路径，
然后加载OpenDCL.**.arx
如果是4.0及以下的版本，只需要加载OpenDCL.**.arx就搞定了。
我测试的结果

PS:上面的文件一般放在
C:\Program Files\Common Files\OpenDCL

经露水测试，搞不定。。。
所以，以后用opendcl开发出来的程序，
建议附带一个runtime的安装程序的下载网址给别人。。。
或者直接打包在一起。。。

taner · 发表于 2009-1-7 15:27:18

EA真乃神人也，俺对你的敬仰，如长江之水，滔滔不绝！

俺还没看懂，抄下来慢慢研究！

eachy · 发表于 2009-1-7 16:28:30

这是完整的代码，有些效果没有测试成功， OpenDCL 的窗体加载后如果不 Unload ，后面可以用 dcl_form_show 显示。

对每个控件的函数一般都是 DCL—_xxx_xxx，DCL是前缀，中间部分是控件名称，最后是功能，所有这些在 Studio 中在控件上按右键菜单的最后一项 Control Browser 中

;;按下 ESC，关闭对话框并卸载
(defun c:Insblock_Form1_OnCancel (/)
(dcl_form_close insblock_form1) ;_关闭对话框
(dcl_project_unload "insblock") ;_关闭后还要卸载，这里要文件名
(princ)
)
;;卸载对话框
(defun c:Insblock_Form1_OnClose (UpperLeftX UpperLeftY /)
(dcl_form_close insblock_form1)
(dcl_project_unload "insblock")
(princ)
)
;;对话框打开时初始化对话框，主要完成块名列表的填充
(defun c:Insblock_Form1_OnInitialize (/ blklst)
(setq blklst (vl-remove-if
'(lambda (x) (= (substr x 1 1) "*"))
(ybl-table "block")
)
) ;_ names of block table
;; clear and fill the list
(dcl_Listbox_addList
insblock_form1_blklst ;_控件
blklst
) ;_ Fill names to list
(dcl_listbox_setcursel insblock_form1_blklst 0) ;_ currect select
(dcl_BlockView_DisplayBlock
insblock_form1_blkprv
(car blklst)
0
1.
) ;_ priv
(princ)
)
;;右击切换
(defun c:Insblock_Form1_Blklst_OnRightClick (/ blklst unblklst ll)
(setq blklst (ybl-table "block") ;_全部块
ublklst (vl-remove-if '(lambda (x) (= (substr x 1 1) "*")) blklst) ;_去掉匿名块
)
(setq ll (dcl_Listbox_getcount insblock_form1_blklst)) ;_当前列表中块数量
(if (= ll (length blklst)) ;_判断切换条件
(progn
(dcl_ListBox_Clear Insblock_Form1_Blklst)
(dcl_Listbox_addList
insblock_form1_blklst
ublklst
)
)
(progn
(dcl_ListBox_Clear Insblock_Form1_Blklst)
(dcl_Listbox_addList
insblock_form1_blklst
blklst
)
)
)
(princ)
)
;;2007 中没有测试出来
(defun c:Insblock_Form1_blklst_OnDragnDropToAutoCAD
(DropPoint Viewport /)
(dcl_MessageBox
"To Do: code must be added to event handler\r\nc:Insblock_Form1_blklst_OnDragnDropToAutoCAD"
"To do"
)
)
;;双击插入图块；看 Events 中有 DragnDropToAutoCAD，2007没有效果
;;用的的是Model 窗体，执行命令时要关闭窗体，执行完再次显示，在
;;2007上测试没有达到再次显示的效果
(defun c:Insblock_Form1_Blklst_OnDblClicked (/ ll)
(setq bn
(dcl_Listbox_GetItemText
insblock_form1_blklst
(dcl_listbox_GetCurSel insblock_form1_blklst)
)
);_获取双击时的当前选择
(if (/= (substr bn 1 1) "*")
(progn
(setvar "cmdecho" 1)
(dcl_form_close insblock_form1)
(vl-catch-all-apply
'(lambda ()
(vl-cmdf ".insert" bn pause pause pause)
)
)
(dcl_form_show Insblock_form1);_2007失败
(setvar "cmdecho" 0)
)
(progn
(dcl_form_close insblock_form1)
(if (setq pt (getpoint "\nInsert Point: "))
(vla-insertblock
(vla-get-modelspace
(vla-get-activedocument (vlax-get-acad-object))
)
(vlax-3d-point pt)
bn
1.
1.
1.
0.
)
)
(dcl_form_show Insblock_form1)
)
)
(princ)
)
;;列表选择变化时预览区变化
;;IntemIndex 索引
;;Value 索引处的 string, 这个比 DCL 仅获取索引方便
;;
(defun c:Insblock_Form1_Blklst_OnSelChanged
(ItemIndex Value / rvalue n)
(if (>= (setq n (dcl_listbox_GetCurSel insblock_form1_blklst))
0
);_获取双击时的当前选择块名
(progn (Setq rValue (dcl_Listbox_GetItemText
insblock_form1_blklst
n
)
)
(dcl_blockview_clear insblock_form1_blkprv);_清除前一显示
(dcl_BlockView_DisplayBlock
insblock_form1_blkprv
rValue
0
1.
)
)
)
(princ)
)
;;主程序
(defun c:Ea:INS (/ string)
(setq string
'("YWt6AyELAAD/ceM/BuKzKjcxaj9qgHgnVFKv7kbv/Xf3ZkMWvL5ysg49rrp7L0pPZG28THK2TLbY"
"j9xJyeYGr/2PnnEOMyJs8eCKmHGOnu/W1lk9Ir6RK0kjo3FrDnAkNyvB0aEs0aDIAA8fb4BIBU/4"
"N4ocegeKH2ZPftG1fl18zIbTNV7/cuTuPEEErvbjNmyrHb4sfSox77Tu7cgq5KJYnFoJYS9DR7Oq"
"y+lQ9LtKzKqUOX1brKgw+Jl+Mc+mNdP6y63y+ttkBxF9C8xCreo0j5KZx3BrHCrCUGkRnU5Par8h"
"GuuSn71YTjRVmHk0Azjy4uRAyj5BwWUwwGXjmsiPmE+MzOpPyV1oHhhcBq0UU3QR7GizdepSl7Uf"
"oFaFGVwGjZSS9bpu2MYFVkv6DQytSRuH0rxRL8NqS0EC2HW7dlMNoA0sqFLNFtRj4GmATfnTgm37"
"4VSCJp+RkEAf5vVWdWxXiRP3WsisdTroMeE8Uwh7f0/RXAxOpaND6Tan/O8cz3vtr3stVN9jmODa"
"Iy1rdy2jtHd2FQWXFsmBpBJUOkC1vEtxKoaRVwIhn8Vvwp2RguYeP5oCVPEPYpun9Bc0mpchVYFR"
"VbbvXllgYCgGSvYTkvWaVtGG2WpA2KALK5+d+7nF9Q+wH+6mu6ISVqKQb0V8pBYneDywtZ03m4Ei"
"LjVgIA6RyUuDL7udPS6dYNAthOEiAlOBaRMkes2KVaLcIVtjuz9Ew+iUCgIvTFNwqXYQKFOBLp85"
"1Du1a2D1yBZ5/Si1QxY9STzE4xlwmMfFCTDz7CfPDS2no/O09mFlq0VwRwL/6vfdXFyh3qDvKohx"
"RYOx/GUjotICNJfBKV0Y1YyZ3szJIfPEfXQJVsIxn/KMKfHGE/RhZAepn/HCxm6MWY/l70mwnOH/"
"1ypbI9sOH90Vh/avXZ/kvOkpZmcpgEY8HjBWgoHIkkUX+61Uy99oaLjMaCAV9ZQo5ShdPMkg1quQ"
"XqQUKIHorWlcojSowWWBxguorlQRg5ExcJf0Gg=="
)
) ;_ Odcl 对话框文件
(if (ybl-table "block") ;_有块的时候才执行对话框
(if (and (_Load_ODCL_Runtime) ;_load arx
(_Load_ODCL_Embedded_Project string nil nil) ;_project_load
)
(progn
(if
(null
(or (dcl_Form_IsActive Insblock_form1) ;_文件名_窗体名检测是否已经显示
(dcl_Form_Show Insblock_form1);_显示窗体
)
)
(princ "Failed to show form: Insblock_form1")
)
)
)
(princ "\nNo Blockdef Found in thisdrawing!")
)
(princ)
)

;;按下 ESC，关闭对话框并卸载 
(defun c:Insblock_Form1_OnCancel (/) 
  (dcl_form_close insblock_form1) ;_关闭对话框 
  (dcl_project_unload "insblock") ;_关闭后还要卸载，这里要文件名 
  (princ) 
) 
;;卸载对话框 
(defun c:Insblock_Form1_OnClose        (UpperLeftX UpperLeftY /) 
  (dcl_form_close insblock_form1) 
  (dcl_project_unload "insblock") 
  (princ) 
) 
;;对话框打开时初始化对话框，主要完成块名列表的填充 
(defun c:Insblock_Form1_OnInitialize (/ blklst) 
  (setq        blklst (vl-remove-if 
                 '(lambda (x) (= (substr x 1 1) "*")) 
                 (ybl-table "block") 
               ) 
  ) ;_ names of block table 
  ;; clear and fill the list 
  (dcl_Listbox_addList 
    insblock_form1_blklst ;_控件 
    blklst 
  ) ;_ Fill names to list 
  (dcl_listbox_setcursel insblock_form1_blklst 0) ;_ currect select 
  (dcl_BlockView_DisplayBlock 
    insblock_form1_blkprv 
    (car blklst) 
    0 
    1. 
  ) ;_ priv 
  (princ) 
) 
;;右击切换 
(defun c:Insblock_Form1_Blklst_OnRightClick (/ blklst unblklst ll) 
  (setq        blklst        (ybl-table "block") ;_全部块 
        ublklst        (vl-remove-if '(lambda (x) (= (substr x 1 1) "*")) blklst) ;_去掉匿名块 
  ) 
  (setq ll (dcl_Listbox_getcount insblock_form1_blklst)) ;_当前列表中块数量 
  (if (= ll (length blklst)) ;_判断切换条件 
    (progn 
      (dcl_ListBox_Clear Insblock_Form1_Blklst) 
      (dcl_Listbox_addList 
        insblock_form1_blklst 
        ublklst 
      ) 
    ) 
    (progn 
      (dcl_ListBox_Clear Insblock_Form1_Blklst) 
      (dcl_Listbox_addList 
        insblock_form1_blklst 
        blklst 
      ) 
    ) 
  ) 
  (princ) 
) 
;;2007 中没有测试出来 
(defun c:Insblock_Form1_blklst_OnDragnDropToAutoCAD 
       (DropPoint Viewport /) 
  (dcl_MessageBox 
    "To Do: code must be added to event handler\r\nc:Insblock_Form1_blklst_OnDragnDropToAutoCAD" 
    "To do" 
  ) 
) 
 
 
;;双击插入图块； 看 Events 中有 DragnDropToAutoCAD，2007没有效果 
;;用的的是Model 窗体，执行 命令时要关闭窗体，执行完再次显示，在 
;;2007上测试没有达到再次显示的效果 
(defun c:Insblock_Form1_Blklst_OnDblClicked (/ ll) 
  (setq        bn 
         (dcl_Listbox_GetItemText 
           insblock_form1_blklst 
           (dcl_listbox_GetCurSel insblock_form1_blklst) 
         ) 
  );_获取双击时的当前选择 
  (if (/= (substr bn 1 1) "*") 
    (progn 
      (setvar "cmdecho" 1) 
      (dcl_form_close insblock_form1) 
      (vl-catch-all-apply 
        '(lambda () 
           (vl-cmdf ".insert" bn pause pause pause) 
         ) 
      ) 
      (dcl_form_show Insblock_form1);_2007失败 
      (setvar "cmdecho" 0) 
    ) 
    (progn 
      (dcl_form_close insblock_form1) 
      (if (setq pt (getpoint "\nInsert Point: ")) 
        (vla-insertblock 
          (vla-get-modelspace 
            (vla-get-activedocument (vlax-get-acad-object)) 
          ) 
          (vlax-3d-point pt) 
          bn 
          1. 
          1. 
          1. 
          0. 
        ) 
      ) 
      (dcl_form_show Insblock_form1) 
    ) 
  ) 
  (princ) 
) 
;;列表选择变化时预览区变化 
;;IntemIndex 索引 
;;Value 索引处的 string, 这个比 DCL 仅获取索引方便 
;; 
(defun c:Insblock_Form1_Blklst_OnSelChanged 
       (ItemIndex Value / rvalue n) 
  (if (>= (setq n (dcl_listbox_GetCurSel insblock_form1_blklst)) 
          0 
      );_获取双击时的当前选择块名 
    (progn (Setq rValue        (dcl_Listbox_GetItemText 
                          insblock_form1_blklst 
                          n 
                        ) 
           ) 
           (dcl_blockview_clear insblock_form1_blkprv);_清除前一显示 
           (dcl_BlockView_DisplayBlock 
             insblock_form1_blkprv 
             rValue 
             0 
             1. 
           ) 
    ) 
  ) 
  (princ) 
) 
;;主程序 
(defun c:Ea:INS        (/ string) 
  (setq        string 
         '("YWt6AyELAAD/ceM/BuKzKjcxaj9qgHgnVFKv7kbv/Xf3ZkMWvL5ysg49rrp7L0pPZG28THK2TLbY" 
           "j9xJyeYGr/2PnnEOMyJs8eCKmHGOnu/W1lk9Ir6RK0kjo3FrDnAkNyvB0aEs0aDIAA8fb4BIBU/4" 
           "N4ocegeKH2ZPftG1fl18zIbTNV7/cuTuPEEErvbjNmyrHb4sfSox77Tu7cgq5KJYnFoJYS9DR7Oq" 
           "y+lQ9LtKzKqUOX1brKgw+Jl+Mc+mNdP6y63y+ttkBxF9C8xCreo0j5KZx3BrHCrCUGkRnU5Par8h" 
           "GuuSn71YTjRVmHk0Azjy4uRAyj5BwWUwwGXjmsiPmE+MzOpPyV1oHhhcBq0UU3QR7GizdepSl7Uf" 
           "oFaFGVwGjZSS9bpu2MYFVkv6DQytSRuH0rxRL8NqS0EC2HW7dlMNoA0sqFLNFtRj4GmATfnTgm37" 
           "4VSCJp+RkEAf5vVWdWxXiRP3WsisdTroMeE8Uwh7f0/RXAxOpaND6Tan/O8cz3vtr3stVN9jmODa" 
           "Iy1rdy2jtHd2FQWXFsmBpBJUOkC1vEtxKoaRVwIhn8Vvwp2RguYeP5oCVPEPYpun9Bc0mpchVYFR" 
           "VbbvXllgYCgGSvYTkvWaVtGG2WpA2KALK5+d+7nF9Q+wH+6mu6ISVqKQb0V8pBYneDywtZ03m4Ei" 
           "LjVgIA6RyUuDL7udPS6dYNAthOEiAlOBaRMkes2KVaLcIVtjuz9Ew+iUCgIvTFNwqXYQKFOBLp85" 
           "1Du1a2D1yBZ5/Si1QxY9STzE4xlwmMfFCTDz7CfPDS2no/O09mFlq0VwRwL/6vfdXFyh3qDvKohx" 
           "RYOx/GUjotICNJfBKV0Y1YyZ3szJIfPEfXQJVsIxn/KMKfHGE/RhZAepn/HCxm6MWY/l70mwnOH/" 
           "1ypbI9sOH90Vh/avXZ/kvOkpZmcpgEY8HjBWgoHIkkUX+61Uy99oaLjMaCAV9ZQo5ShdPMkg1quQ" 
           "XqQUKIHorWlcojSowWWBxguorlQRg5ExcJf0Gg==" 
          ) 
  ) ;_ Odcl 对话框文件 
  (if (ybl-table "block") ;_有块的时候才执行对话框 
    (if        (and (_Load_ODCL_Runtime) ;_load arx 
             (_Load_ODCL_Embedded_Project string nil nil) ;_project_load 
        ) 
      (progn 
        (if 
          (null 
            (or        (dcl_Form_IsActive Insblock_form1) ;_文件名_窗体名 检测是否已经显示 
                (dcl_Form_Show Insblock_form1);_显示窗体 
            ) 
          ) 
           (princ "Failed to show form: Insblock_form1") 
        ) 
      ) 
    ) 
    (princ "\nNo Blockdef Found in thisdrawing!") 
  ) 
  (princ) 
)

jx2008 · 发表于 2009-1-9 09:57:45

呵呵，学习了，eachy开个OpenDcl教程板块吧

ok0628 · 发表于 2009-1-16 16:08:05

刚刚接触还是不熟悉啊再细些的教程有吗？

hnjzwql · 发表于 2009-1-25 08:53:36

有教程吗？

雄啸 · 发表于 2009-1-25 12:03:34

支持ea一个

Dallas_whu · 发表于 2009-2-6 11:10:36

这么好的东西，怎么没加积分啊！

bikeboy · 发表于 2009-2-22 17:33:03

没太看明白慢慢学习吧

nbdjb · 发表于 2009-3-16 16:33:10

看不太明白！

zhuxiaoming · 发表于 2009-3-21 23:02:22

繁琐啊,一般的难看懂,崇拜你们

jxlsp · 发表于 2009-3-27 20:59:18

请问表格怎么写入文字啊?

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