[求助]编写一个有关中心线的程序,很多人都用得着!
autocad自带的中心线线型不好用,需调节比例,中心点位置不可控,可编写一个切断程序解决,要求如下:
1. 在线、弧、圆上鼠标选定的位置处,对称切断图元,使其成为中心线,能多次选点;
2. 切断的长度和中心点的长度能手动设定;
这个程序有助于画中心线,估计很多人都用得着。请各位高手帮忙解决,非常感谢!!! 你到论坛里搜索一下吧,有很多人做过这个程序了
关于中心线的画法
我在论坛上搜索了所有关于中心线的主题,没有发现我所需要的程序,都是利用AUTOCAD自带的中心线线型画中心线,而我要求的方法是: 先用连续线型画出直线(中心线),再在鼠标点击处切断直线,使其成为中心线,这种方法的好处是,断点由使用者确定,切断间隙大小可调! 这个论坛里应该有吧。仔细找找,我以前好象见过。 帮你写了一个:考虑到一般是剪去直线的两端,所以能连续执行剪断,不过不能撤消。如果要能够撤消,去掉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 3:24:00static/image/common/back.gif我有一个中线的程序画圆中心线角分线平行线的中线都好用,但是不能给出所有选中圆的中线。下次贴出来,请各位高手完善一下
<p>想要这样的程序,搜索了一下,你<strong>2003-12-30 发的,到现在还没贴出来,呵呵,还有在吗?</strong></p> 想要这样的程序? 很感谢这样的好东西
页:
[1]