| tiancao1001 于 2008-10-31 02:47 PM 发表评论: | 
 | 
| 查看所评论的日志:田草日志 | 
| tiancao1001 于 2008-10-28 10:47 PM 发表评论: | 
来自晓东CAD的一个方法
 也许并不是一个Bug,而是我们没发现罢了
  代码:
  Sub Example_PickfirstSelectionSet()     ' This example lists all the objects in the pickfirst selection set.     ' Before running this example, create some objects in the active     ' drawing and select those objects. The objects currently selected     ' in the active drawing will be returned in the pickfirst selection set.                  Dim pfSS As AcadSelectionSet     Dim ssobject As AcadEntity     Dim msg As String     msg = vbCrLf          Set pfSS = ThisDrawing.PickfirstSelectionSet     For Each ssobject In pfSS         msg = msg & vbCrLf & ssobject.ObjectName     Next ssobject     MsgBox "The Pickfirst selection set contains: " & msg      End Sub
 
  以上的例子在IDE窗口中运行没问题 调用-vbarun命令运行时不能正确运行 可以用下列方法j解决 定义Lisp函数:
  代码:
  (defun tls-sub2cmd(filename subname cmdname)  (eval   (list 'defun    (read (strcat "c:" cmdname))    nil    '(if (cadr(ssgetfirst)) (sssetfirst nil (ssget)))    (list 'vla-RunMacro          '(vlax-get-acad-object)           (strcat filename "!" subname)    )    '(sssetfirst nil nil)    '(princ)   )  )  (vlax-add-cmd cmdname (strcat "C:" cmdname))  (princ) )
 
  调用格式为: (tls-sub2cmd "文件名" "宏名" "命令名")   |  
  | 
| 查看所评论的日志:CAD VBA 先选择后操作 PickfirstSelectionSet | 
| 123321jf 于 2008-10-23 10:49 AM 发表评论: | 
好东西!能不能帮忙发一份? 123321jfjf@163.com |  
  | 
| 查看所评论的日志:晓东VBA论坛板块的电子书版本 | 
| 123321jf 于 2008-10-23 10:43 AM 发表评论: | 
田大,可以给我发一份吗?谢谢!! 123321jfjf@163.com |  
  | 
| 查看所评论的日志:AutoCAD VBA 二次开发教程源码 | 
| 123321jf 于 2008-10-21 09:46 AM 发表评论: | 
你好!可以发一份给我吗?谢谢 123321jfjf@163.com |  
  | 
| 查看所评论的日志:推荐西北凡人制作的AutoCAD VBA教程【电子书】 | 
| tiancao1001 于 2008-10-13 02:55 PM 发表评论: | 
Private Sub CommandButton2_Click()     Dim i As Long     Dim N As Integer     Dim Pi As Double     Pi = 4# * Atn(1#)     Dim R As Long     Randomize     R = Int(Rnd * 100)     Dim R1 As Long     R1 = (0.5 - Rnd) * 199     Dim L As Long     L = Int(Rnd * 100)     Dim S As Long     S = Int(Rnd * 50)     Dim m As Long     m = Int(Rnd * 100)     Dim A1 As Double     Dim A2 As Double     Dim P(2) As Double     Dim P0(2) As Double     Dim X As Double     Dim Y As Double          Dim Fit() As Double     Dim Sp As AcadSpline          ReDim Fit(2)          i = i + 1     A1 = i * Pi / 180     A2 = (R1 / R) * A1          X = (-(R1 - R) * Cos(A1) - S * Cos(A2 - A1) + 100) * m     Y = ((R1 - R) * Sin(A1) - S * Sin(A2 - A1) + 100) * m          P0(0) = X: P0(1) = Y     Fit(0) = X: Fit(1) = Y: Fit(2) = 0                    'ThisDrawing.ModelSpace.AddPoint P0     Do         DoEvents                  i = i + 1         N = N + 1         ReDim Preserve Fit((N + 1) * 3 - 1) '跳过第一个点,因为该点已经等于上一条曲线的最后一个点了。         A1 = i * Pi / 180         A2 = (R1 / R) * A1              X = (-(R1 - R) * Cos(A1) - S * Cos(A2 - A1) + 100) * m         Y = ((R1 - R) * Sin(A1) - S * Sin(A2 - A1) + 100) * m         P(0) = X: P(1) = Y         Fit((N + 1) * 3 - 3) = X: Fit((N + 1) * 3 - 2) = Y: Fit((N + 1) * 3 - 1) = 0         If N = 360 Then             '绘制样条曲线,起点和终点的切线方向为前两个点的矢量方向和最后两个点的矢量方向             Set Sp = ThisDrawing.ModelSpace.AddSpline(Fit, Point3D(Fit(3) - Fit(0), Fit(4) - Fit(1), 0), Point3D(Fit(1077) - Fit(1074), Fit(1078) - Fit(1075), 0))             Randomize             'Sp.color = Int(Rnd * 255)             N = 0             Fit(0) = Fit(1077): Fit(1) = Fit(1078): Fit(2) = 0 '然第一点等于最后一个点,这样样条曲线才能收尾相接         End If         If Abs(P(0) - P0(0)) < 10 ^ -2 And Abs(P(1) - P0(1)) < 10 ^ -2 Then Exit Do         'If i > 10 ^ 4 Then Exit Do      Loop      MsgBox "R=" & R & "/ R1=" & R1 & "/ L=" & L      Prompt "R=" & R & "/ R1=" & R1 & "/ L=" & L & "/ S=" & S & vbCrLf      End End Sub |  
  | 
| 查看所评论的日志:CAD VBA 也能画出这样的样条曲线spirograph万花尺螺旋曲线 | 
| tiancao1001 于 2008-10-10 05:58 PM 发表评论: | 
 | 
| 查看所评论的日志:田草日志 | 
| tiancao1001 于 2008-10-10 04:22 PM 发表评论: | 
 | 
| 查看所评论的日志:田草日志 |