[原创]：一个结合Lisp的拖动例子

雪山飞狐(lzh)

Lisp函数：，先导入一下
(defun Drag( pBlock / ppnt ed ped)
(defun GetPoint( / a pnt )
  (setq a (grread t))
  (setq pnt (list 0 0 1))
  (if (= 3 (car a)) (setq pnt (list 0 0 -1)))
  (if (= 5 (car a)) (setq pnt (cadr a)))
  pnt
)
  (while (not (= (caddr (setq ppnt (GetPoint)))  -1))
  (setq ed (entget (handent pBlock)))
  (setq ped (list 10 (car ppnt) (cadr ppnt) (caddr ppnt)))
  (setq ed (subst ped (assoc 10 ed) ed))
  (entmod ed)
  )
)
测试（由于拖动在Lisp中做好了，不需频繁调用Vlax类，应该不会使AutoCad崩溃）：
Sub Test()
    Dim obj As VLAX
    Dim c(2) As Double
    Dim pObj As AcadBlockReference
    Set obj = New VLAX
    Set pObj = ThisDrawing.ModelSpace.InsertBlock(c, "123", 1, 1, 1, 0)
    a = "(drag " & Chr(34) & pObj.Handle & Chr(34) & ")"
    obj.EvalLispExpression (a)
    Set obj = Nothing
End Sub

lijiao

Sendcommand即可，不用如此繁琐。

雪山飞狐(lzh)

Sendcommand容易使程序产生混乱

改良版（不需导入Lisp函数）

Public Sub BlockInsert(Name As String)
    Dim pLisp As String
    Dim obj As VLAX
    Dim pnt(2) As Double
    Set obj = New VLAX
    Set pObj = ThisDrawing.ModelSpace.InsertBlock(pnt, Name, 1, 1, 1, 0)
    obj.EvalLispExpression "(setq ed (entget (handent " & ToStr(pObj.Handle) & ")))"
    pLisp = "(while (not (= (caddr " & _
            "(setq pTime (grread t) " & _
                  "pSt (car pTime) " & _
                  "pnt (cond ((= pSt 3) (List 0 0 -1)) ((= pSt 5) (cadr pTime)) (t (List 0 0 1)))))  -1)) " & _
            "(setq ed (subst (cons 10 pnt) (assoc 10 ed) ed)) " & _
            "(entmod ed) " & _
            ") "
    obj.EvalLispExpression pLisp
    Set obj = Nothing
End Sub

Public function ToStr(ByVal str) As String
    ToStr = Chr(34) & str & Chr(34)
End Function

Sub Test()
    BlockInsert "123"
End Sub

ironwill2004

但是在我的机器上运行上面的程序，提示说VLAX是用户自定义类型未定义，我用的是Autocad2004，是不是少装了什么？？
它不认VLAX这个类

雪山飞狐(lzh)

Vlax类在：
http://www.xdcad.net/forum/showt ... 1193001#post1193001

ironwill2004

vlax类的开始处有下列代码：
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "VLAX"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
我搞不清这些东西是什么？
我把他们注释掉了，并不影响可以使用，为什么？？

我用什么样的方式可以实现Lisp和VBA的数据交换呢？我想把(setq pTime (grread t))里面的坐标值传递给VBA使用，以便判断当前鼠标所在位置从而执行相应东西？

雪山飞狐(lzh)

Lisp和VBA的数据交换可以用User系列系统变量实现

ironwill2004

帮忙将改良版再改良，右键取消插入，谢谢

雪山飞狐(lzh)

Public Sub BlockInsert(Name As String)
On Error Resume Next
Dim pLisp As String
Dim obj As VLAX
Dim pnt(2) As Double
Set obj = New VLAX
If BlockScale <= 0 Then BlockScale = 1
Set pObj = ThisDrawing.ModelSpace.InsertBlock(pnt, Name, BlockScale, BlockScale, BlockScale, 0)
obj.EvalLispExpression "(setq ed (entget (handent """ & pObj.Handle & """)))"
pLisp = "(while (not (= (caddr " & _
"(setq pTime (grread t) " & _
"pSt (car pTime) " & _
"pnt (cond ((= pSt 25) (entdel (cdr (assoc -1 ed))) (List 0 0 -1)) ((= pSt 3) (List 0 0 -1)) ((= pSt 5) (cadr pTime)) (t (List 0 0 1))))) -1)) " & _
"(setq ed (subst (cons 10 pnt) (assoc 10 ed) ed)) " & _
"(entmod ed) " & _
") "
obj.EvalLispExpression pLisp
Set obj = Nothing
End Sub

gongdeyu

请问怎么让LISP自动加载

oyxx_1023

回楼上。把LSP写到ACAD。LSP里面。或者在ACAD。LSP里加上（LOAD “LSP文件路径”）
然后在CAD设置里面 把“每次重新加载ACAD。LSP”勾上。