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

msk181

AutoCAD自带的中心线线型不好用,需调节比例,中心点位置不可控,
可编写一个切断程序解决,要求如下:
1. 在线、弧、圆上鼠标选定的位置处,对称切断图元,使其成为中心线,能多次选点;
2. 切断的长度和中心点的长度能手动设定;
这个程序有助于画中心线,估计很多人都用得着。请各位高手帮忙解决,非常感谢!!!

meflying

你到论坛里搜索一下吧，有很多人做过这个程序了

msk181

我在论坛上搜索了所有关于中心线的主题,没有发现我所需要的程序,都是利用AUTOCAD自带的中心线线型画中心线,而我要求的方法是: 先用连续线型画出直线(中心线),再在鼠标点击处切断直线,使其成为中心线,这种方法的好处是,断点由使用者确定,切断间隙大小可调!

gzy

这个论坛里应该有吧。仔细找找，我以前好象见过。

gzy

帮你写了一个：
  考虑到一般是剪去直线的两端，所以能连续执行剪断，不过不能撤消。如果要能够撤消，去掉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

周瑜

我有一个中线的程序画圆中心线角分线平行线的中线都好用，但是不能给出所有选中圆的中线。下次贴出来，请各位高手完善一下

usestone

周瑜发表于2003-12-30 3:24:00我有一个中线的程序画圆中心线角分线平行线的中线都好用，但是不能给出所有选中圆的中线。下次贴出来，请各位高手完善一下

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

hyong10000

想要这样的程序?

jxy308

很感谢这样的好东西