二次开发—块插入后旋转

龙魂

比如一个椭圆，长轴两个顶点位置已知（不水平），则需要将块插入后旋转。
4 g0 m( @: J0 dInsertBlock(插入点,块名, X 轴比例,Y 轴比例,Z 轴比例, 旋转角度)中旋转角度未知，程序上怎么实现？
* W9 B- h# f2 d请达人指教！多谢！
$ i, l0 C! F" Y/ W) a3 ]) t: abow~

woaishuijia

Sub A()
    Dim B As AcadBlock, I As Integer, P(2) As Double
9 C7 v8 t7 _* B/ [9 i8 V    With ThisDrawing
        For Each B In .Blocks '遍历文档中的块集合，通过块名称查找指定的块
0 H$ x0 u0 ]8 N% I5 Z! N9 t            If B.Name = 块名称字符串 Then '找到指定的块
  r: [$ N0 Z3 x. h! x# M6 U  O  c                For I = 0 To B.Count - 1 '遍历块元素
                    If B.Item(I).ObjectName = "AcDbEllipse" Then Exit For '找到椭圆后退出循环
                Next
7 H4 @( Y8 m& q. Y0 I5 i7 R$ t                .ModelSpace.InsertBlock P, 块名称字符串, 1, 1, 1, -.Utility.AngleFromXAxis(B.Item(I).Center, B.Item(I).StartPoint)
/ x, g4 n( j* L1 o8 [                '根据椭圆中心点和起点，用AngleFromXAxis方法获取椭圆旋转角，并用其负值做为插入块时的旋转角(反向转回来)
5 E/ [, s. n, Y4 t$ h+ b                Exit For
            End If
        Next
2 ]4 A) a& O$ c" j3 s" X* L5 T# I7 p, ]    End With
8 l: o) p3 s2 Y9 u! ^End Sub

www1974

复制粘贴。
# s# k' ^4 L$ C+ i(defun c:copy&paste ()
  (setq ss nil)
% H. C$ W) Z: K' Y6 \0 ?# Q  (print "输入回车进行粘贴")
  (setq ss (ssget))
' q# N6 \- O) z/ y, Q. g6 y: O  (if (= ss nil)
4 }7 l* S, N, e. N- A' s, \    (command "-insert" (strcat "*" "tigerspace.dwg") (getpoint "插入点：") (getreal "缩放比例：") (getreal "旋转角度："))
    (progn
         (setq D1 (getpoint "插入点："))
           (if (findfile "tigerspace.dwg")
             (command "-wblock" "tigerspace.dwg" "Y" "" D1 ss "")
             (command "-wblock" "tigerspace.dwg" "" D1 ss "")
           );;结束if
9 B6 d6 p4 c# A1 ?3 ?" p  D, v         (command "oops")
" K& e, O- `7 q# x+ ]0 t$ r         (command "-insert" (strcat "*" "tigerspace.dwg") (getpoint "插入点：") (getreal "缩放比例：") (getreal "旋转角度："))
     );;结束progn
) C" j- a! m8 s9 G/ {  c  );;结束if
) A! M0 {' z2 t( I% V7 M7 Z! c  (princ)
. I3 T/ H  F% |)

[ 本帖最后由 www1974 于 2008-9-23 20:10 编辑 ]

龙魂

多谢指教！