[原创]：实战 OpenDCL

eachy · 发表于 2009-1-6 15:38:04

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

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

×

这是一个 OpenDCL 的简单实例，写的比较粗燥

1 OpenDCL Studio 界面

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

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

eachy · 发表于 2009-1-6 16:22:13

写 Lisp 之前先要做些前期工作，因为要图块插入，获取图块列表是必须的，另外插入匿名块是不能用 command 的，要用到 Vla-insertblock，先来看看这两部分

获取图块列表，这个经常用到，作为一个通用函数

;;;功能返回包含在指定符号表中的所有元素
;;;参数一个符号表名称
;;;示例 (ybl-table "block")
;;;作者 Michael Puckett
(defun ybl-table (s / d r)
(while (setq d (tblnext s (null d)))
(setq r (cons (cdr (assoc 2 d)) r))
)
(reverse r)
)

Vla-InsertBlock

插入图形文件或当前图形中已定义的命名块。
参阅 | 示例
语法
RetVal = object.InsertBlock(InsertionPoint, Name, Xscale, Yscale, ZScale, Rotation [, Password])
Object
ModelSpace, PaperSpace, Block
使用该方法的对象和集合。
InsertionPoint
Variant[变体] [变体] (三元素双精度数组); 为输入项
该三维WCS坐标指定了插入块到图形中的位置。
Name
String[字符串]; 为输入项
插入的 AutoCAD 图形文件名称或图块名称。如果为文件名，则必须包含 .dwg 扩展名和任何路径信息以便 AutoCAD 找到该文件。
Xscale Double[双精度]; 为输入项X向的比例。默认值等于 1.0。必须为正数。
Yscale Double[双精度]; 为输入项Y向的比例。默认值等于 1.0。必须为正数。
Zscale Double[双精度]; 为输入项Z向的比例。默认值等于 1.0。必须为正数。
Rotation Double[双精度]; 为输入项旋转角。默认值等于 0.0 弧度。
Password Variant[变体]; 为输入项；可选项
RetVal
BlockRef 对象返回新创建的块参照对象。
说明
插入块到其它块中将创建嵌套的块。
试图带未初始化 Name 参数调用 InsertBlock 方法将产生意外结果。

复制代码

eachy · 发表于 2009-1-6 15:49:29

2 增加窗体，目前有 6 种窗体形式
Model Dialog 普通窗体，此时控制权在窗体上，不能在绘图区操作

Modeless Dialog 好像叫非模态对话框，鼠标可以在 CAD 内操作，对话框不消失，鼠标可以再次激化对话框

Contrl Bar 控制条，没用过

Options Tab 用过天正的就知道了，就是在 Options 中增加自己的设定

File Dialog Windows 风格的文件选择对话框

Palette Autocad 面板

设计对话框，首先选择上面的一种窗体，然后调整大小，接着选择左边的控件在窗体上拉出控件并调整大小

eachy · 发表于 2009-1-6 15:52:02

这是一个简单的插入图块程序设计过程，可以显示匿名块

eachy · 发表于 2009-1-6 16:00:14

对话框设计好了，接下来的工作就是指定每个控件的“事件（Events）”，也就是控件的动作，比如选择变化、双击、右击、取消、拖动等等。

这里首先要对窗体设置事件，然后对每个控件设计事件

eachy · 发表于 2009-1-6 16:01:25

对控件设置 “事件”

eachy · 发表于 2009-1-6 16:01:56

控件“事件”设置

eachy · 发表于 2009-1-6 16:03:11

事件设置完成，对话框就设置好了，接下来的工作就是将各个“事件”的控制命令复制到 lisp 文件中

carrot1983 · 发表于 2009-1-6 16:10:04

有中文版的教程。感觉就是舒服。。。
ea费心了

eachy · 发表于 2009-1-6 16:13:42

最后把文件保存为 lsp 文件，文件 -〉另存为，将后缀改为 lsp

xdto · 发表于 2009-1-6 16:14:00

终于有odcl的教程了。

eachy · 发表于 2009-1-6 16:14:43

这是保存后的文件，后面要将这个表加入到 Lisp 文件，作为一个变量

