[转贴]：对椭圆弧41号组代码的解释

aeo

对椭圆弧41号组代码的解释

本文件是DXF Issues Ellipse Group Codes的一部分
日期：22/06/00

问题：

在椭圆弧中，41号组代码是被描述为“开始参数”的。但看起来它并不与其它圆弧的已知值发生关联。这个值是怎么来的呢？


解决方法：
椭圆弧是一种具有偏离圆心的特殊类型的圆弧。创建这种类型圆弧的一个方法是找出起点的参数法线。做到这一点，必须指定一个与所绘圆弧的实际起始角不同的起始角。41号组代码包含这个用弧度表达的参数角。
什么是参数角？

参数角是由两个同心的圆产生的，这两个圆的圆心和半径就分别是椭圆的圆心和椭圆的长、短轴。椭圆上的每个点位于这两个圆上或它们之间，椭圆上的每个点可以通过和两个圆的唯一关系来定义。要找到这个关系，由椭圆上一点作一条与长轴垂直的直线，并得到与描述长轴的圆最近的交点。然后在短轴上做相同操作，从椭圆上的同一点开始，作与短轴垂直的直线，并得到直线与描述短轴的圆最近的交点。两个与圆的交点与椭圆的中心共线。过这三点的直线与长轴的夹角就是41号组代码指定的参数角。

如何从真正的起始角计算它？

要从真正的起始角计算参数角，必须首先在椭圆上找到起始点。这需要联立直线和椭圆的方程求解。在这个示例中，我们假设椭圆长轴在x轴上且椭圆中心在原点。当找到这个点后，就可以用它的y坐标值和短轴一起解出半径与短轴相等，圆心与椭圆中心相同的圆的方程。这就可以求出圆上的x、y点坐标，从而得到自椭圆中心的参数角。

下面是一个AutoLisp范例，它演示了如何使用三角方法来确定参数角：

