明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 3960|回复: 8

[求助]编写一个有关中心线的程序,很多人都用得着!

[复制链接]
发表于 2003-12-16 20:37 | 显示全部楼层 |阅读模式
AutoCAD自带的中心线线型不好用,需调节比例,中心点位置不可控,
可编写一个切断程序解决,要求如下:
1. 在线、弧、圆上鼠标选定的位置处,对称切断图元,使其成为中心线,能多次选点;
2. 切断的长度和中心点的长度能手动设定;
这个程序有助于画中心线,估计很多人都用得着。请各位高手帮忙解决,非常感谢!!!
发表于 2003-12-17 08:20 | 显示全部楼层
你到论坛里搜索一下吧,有很多人做过这个程序了
 楼主| 发表于 2003-12-24 19:07 | 显示全部楼层

关于中心线的画法

我在论坛上搜索了所有关于中心线的主题,没有发现我所需要的程序,都是利用AUTOCAD自带的中心线线型画中心线,而我要求的方法是: 先用连续线型画出直线(中心线),再在鼠标点击处切断直线,使其成为中心线,这种方法的好处是,断点由使用者确定,切断间隙大小可调!
发表于 2003-12-25 15:46 | 显示全部楼层
这个论坛里应该有吧。仔细找找,我以前好象见过。
发表于 2003-12-25 16:38 | 显示全部楼层
帮你写了一个:
  考虑到一般是剪去直线的两端,所以能连续执行剪断,不过不能撤消。如果要能够撤消,去掉goto retry和RETYT,不过那样就不能连续剪断了。
'gzy@mjtd.com
'12.25
Dim selobj As AcadObject
Dim lineobj As AcadLine
Dim ppt As Variant
Dim mp1(0 To 2) As Double
Dim mp2(0 To 2) As Double
Sub mainmenu()
    Dim newmenu As AcadPopupMenu
    Dim newmenugroup As AcadMenuGroup
    Dim newmenuitemname As AcadPopupMenuItem
    Set newmenugroup = ThisDrawing.Application.MenuGroups.Item(0)
    Set newmenu = newmenugroup.Menus.Add("剪切")
    Set newmenuitemname = newmenu.AddMenuItem(newmenu.Count + 0, "剪切", "-vbarun jq ")
    Set newmenuitemname = newmenu.AddMenuItem(newmenu.Count + 2, "退出", "-vbarun u2 ")
    newmenu.InsertInMenuBar (ThisDrawing.Application.MenuBar.Count + 1)
End Sub
Sub u2()
    ThisDrawing.SendCommand "filedia 0 "
    ThisDrawing.SendCommand "menu " + Chr(13)
    ThisDrawing.SendCommand "filedia 1 "
End Sub
Sub jq()
RETRY:
    On Error Resume Next
     Do While code = 0
        ThisDrawing.Utility.GetEntity selobj, ppt, "请选择目标直线"
      If Err <> 0 Then
            Err.Clear
            ThisDrawing.Utility.Prompt " 没有选定对象,退出"
            Exit Sub
      End If
        If Err.Number = 0 Then
            If (selobj.EntityName = "AcDbLine") Then
                Set lineobj = selobj
                mp1(0) = lineobj.StartPoint(0)
                mp1(1) = lineobj.StartPoint(1)
                mp2(0) = lineobj.EndPoint(0)
                mp2(1) = lineobj.EndPoint(1)
            End If
        If (ppt(0) - mp1(0)) ^ 2 + (ppt(1) - mp1(1)) ^ 2 < (mp2(0) - ppt(0)) ^ 2 + (mp2(1) - ppt(1)) ^ 2 Then
          lineobj.StartPoint = ppt
         Else
          lineobj.EndPoint = ppt
        End If
     Exit Do
     End If
  Loop
GoTo RETRY
End Sub
发表于 2003-12-30 03:24 | 显示全部楼层
我有一个中线的程序画圆中心线角分线平行线的中线都好用,但是不能给出所有选中圆的中线。下次贴出来,请各位高手完善一下
发表于 2007-11-19 22:59 | 显示全部楼层
周瑜发表于2003-12-30 3:24:00我有一个中线的程序画圆中心线角分线平行线的中线都好用,但是不能给出所有选中圆的中线。下次贴出来,请各位高手完善一下

想要这样的程序,搜索了一下,你2003-12-30 发的,到现在还没贴出来,呵呵,还有在吗?

发表于 2013-7-19 14:54 | 显示全部楼层
想要这样的程序?

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
发表于 2015-1-24 16:51 | 显示全部楼层
很感谢这样的好东西
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 07:43 , Processed in 0.296045 second(s), 24 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表