kytw · 发表于 2009-1-6 16:32:53

不错，还未学会

eachy · 发表于 2009-1-6 16:43:18

上面两项是基本的 Autolisp/Vlisp Lisp 内容，使用 OpenDCL 还要对 OpenDCL Runtime 加载，下面是 Stuido 的 Sample 中的代码，写的比较复杂

(defun LoadRunTime ( / )
;; Demand load the OpenDCL.##.ARX. This requires the OpenDCL Runtime or Studio to be installed on each PC first.
(cond
( (= 'EXRXSUBR (type dcl_getversionex)) )
( (= 2 (boole 1 (getvar "DEMANDLOAD") 2))
(command "OpenDCL")
(if (/= 'EXRXSUBR (type dcl_getversionex))
(progn
(alert "The OpenDCL Runtime module failed to load. Please repair the OpenDCL installation and try again.")
(exit)
)
)
)
( (progn
(alert "The OpenDCL Runtime module cannot be loaded because demand loading is disabled.\nLoad the OpenDCL ARX file manually, or enable demand loading for commands by setting the DEMANDLOAD system variable to 2 or 3.\nSee the "ManualLoading.lsp" sample for a demonstration.")
(exit)
)
)
)
)
(defun LoadODCLProj (proj / fn)
;; Call (dcl_PROJECT_LOAD with the <CONTROL>. No re-load, no ProjectAliasName
;; Note that without the re-load flag the ODCL is only loaded once, each time (dcl_PROJECT_LOAD is called it tests first if the sProject is already loaded.
(cond
;; Search the support paths for the .ODCL file & load it.
( (if (setq fn (findfile proj))
(dcl_PROJECT_LOAD fn)
))
;; Load the .ODCL file from the default installed "Samples" folder.
( (if
(or
(setq fn (vl-registry-read "HKEY_LOCAL_MACHINE\\SOFTWARE\\OpenDCL" "SamplesFolder")) ;_ 32-bit location
(setq fn (vl-registry-read "HKEY_LOCAL_MACHINE\\SOFTWARE\\Wow6432Node\\OpenDCL" "SamplesFolder")) ;_ 64-bit location
)
(dcl_PROJECT_LOAD (strcat fn proj))
))
;; The project failed to load, so report or log the error exit now (or take corrective action and try again)
(T (alert (strcat """ proj "" failed to load, you may need to add it to an Acad support path for it to load correctly!"))
(EXIT)
)
)
)
(princ)

(defun LoadRunTime ( / ) 
    ;; Demand load the OpenDCL.##.ARX. This requires the OpenDCL Runtime or Studio to be installed on each PC first. 
    (cond 
      ( (= 'EXRXSUBR (type dcl_getversionex)) ) 
      ( (= 2 (boole 1 (getvar "DEMANDLOAD") 2)) 
        (command "OpenDCL") 
        (if (/= 'EXRXSUBR (type dcl_getversionex)) 
          (progn 
            (alert "The OpenDCL Runtime module failed to load. Please repair the OpenDCL installation and try again.") 
            (exit) 
          ) 
        ) 
      ) 
      ( (progn 
          (alert "The OpenDCL Runtime module cannot be loaded because demand loading is disabled.\nLoad the OpenDCL ARX file manually, or enable demand loading for commands by setting the DEMANDLOAD system variable to 2 or 3.\nSee the "ManualLoading.lsp" sample for a demonstration.") 
          (exit) 
        ) 
      ) 
    ) 
) 
 
 
(defun LoadODCLProj (proj / fn) 
    ;; Call (dcl_PROJECT_LOAD with the <CONTROL>. No re-load, no ProjectAliasName 
    ;; Note that without the re-load flag the ODCL is only loaded once, each time (dcl_PROJECT_LOAD is called it tests first if the sProject is already loaded. 
    (cond 
      ;; Search the support paths for the .ODCL file & load it. 
       ( (if (setq fn (findfile proj)) 
           (dcl_PROJECT_LOAD fn) 
       )) 
      ;; Load the .ODCL file from the default installed "Samples" folder. 
       ( (if 
           (or 
             (setq fn (vl-registry-read "HKEY_LOCAL_MACHINE\\SOFTWARE\\OpenDCL" "SamplesFolder")) ;_ 32-bit location 
             (setq fn (vl-registry-read "HKEY_LOCAL_MACHINE\\SOFTWARE\\Wow6432Node\\OpenDCL" "SamplesFolder")) ;_ 64-bit location 
           ) 
           (dcl_PROJECT_LOAD (strcat fn proj)) 
       )) 
      ;; The project failed to load, so report or log the error exit now (or take corrective action and try again) 
      (T (alert (strcat """ proj "" failed to load, you may need to add it to an Acad support path for it to load correctly!")) 
        (EXIT) 
      ) 
    ) 
) 
 
 
(princ)

另外一个手动加载代码

;;; ManualLoading.lsp
;;; For OpenDCL Ver 4.0
;;; Edit kwb 20070225 GMT00:00:00
;;; Edit orw 20070518 GMT07:30:xx :: added 64 bit arx file selection
;;; returns "OpenDCL.x64.17.ARX"
;;; Last Edit kwb as suggested by MichaelP 20070608 GMT00:30:xx
;;; :: change location of dcl_GETVERSIONEX test.
;;
;; This code block loads the OpenDCL.##.arx files if not already loaded
;; Note, Loader will return T if loaded or nil otherwise.
;;
;; If the OpenDCL.##.arx is loaded at startup or demand loaded
;; this routine need never run.
(OR dcl_GETVERSIONEX
( (lambda ( / proc_arch arxname arxpath )
;; Determine the appropriate arx module for
;; the processor and the AutoCAD version.
(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"
)
)
;; Alert the user of a failure to:
;;
;; (A) Find the arxfile, or
;; (B) Load the arxfile.
;;
;; and return nil.
;;
;; Otherwise just quietly return t.
(cond
( (null (setq arxpath (findfile arxname)))
(alert (strcat "Couldn't find " arxname ".\nYou may need to add it to an Acad support path"))
)
( (null (arxload arxpath 'nil))
(alert (strcat "Failed to load " arxname "."))
)
( t )
)
)
)
)

;;; ManualLoading.lsp 
;;; For OpenDCL Ver 4.0 
;;; Edit kwb 20070225 GMT00:00:00 
;;; Edit orw 20070518 GMT07:30:xx :: added 64 bit arx file selection 
;;;                                       returns "OpenDCL.x64.17.ARX" 
;;; Last Edit kwb as suggested by MichaelP 20070608 GMT00:30:xx 
;;;                :: change location of dcl_GETVERSIONEX test. 
;; 
 
;; This code block loads the OpenDCL.##.arx files if not already loaded 
;; Note, Loader will return T if loaded or nil otherwise. 
;; 
;; If the OpenDCL.##.arx is loaded at startup or demand loaded 
;; this routine need never run. 
(OR dcl_GETVERSIONEX 
    (   (lambda ( / proc_arch arxname arxpath ) 
 
            ;;  Determine the appropriate arx module for 
            ;;  the processor and the AutoCAD version. 
 
            (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" 
                ) 
            )             
            ;;  Alert the user of a failure to: 
            ;; 
            ;;      (A) Find the arxfile, or 
            ;;      (B) Load the arxfile. 
            ;; 
            ;;      and return nil. 
            ;; 
            ;;  Otherwise just quietly return t. 
             
            (cond 
                (   (null (setq arxpath (findfile arxname))) 
                    (alert (strcat "Couldn't find " arxname ".\nYou may need to add it to an Acad support path")) 
                ) 
                (   (null (arxload arxpath 'nil)) 
                    (alert (strcat "Failed to load " arxname ".")) 
                ) 
                (   t   ) 
            ) 
        ) 
    ) 
)

这些代码就是自动查找符合 CAD 版本的OpenDCL ARX 并加载，看不懂没关系，下面我们进行简化

taner · 发表于 2009-1-6 16:50:38

顶！谁有中文版的HELP?贴一个

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

[原创]：实战 OpenDCL

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

相关帖子