(defun c:e_arc( / a b slope ang q1 q2 q3 q4 qmode x y a2)
       ;假设0，0点为椭圆中心，长轴在x方向
       (setq ang (getangle '(0.0 0.0) "Choose start angle: "))
       (setq a 1
                     b 0.5
                     slope (/ (sin ang) (cos ang))
                     q1 (/ pi 2.0)
                     q2 pi
                     q3 (/ (* 3 pi) 2.0)
                     q4 (* 2.0 pi)
                     qmode 'q1
       );setq

       (entmake (setq ent '((0 . "ELLIPSE")
                                                        (100 . "AcDbEntity")
                                                        (100 . "AcDbEllipse")
                                                        (10 0.0 0.0 0.0)
                                                        (11 1.0 0.0 0.0)
                                                        (40 . 0.5)
                                                        (62 . 1))
                     );setq
      );entmake

      ;直线方程是：y = mx + 0，m是斜率，0是y向截距
      ;椭圆方程是：x^2/a^2 + y^2/b^2 = 1
      ;联立直线和椭圆方程求出x和y值
      (setq y (/ (* a b slope) (sqrt (+ (* (* slope slope) (* a a)) (* b b)))))

      ; 短轴圆方程：x^2 + y^2 = b^2
      ; 解出y=上面计算值时的圆方程
      (setq x (sqrt (- (* b b) (* y y))))

      ;用三角法计算起始角
      (setq cos_a2 (/ x b)
                        sin_a2 (/ y b)
       );setq

      (if (/= cos_a2 0)
                  (setq a2 (atan (/ sin_a2 cos_a2)))
                  (setq a2 q1
                  qmode 'q1)
      );if

      ; 保持a2象限不变
      (cond ((and (> ang q1) (< ang q2))
                                    (setq a2 (- pi (abs a2))
                                                      qmode 'q2
                                    );setq
                  ); 语句1
                  ((and (> ang q2) (< ang q3))
                  (setq a2 (+ (abs a2) pi)
                                                      qmode 'q3
                                    );setq
                  );语句2
                  ((and (> ang q3) (< ang q4))
                  (setq a2 (abs (- (* 2 pi) (abs a2)))
                                                      qmode 'q4
                                    );setq
                  );语句3
                  ;特别位置：角度=0, 90, 180, 270或 360度
                  ((or (= ang 0) (= ang q1))
                              (setq qmode 'q1)
                  );语句4
                  ((= ang q2)
                              (setq a2 pi qmode 'q1)
                  );语句5
                  ((= ang q3)
                              (setq a2 (- (/ pi 2.0) pi) qmode 'q1)
                  );语句6
                              (t nil);缺省语句
            );cond
            (command "zoom" "c" "0,0" 3)
            (setq ent (append ent (list (cons 41 a2) (cons 42 (+ a2 (/ pi 2.0))))))
            (setq ent (subst '(62 . 5) (assoc 62 ent) ent))
            (entmake ent)

            (setq a2
                  (cond ((= qmode 'q1) a2)
                              ((= qmode 'q2) a2)
                              ((= qmode 'q3) (- a2 q4))
                              ((= qmode 'q4) (- a2 q4))
                              (t nil)
            );cond
            );setq
            (princ "\nParametric angle in radians: ")
            (princ a2)
            (princ "\nParametric angle in degrees: ")
            (princ (/ (* 180 a2) pi))
            (princ)
            );e_arc

aeo

计算并entmake椭圆弧（以lisp为例）



问题：

在椭圆弧中，41号组代码被描述为“开始参数”。
然而要定义它和圆弧已知值的关联却很困难。这个值是怎么来的呢？



解决方法：

椭圆弧是一种具有偏离圆心的特殊类型的圆弧。创建这种类型圆弧的一个方法是找出起点的参数法线。做到这一点，必须指定一个与所绘圆弧的实际起始角不同的起始角。41号组代码包含这个用弧度表达的参数角。
什么是参数角？

参数角是由两个同心的圆产生的，这两个圆的圆心和半径就分别是椭圆的圆心和椭圆的长、短轴。椭圆上的每个点位于这两个圆上或它们之间，椭圆上的每个点可以通过和两个圆的唯一关系来定义。要找到这个关系，由椭圆上一点作一条与长轴垂直的直线，并得到与描述长轴的圆最近的交点。然后在短轴上做相同操作，从椭圆上的同一点开始，作与短轴垂直的直线，并得到直线与描述短轴的圆最近的交点。两个与圆的交点与椭圆的中心共线。过这三点的直线与长轴的夹角就是41号组代码指定的参数角。

如何从真正的起始角计算它？

要从真正的起始角计算参数角，必须首先在椭圆上找到起始点。这需要联立直线和椭圆的方程求解。在这个示例中，我们假设椭圆长轴在x轴上且椭圆中心在原点。当找到这个点后，就可以用它的y坐标值和短轴一起解出半径与短轴相等，圆心与椭圆中心相同的圆的方程。这就可以求出圆上的x、y点坐标，从而得到自椭圆中心的参数角。

下面是一个AutoLisp范例，它演示了如何使用三角方法来确定参数角：

(defun c:e_arc( / a b slope ang q1 q2 q3 q4 qmode x y a2)
       ;假设0，0点为椭圆中心，长轴在x方向
       (setq ang (getangle '(0.0 0.0) "Choose start angle: "))
       (setq a 1
                     b 0.5
                     slope (/ (sin ang) (cos ang))
                     q1 (/ pi 2.0)
                     q2 pi
                     q3 (/ (* 3 pi) 2.0)
                     q4 (* 2.0 pi)
                     qmode 'q1
       );setq

       (entmake (setq ent '((0 . "ELLIPSE")
                                                        (100 . "AcDbEntity")
                                                        (100 . "AcDbEllipse")
                                                        (10 0.0 0.0 0.0)
                                                        (11 1.0 0.0 0.0)
                                                        (40 . 0.5)
                                                        (62 . 1))
                     );setq
      );entmake

      ;直线方程是：y = mx + 0，m是斜率，0是y向截距
      ;椭圆方程是：x^2/a^2 + y^2/b^2 = 1
      ;联立直线和椭圆方程求出x和y值
      (setq y (/ (* a b slope) (sqrt (+ (* (* slope slope) (* a a)) (* b b)))))

      ; 短轴圆方程：x^2 + y^2 = b^2
      ; 解出y=上面计算值时的圆方程
      (setq x (sqrt (- (* b b) (* y y))))

      ;用三角法计算起始角
      (setq cos_a2 (/ x b)
                        sin_a2 (/ y b)
       );setq

      (if (/= cos_a2 0)
                  (setq a2 (atan (/ sin_a2 cos_a2)))
                  (setq a2 q1
                  qmode 'q1)
      );if

      ; 保持a2象限不变
      (cond ((and (> ang q1) (< ang q2))
                                    (setq a2 (- pi (abs a2))
                                                      qmode 'q2
                                    );setq
                  ); 语句1
                  ((and (> ang q2) (< ang q3))
                  (setq a2 (+ (abs a2) pi)
                                                      qmode 'q3
                                    );setq
                  );语句2
                  ((and (> ang q3) (< ang q4))
                  (setq a2 (abs (- (* 2 pi) (abs a2)))
                                                      qmode 'q4
                                    );setq
                  );语句3
                  ;特别位置：角度=0, 90, 180, 270或 360度
                  ((or (= ang 0) (= ang q1))
                              (setq qmode 'q1)
                  );语句4
                  ((= ang q2)
                              (setq a2 pi qmode 'q1)
                  );语句5
                  ((= ang q3)
                              (setq a2 (- (/ pi 2.0) pi) qmode 'q1)
                  );语句6
                              (t nil);缺省语句
            );cond
            (command "zoom" "c" "0,0" 3)
            (setq ent (append ent (list (cons 41 a2) (cons 42 (+ a2 (/ pi 2.0))))))
            (setq ent (subst '(62 . 5) (assoc 62 ent) ent))
            (entmake ent)

            (setq a2
                  (cond ((= qmode 'q1) a2)
                              ((= qmode 'q2) a2)
                              ((= qmode 'q3) (- a2 q4))
                              ((= qmode 'q4) (- a2 q4))
                              (t nil)
            );cond
            );setq
            (princ "\nParametric angle in radians: ")
            (princ a2)
            (princ "\nParametric angle in degrees: ")
            (princ (/ (* 180 a2) pi))
            (princ)
            );e_arc

aeo

问题：

为什么“AutoLISP Fix”功能有时会返回错误结果？
当获得一个优化多段线端点的Z坐标并把它修正为最近整数时，偶尔返回错误的结果。例如，如果返回值为50.0，在某些情况下返回值为49。



解决方法：

这个例子证明了一个不可避免的内在精度问题。有时AutoCAD的16位有效数字不能计算一些被修正的数字的浮点部分。
例如：AutoCAD通过指定的多段线顶点返回一个值为50.0。然而，下面的操作指出了正确的数值是不同的。

(setq num (- 50 zvalue))
(rtos num 2 16)

这里显示了一个“0.0000000000000071”的差异。因此，在数字浮点部分中有一个小的区别。这个区别导致了从（fix）中返回49。这因为实际值为49.9999999999999928，但只在（fix）命令检查小数值时所有的16位数才会检查到。另外，AutoCAD只检查14位小数位（i.e., 49.99999999999999）并循环数值到50.0。

工作区将比较返回值和解释值，并根据结果修正所要的数值：

(if (= num (atof (rtos num)))
(fix num)
(fix (atof (rtos num)))
)

aeo

如何得到“文件”-“打开”对话框的缺省路径?

问题：

“文件”-“打开”对话框的缺省目录的变量存在什么地方？可以访问它吗？这样，用户就可以从其他目录中打开图形。


解决方法：

通过使用这两个系统变量DWGNAME和DWGPREFIX，可以在编辑器中获得当前图形的信息：DWGNAME包含图形名，包括.DWG扩展名。DWGPREFIX包含图形所在的位置。结合这些系统变量可以得到当前图形全名。
DWGPREFIX不能始终包含“文件”-“打开”对话框的缺省目录。实际上，它缺省的是最后打开的图形路径，哪怕这个文件已经关闭。注意也有例外：从历史列表中打开的AutoCAD不会改变“文件”-“打开”的缺省路径。退出时AutoCAD在Windows注册表KEY内记录这些信息，并在启动时读取它作为历史文件列表。

HKEY_CURRENT_USER\\Software\\Autodesk\\AutoCAD\\R15.0\\ACAD-1:409\\Recent File List

当AutoCAD运行时，在注册表中不能更新这些信息；因此，使用下面的VLISP表达式来获得这些信息是不实际的。

(vl-registry-read
HKEY_CURRENT_USER\\Software\\Autodesk\\AutoCAD\\R15.0\\ACAD-1:409\\Recent File List File1)

同样，不能随心所欲的设置最近打开的文件路径，因为AutoCAD在内存中保存了这些信息，因此，这个信息不能从系统变量或API中获得。

幸运的是，可以用下面的简单的AutoLISP表达式来模拟AutoCAD OPEN命令，或者编写自己的OPEN命令。

(getfiled Select File“c:/program files/acad2000” “dwg” 8)

aeo

在最后位置显示dcl对话框



问题：

可不可以使DCL对话框在最后关闭时的位置显示，而不是总在屏幕中间将其打开。


解决方法：

可以，只需要提供对话框最后位置的坐标即可，此坐标可以通过done-dialog返回，并被new-dialog调用。下面的lisp代码演示了此过程，请确认DCL文件在AutoCAD的查找路径中。
(defun C:Move_the_DCL (/ dcl_id notenum1)

;; 1) ;如果Move_DCL.DCl文件对话框在路径中，加载它
(setq DCLFileName "Move_DCL.dcl")

     (setq DCLfile (findfile DCLFileName))
     (if (null DCLfile)
                    (progn
                         (alert (strcat "\nDCL file: " DCLFileName " was Not Found !
Exiting."))
                         (exit)
                    )
     )

     (setq dcl_id (load_dialog DCLfile))

;; ;检查加载是否成功，如果成功，显示最后的对话框位置。
     (if lastpt
               (if (not (new_dialog "note" dcl_id "3" lastpt)) (progn (alert (strcat
"\nDCL file: " DCLFileName " was Not Found ! Exiting.")) (exit)) )
               (if (not (new_dialog "note" dcl_id "3" '(-1 -1))) (exit))
     )

;; 2) 为返回DCL的值/关键字进行设置

(action_tile "cancel" "(done_dialog) (setq gperr \"\")(exit)")

(action_tile "accept"
               (strcat "(progn (setq ChkBoxReturnValue (atoi (get_tile \"note1\")))"
                    " (setq lastpt (done_dialog)))"
                    )
     )

;; 3)现在启动对话框
     (start_dialog)

;; 4) 卸载对话框

     (unload_dialog dcl_id)

;; 打印出返回值

     (if ChkReturnValue
               (progn (princ "\nThe ChkBoxReturnValue is: ") (princ ChkBoxReturnValue))
     )
     (if lastpt
               (progn (princ "\nDialogue Box Location: ") (princ (car lastpt)) (princ ",
") (princ (cadr lastpt)) )
     )
(princ)
     )
     (princ "\nLoaded Move_DCL.lsp, type Move_the_DCL to run.")
(princ)

Lisp文件使用的DCL对话框：
     note : dialog {
          label = "Simple Dialog Example";
          : boxed_column {
                    alignment = centered;
                    children_alignment = centered;
               :text {
                    alignment = centered;
                    is_bold = true;
                    key = "label1";
                    label = "This is a Centered Label";
                    width = 8;
               }
               : spacer { width = 1; }
          : row {
               : spacer { width = 1; }
               :toggle {
                    label = "Note Number 1";
                    key = "note1";
                    mnemonic = "C";
                    alignment = right;
               }
               }
               : spacer { width = 1; }
               }
          : row { // 定义OK/Cancel 按钮行
                    : spacer { width = 1; }
                    : button {           // 定义OK按钮

                                                  label = "OK";
                                                  key = "accept";
                                                  width = 8;
                                                  fixed_width = true;
                                        }
                      : button {           // 定义Cancel按钮
                                                  label = "Cancel";
                                                  is_cancel = true;
                                                  key = "cancel";
                                                  width = 8;
                                                  fixed_width = true;
                                         }
                    }
}

aeo

1.

aeo

问：能够给AutoCAD的VBA宏传递参数吗？

答：从AutoCAD直接传递参数到一个VBA宏中是不可能的。但是你可以用VBA的GetString方法和LISP的(command)函数来传递信息。

    举例：
    首先定义一个VBA宏：
Sub testparams()
   Dim str, str2 As String
   str=ThisDrawing.Utility.GetString(False)
   str2=ThisDrawing.Utility.GetString(False)

   MsgBox str
   MsgBox str2
End Sub

    然后用以下LISP语句调用此宏：
(command "-VBARUN" "testparams" "param1" "param2")



--------------------------------------------------------------------------------

问：.MNU和.LSP文件的调用顺序是怎样的？

答：他们在AutoCAD 2000的调用顺序是这样的：
  当AutoCAD启动时：
       - acadr2000.lsp
       - acad.lsp
  对于每个新打开的文档：
       - acad.lsp, 如果在AutoCAD的配置对话框中的系统标签下做了相应的选项设定。
       - acaddoc2000.lsp
       - acaddoc.lsp
       - .MNU菜单文件和它们的关联.MNL文件。



--------------------------------------------------------------------------------

问：我已经写了一个VisualLisp函数和一个VBA宏。这个VBA宏显示一个对话框，并且有一些按钮允许有用户输入（例如：输入一个字符串）。现在我从VisualLisp用(vl-vbarun)调用这个VBA宏。当AutoCAD执行到这一行时，LISP停在这一行。但是一旦我在此宏中使用了一个用户输入函数，LISP就不等VBA对话框出现，而继续执行下面的LISP函数。有些时候甚至首先执行LISP的输入函数，然后再执行VBA宏中的输入语句。怎样才能使我的LISP函数和VBA宏同步？

答：现在只有一个解决办法。在你的LISP函数中(vl-vbarun) 函数必须最后调用。当关闭VBA对话框或者从VBA宏中返回时，你得调用另一个你想继续执行的LISP函数。你可以象下面这样做。

    首先：你需要一个LISP函数调用这个VBA宏：

(defun c:test ()
  ;; Call a VBA macro which displays
  ;; a dialog and writes a file.
  (vl-vbarun "test")

  ;;If you uncomment the following line, then AutoCAD will prompt you
  ;;to select an entity first, input a string second.
  ;;(entsel)

  (princ)
)

    然后你需要第二个LISP函数以供你的VBA宏返回时调用：

(defun c:test_cont ()
;; Here you can continue.
(print " I am continuing.")
(princ)
)

    以下是这个VBA宏的示例：

Sub test()
' Show a dialog which uses some
' user input functions.
UserForm1.Show

' Call the lisp function which should
' be now executed.

' You can use the SendCommand method:
' ThisDrawing.SendCommand ("test_cont ")
' or use the ActiveX interface of VisualLisp:

' In order to use it, please remember to reference vl.tlb file which is in Acad2000 folder
' into your VBA project and execute (vl-load-com) on the AutoCAD command line first.

Dim vl As Object
Set vl = CreateObject("VL.Application.1")

vl.ActiveDocument.functions.Item("c:test_cont").funcall
End Sub



--------------------------------------------------------------------------------

问：怎样用Visual Basic生成一个用户接口模块以供Visual LISP方便地调用？

答：最简单和最有效的方法是为AutoCAD写一个内过程(in-process)的自动客户(Automation Client)。例如：一个VB ActiveX DLL。这个DLL 以后可以从 Visual LISP, VBA, Java (通过Automation)和ObjectARX加载。它可以是一个AutoCAD的自动客户，也可以是一个任何的自动服务器( Automation server)，或者多重服务器。

1. 启动Visual Basic 5 or 6；
2. 在New Project Wizard中选择ActiveX DLL；
3. 把工程名改为"MyProject"；
4. 在工程中有一个缺省的类模块，把它的名称改为"MyClass"；
5. 添加一个函数或者子例程到类模块中。例如：

' This function takes two arguments, and will return a list of data to the calling function
Public Function MyFn(ByRef arg1 as Integer, ByRef arg2 as Double) As Variant
  myForm.Show vbModal
  ' Create a list of items to return to the caller (the items are in this case purely arbitrary)
  MyFn = Array(1.0,"Arbitrary string",2)
End Function

（这里，myForm是一个你必须添加到工程中的表格。同时切记MyFn是一个函数，它将返回一个值或者一组值给调用例程。）

6. 点取File -

Make MyProject.dll。这就会生成一个DLL并且把它注册为COM。（如果你想在其他机器上运行此DLL，你需要首先确认在所有的机器上安装并注册了这个DLL。这通常需要你用Visual Basic生成一个安装包。）
7. 如果你想从Visual LISP中使用此DLL,你需要定义一个简单的函数，并且把他加载到AutoCAD中：

(defun showDialog (/ acadApp vbApp retVal retList)
;; required in AutoCAD 2000, not R14
(if (car (atoms-family 1 '("vl-load-com"))) (vl-load-com))
;; get the main AutoCAD application object
(setq acadApp (vlax-get-acad-object))
;; load VB ActiveX DLL into AutoCAD's address space (either line will work)
;;(setq vbApp (vlax-invoke acadApp "GetInterfaceObject" "MyProject.MyClass")
(setq vbApp (vla-GetInterfaceObject acadApp "MyProject.MyClass"))
(if (not vbApp)
   (princ "\nError loading ActiveX DLL.")
   (vlax-invoke vbApp "MyFn"
                       7        ; arg1, an integer
                       1.5      ; arg2, a 'double'
   )
)
)

    为了调用已经暴露出的ActiveX方法，在命令行上输入：

(showDialog)

    将把下列内容返回给AutoCAD：

(1.0 "Arbitrary string" 2)

    你会发现你可以给VB对话框传递参数并且在AutoCAD中处理返回值。这对于生成选项对话框非常有用，因为有些参数需要初始化并且修改后的值需要返回给AutoCAD。
7. 如果你想从VBA使用这个DLL，你需要把此DLL添加到引用中。（用COM注册它，就会把它添加到ActiveX 服务器的列表中。然后它就可以被VBA引用，不然就请浏览并且选择MyProject.dll。）
8. 然后你就可以用下面的机制加载这个内过程 ActiveX DLL，并且调用其中的函数：

Sub MyVBAProject()
Dim oMyApp as Object
dim vReturn as Variant
set oMyApp = ThisDrawing.Application.GetInterfaceObject( "MyProject.MyClass"
)
vReturn = oMyApp.MyFn(7,1.5)
End Sub



--------------------------------------------------------------------------------

问：可以在VBA中获得带有预览图象的AutoCAD "Open File Dialog"对话框吗？

答：在VBA没有直接的方法这样做。但是，你可以通过LISP和AutoCAD之间的通讯来完成。在LISP中有一个名叫getfiled的函数，它可以预览DWG并且与AutoCAD的"Open File Dialog"表现一样。
    首先，通过SendCommand方法发送getfiled表达式给AutoCAD命令行并且定义一个系统变量USERS1以保存文件名。然后，你可以用GetVariable方法获得这个系统变量。最后，象使用其它任何变量一样使用它。

Public Sub OpenDialog()
Dim fileName As String
ThisDrawing.SendCommand "(setvar " & """users1""" & "(getfiled " & """Select a DWG File""" & """c:/program files/acad2000/""" & """dwg""" & "8)) "
fileName = ThisDrawing.GetVariable("users1")
MsgBox "You have selected " & fileName & "!!!", , "File Message"
End Sub
  



--------------------------------------------------------------------------------

问： 如何在AutoLISP调用完一个VBA宏后，卸载包含它的VBA工程？我想首先加载这个工程，调用一个宏，然后卸载它。下面是我使用的代码，但是VBAUNLOAD在Test宏结束之前被发送到命令行。

  (command "-VBARUN" "Test")
  (command "vbaunload")

答：主要的问题是你的宏当中有要求用户输入的语句，这时LISP试图执行下一条命令，即VBAUNLOAD。我们需要等待LISP语句执行完毕，或者让LISP在调用VBARUN命令后什么也不做，而让VBA卸载它自己。下面是这两种方法：

1) 在LISP中等待。

(defun c:RunMacro( / oldFileDia oldCmdEcho)
  (setq oldFileDia (getvar "FILEDIA")
         oldCmdEcho (getvar "CMDECHO")
  )
  (setvar "FILEDIA" 0)
  (setvar "CMDECHO" 0)
  (command "_VBALOAD" "c:\\test.dvb")
  (command "_-VBARUN" "Test")
  (while (= "-VBARUN" (getvar "CMDNAMES"))
        (command pause)
  )
  (command "_VBAUNLOAD")
  (setvar "FILEDIA" oldFileDia)
  (setvar "CMDECHO" oldCmdEcho)
  (princ)
)

2) VBA中自动卸载。

    你可以使VBA代码强制卸载它自己。在你的宏的最后（例如：UserForm_Terminate()），使用下列代码可以达到此目的：

   AppActivate ThisDrawing.Application.Caption
   SendKeys "_VBAUNLOAD" + Chr$(13)

    以上的代码在AutoCAD R14.01中工作良好，但是AutoCAD 2000允许加载多个工程。相应地，VBAUNLOAD增加了一个额外参数。有两个新的函数可以加载和运行VBA 代码：(vl-vbaload)和(vl-vbarun)。你可以通过在宏名中指定工程名字把这两种操作联合在一起。

(defun c:RunMacro2000( / oldFileDia oldCmdEcho)
  (setq oldFileDia (getvar "FILEDIA")
         oldCmdEcho (getvar "CMDECHO")
  )
  (setvar "FILEDIA" 0)
  (setvar "CMDECHO" 0)
  (vl-vbarun "c:\\test.dvb!Test")
  (while (= "-VBARUN" (getvar "CMDNAMES"))
        (command pause)
  )
  (command "VBAUNLOAD" "c:\\test.dvb")
  (setvar "FILEDIA" oldFileDia)
  (setvar "CMDECHO" oldCmdEcho)
  (princ)
)

    第二种方法也需要做一些小的改动。我们可以通过自动接口向AutoCAD发送命令，并且这比SendKeys更安全：

   ThisDrawing.SendCommand "_VBAUNLOAD C:\TEST.DVB" + Chr$(13)

    如果我们卸载另一个工程，我们可以使用自动接口 (ThisDrawing.Application.UnloadDVB "test.dvb" )。但是在这种情况下我们需要使用SendKeys或SendCommand来卸载其本身。
  



--------------------------------------------------------------------------------

问：在R13中，我可以通过检查DWK文件知道DWG文件是否被锁定了。在R14中，没有一个ARX函数来检查文件锁定状态。有什么其它办法吗？

答：因为我们现在使用了操作系统支持的文件锁定方式，你可以通过用_fsopen()打开图形文件来检查文件是否锁定。使用模式"r+"和共享标志SH_DENYWR，如果失败，这个图形就已经被打开并且是写的状态。如果成功，千万不要忘记关闭此文件，然后再让AutoCAD打开它。
    同时你也需要检查.DWK文件，因为这个文件也可能被另外的R13例程所打开。
2) 用LISP运行一些VBA代码打开这个文件，通过一个系统变量返回一个成功或者失败标志给LISP。例如：下面的VBA代码可以做这件事情。

Sub Test_File_Data()
Dim FileNum As Integer
Dim MyFileName As String
Dim sysVarName As String
Dim sysVarData As Variant

On Error GoTo ErrHandler

FileNum = 1
MyFileName = "D:\PROGRAM FILES\AUTOCAD R14\ARCTEXT.DWG"
sysVarName = "USERI1"
sysVarData = 0
ThisDrawing.SetVariable sysVarName, sysVarData

Open MyFileName For Binary Access Read Lock Read Write As FileNum
Close 1
sysVarData = 1
ThisDrawing.SetVariable sysVarName, sysVarData

Exit Sub

ErrHandler:
MsgBox "Error Number = " & Err.Number
MsgBox "Error Description = " & Err.Description
Err.Clear
sysVarData = 0
ThisDrawing.SetVariable sysVarName, sysVarData

End Sub



--------------------------------------------------------------------------------

问：有什么方法可以检测一个VBA宏是否加载？

答：在AutoCAD 2000中，你可以获取一个属性名叫VBE的ActiveX应用程序对象。它使你可以访问VBAIDE扩展对象。这个对象拥有方法和属性允许你判断一个工程是否已经加载。
    如果你想深入学习，就请启动VBAIDE，添加一个对"Microsoft Visual Basic for Applications Extensibility"的引用，然后你就可以在你的ObjectBrowser (F2)浏览此对象了。
以下是四个例子。第一个"loadMyProcedure"检测所有已经加载的工程名。如果没有发现"TestMenuEcho"，就加载它。
    第二个例子"testMacros"在每一个加载的模块中搜索每一行并且在立即窗口中 (cntrl + G)打印true或者false。目的在于寻找文本"test4"（宏的名字)。
    第三个例子"displayLoadedProjects"在信息窗口中显示所有已加载的工程。
    第四个例子是一个LISP例程。它使用相同的ActiveX对象判断一个工程是否已经加载，如果没有，就加载它。

Public Sub loadMyProcedure()
Dim int1 As Integer
Dim bProjectLoaded As Boolean

' Iterate through all the projects
For int1 = 1 To Application.VBE.VBProjects.Count

     ' Make the test boolean variable to true if the Project I want to load
     ' is already loaded, Change TestMenuEcho to the name of your project
     If Application.VBE.VBProjects(int1).Name = "TestMenuEcho" Then

        ' Debug.Print Application.VBE.VBProjects(int1).Name
         bProjectLoaded = True

     End If

Next int1

' Display a message if my the project is already loaded
' if it isn't then load it, change the directory and
' name to that of your project
If bProjectLoaded = True Then

     MsgBox "TestMenuEcho is already loaded"

Else

     MsgBox "Going to load the project TestMenuEcho"
     Application.LoadDVB "D:\Vba-apps\a-2000\menuecho in menu.dvb"

End If

End Sub
  

Public Sub testMacros()
Dim int1 As Integer
Dim int2 As Integer

' Iterate through all the loaded projects
For int1 = 1 To Application.VBE.VBProjects.Count
     ' Name of loaded project
     Debug.Print Application.VBE.VBProjects(int1).Name

     ' Iterate through the text of each module looking for "test4"
     For int2 = 1 To Application.VBE.VBProjects(int1).VBComponents.Count

         ' Get the number of lines in each module - use in the
         ' find method below
         Dim L As Long
         L = Application.VBE.VBProjects(int1).VBComponents(int2) _
         .CodeModule.CountOfLines

         Debug.Print Application.VBE.VBProjects(int1).VBComponents(int2) _
         .CodeModule.Find("test4", 1, 1, L, 1, False, False)
     Next int2

Next int1

End Sub
  

Public Sub displayLoadedProjects()
Dim strProjectNames
Dim int1 As Integer

strProjectNames = "Names of loaded projects " & vbCrLf

For int1 = 1 To Application.VBE.VBProjects.Count
   strProjectNames = strProjectNames + Application.VBE.VBProjects(int1).Name & vbCrLf
Next int1

MsgBox strProjectNames

End Sub

(defun c:loadMyProject ()
;; This routine will load a project if it is not already loaded
;; the VBE (VB extensibility) ActiveX object is used to reference
;; the loaded projects

;; Load ActiveX  
(vl-load-com)

;; Get the VBE extisibility object  
(setq acadObject (vlax-get-acad-object))
(setq acadVbe (vla-get-vbe acadObject))
(setq acadVbeProjects (vlax-get-property acadVbe 'VBProjects))

;; Get the number of loaded VBA projects
(setq int1 (vlax-get-property acadVbeProjects 'count))

;; Counter and test variable named loaded  
(setq int2 1)
(setq loaded "False")

;; Repeat for each project  
(repeat int1

;; Itereate through the projects, getting the name of
;; next project, each time through  
(setq Item (vlax-invoke-method acadVbeProjects 'Item int2))
(setq pName (vlax-get-property Item 'Name))
  

;; Test the name for the name of the project I want to load
;; If it is already loaded the set the test variable to True
(if (= pName "my_test_project")

  (progn
     (prompt "\nmy_test_project is already loaded\n")

     (Setq Loaded "True")

  )

)
;; Increment the number used to get the next Project
(setq int2 (+ int2 1))

)

;; Load project if it is not already loaded by testing
;; the Loaded variable
(if (= Loaded "False")
(progn
  (princ "\nLoading my_test_project")
  (command "-VBALOAD"
            "D:/vba-apps/a-2000/already loaded test.dvb"
  )
)

aeo

问：我想对一个圆弧进行操作。但是当我运行下面的VBA宏时，出现一个编号为451的运行错误。它的意思是‘对象不是一个集合’。这是一个关于变体型数组(Variant Array)的常见VBA问题吗？有什么方法可以解决？

Sub showArcPoints()
    Dim oEnt As Object
    For Each oEnt In ThisDrawing.ModelSpace
        If (TypeOf oEnt Is AcadArc) Then
            ' This causes Runtime error 451 - Object Not a Collection
            ' if oEnt is not late bound it works ok
            MsgBox "StartPoint(0) is =" & oEnt.StartPoint(0)
        End If
    Next
End Sub

答：当VBA从一个一般对象返回变体型数组的时候，如果这个对象是晚束缚（late bound）的话，VBA不能通过这个对象的属性返回数组的一个元素。如果这个对象是早束缚（early bound）的话，那么就不受限制。
有两种办法可以解决这个问题。其一、用AcadArc 来对此对象进行早束缚。修改好的代码如下：

Sub showArcPoints()
    Dim oEnt As Object
    Dim oArc As AcadArc
    For Each oEnt In ThisDrawing.ModelSpace
        If (TypeOf oEnt Is AcadArc) Then
            'This works well since it is early bound.
            Set oArc = oEnt
            MsgBox "StartPoint(0) = " & oArc.StartPoint(0)
        End If
    Next
End Sub

其二、声明一个临时的变体型变量并且把它设置为需要操作的对象属性。修改的代码如下：

Sub showArcPoints()
    Dim oEnt As Object
    For Each oEnt In ThisDrawing.ModelSpace
        If (TypeOf oEnt Is AcadArc) Then
            'This also works well.
            Dim pv_temp As Variant
            pv_temp = oEnt.StartPoint
            MsgBox "StartPoint(0) = " & pv_temp(0)
        End If
    Next
End Sub

问：我想在VBA中使用Microsoft的DAO。如何使用？

答：请注意DAO并不是随VBA提供的。所以首先你必须确认DAO在所有需要它运行的机器上正确安装。并且你得使用相应的Microsoft方法来获得DAO的使用许可，然后才可以使用。你会发现位于Microsoft网站上的这篇文档也许有用：
http://msdn.microsoft.com/library/techart/msdn_redistmdac.htm
根据不同版本的DAO安装在不同版本的AutoCAD上，安装程序将覆盖一个MFC DLL文件MFC42.DLL。这可能引起AutoCAD或者其他的应用程序的一些问题。所以请小心对待。如果你已经正确安装了DAO，下列的VBA代码应该运行良好。这是一个用VBA在AutoCAD中访问Microsoft Access MDB数据库的例子。

Private Sub CommandButton1_Click()

    Dim daoWs As Workspace
    Dim daoDb As Database
    Dim daoRs As Recordset
    Dim daoFields As Fields

    Dim recordValue As String

    ' Create a DAO workspace object
    Set daoWs = CreateWorkspace("", "admin", "", dbUseJet)

    ' Open a MDB file (and get a database object)
    Set daoDb = daoWs.OpenDatabase("")

    ' Get a recordset from the database
    Set daoRs = daoDb.OpenRecordset("")

    ' Move to the first record in this set
    daoRs.MoveFirst

    ' Get all fields from the first record
    Set daoFields = daoRs.Fields

    ' Get the value from one field.
    ' For the index you can use an integer
    ' or the name of the table field.
    recordValue = daoFields("")
  

    MsgBox ("Value: " & recordValue)

    '
    ' Close every DAO object
    '

    ' Close the recordset object
    daoRs.Close
    ' Close the database object
    daoDb.Close
    ' Close the workspace object
    daoWs.Close

End Sub

问：我怎样在AutoCAD中调用具有参数的VBA函数？我知道VB/A宏没有参数。Microsoft就是这样设计的。然而，VB/A函数可以带参数。我想知道是否存在命令行或者LISP的一种途径来调用VBA函数以便从AutoCAD传递必需的参数。

答：在AutoCAD R14中， 这是不可能的。但是在AutoCAD 2000利用VBASTMT命令可以完成这项任务。这种方法仅当所调用的函数（f_test）定义在一个VBA模块中，而不是在ThisDrawing对象中有效。以下的例子说明如何具体去做。这个函数需要一个字符串参数。

Function f_test(ByVal sCommand As String)
  MsgBox "This was sent from the AutoCAD Command Line: " & sCommand
End Function

在AutoCAD命令行，用VBASTMT命令。

Command: vbastmt
Expression: f_test "line 1,1 5,5  "

或者用以下的LISP代码：

(command "vbastmt" "f_test \"line 1,1 5,5  \"")

问：块（Block）对象的AddDimAligned方法创建不正确的标注（Dimension）对象。我怎样才能正确地添加一个标注（Dimension）实体到一个块（Block）对象中?

答：块对象的AddDimAligned方法和其它的AddDimxxx方法导致添加的标注实体不正确。这是已知的一个AutoCAD缺陷。然而，下面的方法可以克服这个缺陷。首先，在模型空间中生成一个标注实体，拷贝这个实体到所需块对象中，最后，删掉原始的标注实体。以下的事例代码生成一个块"test"，然后添加了一个DimRotated实体到块中，最后把这个块插入到模型空间中。

Sub f_SolAddDiminBlocks()
'Work around for Adding dimensions to block AutoCAD 2000
Dim po_rotDim As AcadDimAligned
Dim po_block As AcadBlock
Dim pd_ext1(0 To 2) As Double
Dim pd_ext2(0 To 2) As Double
Dim pd_lineLoc(0 To 2) As Double
Dim po_array(0) As Object

pd_ext1(0) = 3: pd_ext1(1) = 3: pd_ext1(2) = 0
pd_ext2(0) = 10: pd_ext2(1) = 3: pd_ext2(2) = 0
pd_lineLoc(0) = 5: pd_lineLoc(1) = 4: pd_lineLoc(2) = 0
'create dimeionsion object
Set po_rotDim = ThisDrawing.ModelSpace.AddDimAligned(pd_ext1, pd_ext2, pd_lineLoc)

'create a new block by name test
Set po_block = ThisDrawing.Blocks.Add(pd_ext1, "test")
'insert a block reference
ThisDrawing.ModelSpace.InsertBlock pd_ext1, "test", 1, 1, 1, 0

'copy dimension object
Set po_array(0) = po_rotDim
ThisDrawing.CopyObjects po_array, po_block
po_rotDim.Delete

'release the references
Set po_block = Nothing
Set po_rotDim = Nothing
End Sub

问：怎样才能获得当前配置的AutoCAD绘图仪列表？

答：下面的VBA函数列举出所有的PC3的绘图仪。你可以在你的应用程序中使用它。

Public Function GetPlotters() As Collection
    Set GetPlotters = New Collection
    Dim strPlotter As String
    strPlotter = Dir(Application.Preferences.Files.PrinterConfigPath + "\*.pc3")
    While Not strPlotter = ""
        GetPlotters.Add strPlotter
        strPlotter = Dir
    Wend
End Function

有一个方法用来枚举所有的系统打印机。这些打印机在AutoCAD的绘图对话框中也可以使用。请参看Microsoft知识库文档： Q166008 在以下的网页：
http://support.microsoft.com/search/default.asp

lsjjm

AutoCAD<=>VBA传递参数hai可以用:
ThisDrawing.setvariable "Users1", textbox1.text
(vla-getvariable thisdrawing "Users1")