田草博客

互联网田草博客


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

微信 公众号:ByCAD

邮箱:tiancao1001x126.com
ByCAD,微信公众号
首页 | 普通 | 电脑 | AutoCAD | VB/VB.NET | FLash | 结构 | 建筑 | 电影 | BIM | 规范 | 软件 | ID
-随机-|-分布-
-博客论坛-|-﨣﨤﨧﨨-
-网站导航-|-规范下载-
-BelovedFLash欣赏-

用户登陆
用户:
密码:
 

站点日历
73 2024 - 3 48
     12
3456789
10111213141516
17181920212223
24252627282930
31


站点统计

最新评论



AutoDesk教育版打印戳记清除方法 CAD express 汉化
未知 田草CAD工具箱—>自动绘制PKPM轴线网   [ 日期:2007-06-11 ]   [ 来自:本站原创 ]  HTML
PKPM窗口激活后应在英文输入法状态下,才可以使用,而且要在AutoCAD的编辑模式下使用。

(更新2009-9-1)
1、解决绘制坐标在pkpm绘图区之外。
2、解决轴线数据取整不精确问题。
3、发现错误可以中途退出。
4、制作了一个Flash教程。



用下面的从cad中提取直线数据:使用田草工具箱中的统计工具,里面有一个可以提取直线数据的。

按此在新窗口打开图片

用下面的在pkpm中进行自动输入数据:

按此在新窗口打开图片


下面是自动绘制的一段视频:

按此在新窗口打开图片


下面是程序文件: 



在AutoCAD中提取轴线数据的VBA程序:



安装方法
AotoCAD->工具->加载应用程序-> 启动->内容
按此在新窗口打开图片

然后再cad的命令行输入 -vbarun Ldata
就可以读取轴线的数据了。最好在读取轴线数据之前将轴线移到(0,0,0)点附近。


[本日志由 tiancao1001 于 2019-07-13 04:57 PM 编辑]


引用这个评论 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
 

引用这个评论 tiancao1001 于 2009-02-21 10:08 AM 发表评论: 
你好当然可以。稍后给你献上。
感谢支持,

引用这个评论 longer1000 于 2009-02-21 09:14 AM 发表评论: 
你好!能否编写这样一个cad工具--自动编写矩形编号的程序。
设想方法如下:
选择批量的矩形,再向矩形中心方向偏移相同的数值,删除原选择的矩形,最后在偏移的矩形内填写相应的长度*宽度。
在此表示谢意

引用这个评论 田草 于 2008-01-21 12:15 AM 发表评论: 
现在还有二问题: 

1、 读取的轴线不在PKPM的屏幕中间,导致绘制不出来,要移动PKPM坐标,才能正确绘制。
2、还有就是在有些时候,会出现第一跟轴线或最后一根绘制错误。

引用这个评论 田草 于 2007-11-15 11:04 PM 发表评论: 
这个程序可能只有我pkpm好用,这个于版本有问题,pkpm的本身又有cad编辑方式和pkpm编辑方式,pkpm自己本身的窗体控件的焦点就很乱,我没法写出通用的。

引用这个评论 田草 于 2007-08-08 04:49 PM 发表评论: 
这个怪名 肯定是老妖的。

你学习c++干嘛?

这个也不难,不过我还是用vb 偶尔用c++

引用这个评论 dylan_sue 于 2007-08-07 08:34 PM 发表评论: 
老苗,kolapyka是谁啊?应该是咱们班的,强的了,凌晨两点半还在线上!

引用这个评论 kolapyka 于 2007-08-07 02:29 PM 发表评论: 
老苗,我现在在学C++,设计中需要用到的,以后教教我啊

发表评论 - 不要忘了输入验证码哦!
作者: 用户:  密码:   注册? 验证:  防止恶意留言请输入问题答案:1*9=?  
评论:

禁止表情
禁止UBB
禁止图片
识别链接
识别关键字

字体样式 文字大小 文字颜色
插入粗体文本 插入斜体文本 插入下划线
左对齐 居中对齐 右对齐
插入超级链接 插入邮件地址 插入图像
插入 Flash 插入代码 插入引用
插入列表 插入音频文件 插入视频文件
插入缩进符合
点击下载按钮 下标 上标
水平线 简介分割标记
表  情
 
Tiancao Blog All Rights Reserved 田草博客 版权所有
Copyright ©