田草博客

互联网田草博客


网友交流QQ群:11740834 需注明申请加入原因

微信 公众号:ByCAD

邮箱:tiancao1001x126.com
ByCAD,微信公众号
首页 | 普通 | 电脑 | AutoCAD | VB/VB.NET | FLash | 结构 | 建筑 | 电影 | BIM | 规范 | 软件 | ID

评论列表

所有评论
[79] [80] [81] [82] [83] [84] [85] [86] [87] [88]  ... [143]  
sujianyong 于 2009-03-05 06:18 PM 发表评论:
sujianyong@163.com
谢谢斑竹!万望给我发送一份!
万分感谢!
查看所评论的日志:AutoCAD vba 范例
tiancao1001 于 2009-03-03 03:32 PM 发表评论:
利用ShellExecute可以直接打开文件:
Private Const SW_SHOWNA = 8
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Sub Command1_Click()
ShellExecute Me.hwnd, "open", "c:\temp.jpg", "", "", SW_SHOWNA
End Sub 

vb中使用shell,执行系统变量
查看所评论的日志:田草日志
tiancao1001 于 2009-03-03 03:31 PM 发表评论:
2009年的第一个工程确是一块广告牌
查看所评论的日志:田草日志
xiaoyangboy 于 2009-03-01 09:43 PM 发表评论:
yxtnt@126.com
麻烦传给我一份,谢谢了,很需要
查看所评论的日志:AutoCAD VBA 二次开发教程源码
kingzgh 于 2009-02-24 08:40 PM 发表评论:
请楼主将“AutoCAD VBA 二次开发教程源码”发给我,非常感谢,我的信箱kingzgh@yahoo.com.cn
查看所评论的日志:AutoCAD VBA 二次开发教程源码
tiancao1001 于 2009-02-22 11:25 PM 发表评论:
Sub XXX()
   On Error GoTo ErrControl
    
    Dim SSet As AcadSelectionSet
    Set SSet = CreateSelectionSet("XXX")
    Dim fType, fData
    BuildFilter fType, fData, 0, "LWPolyline"
    
    '选择矩形
    SSet.SelectOnScreen fType, fData
    
    Dim PL As AcadLWPolyline
    Dim New_Pl  As Variant
    Dim Pmin As Variant
    Dim Pmax As Variant
    Dim L As Double
    Dim H As Double
    For Each PL In SSet
        '偏移矩形
        New_Pl = PL.offset(100)
        '偏移后的矩形角点
        New_Pl(0).GetBoundingBox Pmin, Pmax
        L = Pmin(0) - Pmax(0) '矩形长
        H = Pmax(1) - Pmax(1) '矩形宽
        '在矩形内部写上 长x宽
        TxtHatch Format(L, "0.00") & "x" & Format(H, "0.00"), Pmin, Pmax, 0
        PL.Delete
    Next
ErrControl:

End Sub
Public Function TxtHatch(ByVal Str As String, ByVal P1 As Variant, P2 As Variant, a As Double) As AcadText
    Dim Txt As AcadText
    Dim TxtH As Double
    Dim TxtL As Double
    Dim RecL As Double
    Dim RecH  As Double
    Dim Center1(2) As Double
    Dim Pmin As Variant, Pmax As Variant
    If Abs(P1(0) - P2(0)) = 0 Or Abs(P1(1) - P2(1)) = 0 Then Exit Function
    If a = 0 Then
        RecL = Abs(P1(0) - P2(0))
        RecH = Abs(P1(1) - P2(1))
    Else
        RecL = Abs(P1(1) - P2(1))
        RecH = Abs(P1(0) - P2(0))
    End If
    Center1(0) = (P1(0) + P2(0)) / 2
    Center1(1) = (P1(1) + P2(1)) / 2
    Center1(2) = (P1(2) + P2(2)) / 2
    Set Txt = ThisDrawing.ModelSpace.AddText(Str, Point3D(0, 0, 0), 2.5)
    Txt.GetBoundingBox Pmin, Pmax
    TxtL = Abs(Pmin(0) - Pmax(0))
    TxtH = Abs(Pmin(1) - Pmax(1))
    If RecL / TxtL <= RecH / TxtH Then
        Txt.ScaleEntity Pmin, RecL / TxtL
    Else
        Txt.ScaleEntity Pmin, RecH / TxtH
    End If
    Txt.Alignment = acAlignmentMiddleCenter
    Txt.Move Txt.TextAlignmentPoint, Center1
    Txt.Rotate Center1, a * Atn(1) * 4 / 180
    Set TxtHatch = Txt
End Function
 
查看所评论的日志:田草CAD工具箱—>自动绘制PKPM轴线网
tiancao1001 于 2009-02-21 10:08 AM 发表评论:
你好当然可以。稍后给你献上。
感谢支持,
查看所评论的日志:田草CAD工具箱—>自动绘制PKPM轴线网
longer1000 于 2009-02-21 09:14 AM 发表评论:
你好!能否编写这样一个cad工具--自动编写矩形编号的程序。
设想方法如下:
选择批量的矩形,再向矩形中心方向偏移相同的数值,删除原选择的矩形,最后在偏移的矩形内填写相应的长度*宽度。
在此表示谢意
查看所评论的日志:田草CAD工具箱—>自动绘制PKPM轴线网
[79] [80] [81] [82] [83] [84] [85] [86] [87] [88]  ... [143]  
Tiancao Blog All Rights Reserved 田草博客 版权所有
Copyright ©