[LISP函数]：mirror不用输入y(lisp)、自身mirror(VBA)

qiaqiadeng

(defun c:dc ();mirror不用输入y
  (setq p1 (getpoint "\n请输入对称轴的第一点："))
  (setq p2 (getpoint p1 "\n请输入对称轴的第二点："))
  (while (setq obj (ssget))
    (command "mirror" obj "" p1 p2 "y")
  )
)


Public Sub modelzgx() '对象自身镜像   Shift+Tab反向移动
Dim Sela As AcadSelectionSet
Dim i As Integer
Dim Num As Integer
Dim obj As AcadEntity
Dim Minpoint As Variant, Maxpoint As Variant
Dim MinP(0 To 2) As Double, MaxP(0 To 2) As Double
Dim p1(0 To 2) As Double, p2(0 To 2) As Double
Dim ll As AcadPolyline
Dim InPoint As AcadPoint
Dim Handl As Long
Dim XX As AcadEntity
Dim ObjArray(0) As AcadEntity
Dim Key As String

'On Error Resume Next
Key = UCase(ThisDrawing.Utility.GetString(False, "对称轴是垂直(C)?"))

For j = 1 To 100
    On Error GoTo ErrTrap
Num = ThisDrawing.SelectionSets.count
For i = 0 To Num - 1
    Set Sela = ThisDrawing.SelectionSets.Item(i)
    If Sela.Name = "Sela" Then
        Sela.Delete
    End If
Next i
Set Sela = ThisDrawing.SelectionSets.Add("Sela")
Sela.SelectOnScreen

i = 1
If Sela.count > 0 Then
    For Each obj In Sela
        obj.GetBoundingBox Minpoint, Maxpoint
            If i = 1 Then
                MinP(0) = Minpoint(0)
                MinP(1) = Minpoint(1)
                MaxP(0) = Maxpoint(0)
                MaxP(1) = Maxpoint(1)
            Else
                MinP(0) = Min(Minpoint(0), MinP(0))
                MinP(1) = Min(Minpoint(1), MinP(1))
                MaxP(0) = Max(Maxpoint(0), MaxP(0))
                MaxP(1) = Max(Maxpoint(1), MaxP(1))
            End If
        i = i + 1
    Next
End If
If Key = "C" Then '如果对称轴是垂直
    p1(0) = (MinP(0) + MaxP(0)) / 2
    p1(1) = MinP(1)
    p2(0) = p1(0)
    p2(1) = MaxP(1)
Else
    p1(0) = MinP(0)
    p1(1) = (MinP(1) + MaxP(1)) / 2
    p2(0) = MaxP(0)
    p2(1) = p1(1)
End If
For Each obj In Sela
    obj.Mirror p1, p2
    obj.Delete
Next
ErrTrap:
    '发生错误时跳转到这里
    If InStr(ThisDrawing.GetVariable("lastprompt"), "Cancel") Then
      Exit For
    ElseIf InStr(ThisDrawing.GetVariable("lastprompt"), "取消") Then
      Exit For
    End If
   
Next j
End Sub

曹杰

楼主，自身mirror(VBA)的运行命令是什么呀

qiaqiadeng

请将附件保存在d:下(也可用其他路径，请自行决定)，然后在acad2004doc.lsp中加入下列语句：
(vl-vbaload "d:/vbacommmand.dvb")
(defun c:zgx ()                                ;自身镜像
  (vl-vbarun "modelzgx")
)
然后你再打开CAD，在命令行里输入zgx，就可以自镜像了。