
|
-博客论坛-|-﨣﨤﨧﨨- -网站导航-|-规范下载- -BelovedFLash欣赏-
|
'重命名图块 Sub ReNameBLock() On Error Resume Next Dim E As AcadEntity Dim P As Variant Dim B As AcadBlockReference ThisDrawing.Utility.GetEntity E, P, "选择一个你要重命名的参照块: " If Err <> 0 Then Exit Sub Dim NewName As String NewName = InputBox("输入新的图块名称:", "田草结构工具箱") If NewName = "" Then Exit Sub If Err = 0 Then If E.ObjectName = "AcDbBlockReference" Then Set B = E ThisDrawing.Blocks(B.name).name = NewName End If End If End Sub ![]() 拿到别人的初步设计,窗户都是随便插入的,一般情况下,我们都会将窗户放在墙段的中间,因此需要以下操作: '对象居中 '天正建筑中的窗居墙体中间 ' 在此操作之前应该将窗编号隐藏 Sub Center_E2E_Center1() Dim P As Variant Dim E As AcadEntity Dim SSet As AcadSelectionSet Dim I As Long Dim PC1 As Variant, PC2 As Variant Dim Wall As AcadEntity On Error GoTo xErr xNext: ThisDrawing.Utility.GetEntity E, P, "第一个窗对象:" PC1 = GetCenter(E) Set SSet = GetE_SideByE(E) For I = 0 To SSet.Count - 1 'Prompt SSet.item(I).ObjectName & vbCrLf If SSet.item(I).ObjectName = "TDbWall" Then Set Wall = SSet.item(I) PC2 = GetCenter(Wall) E.Move PC1, PC2 End If Next I xErr: End Sub ![]() '找到一个CAD对象附近的CAD对象 Function GetE_SideByE(E As AcadEntity) As AcadSelectionSet '返回 Dim Pmin As Variant, Pmax As Variant E.GetBoundingBox Pmin, Pmax Dim SSet As AcadSelectionSet Set SSet = CreateSelectionSet("XX") 'SSet.Select acSelectionSetWindow, Pmin, Pmax SSet.Select acSelectionSetCrossing, Pmin, Pmax Set GetE_SideByE = SSet End Function ![]() 1、电瓶车的脚踏离地面的最小高度太小,在车很小的转弯情况下,都有可能脚踏触地,脚踏很容易损毁。 2、电瓶车的车灯最好能够上下调节,车灯应该能照到前下方的地面。电瓶车的灯光微弱,如果固定,且光线直射向前,在没有路灯的情况之下,这个等没有一点实用价值,微弱的灯光不足以照到远方的地面上,前方的地面依旧看不清。 3、电瓶车功能不应过多,没实际意义,特别是有很多塑料壳在上面的,坏了,不值得维修,很难看。 ![]() 目前只知道这几个,我也曾用过。 '选择颜色对话框 Private Declare Function acedSetColorDialog Lib "acad.exe" _ (color As Long, ByVal bAllowMetaColor As Boolean, ByVal nCurLayerColor As Long) As Boolean '显示提示对话框 Private Declare Function acedAlert Lib "acad.exe" (ByVal str As String) As Long ' 显示文本窗口(AutoCAD 命令行文本窗口) Private Declare Function acedTextScr Lib "acad.exe" () As Long ' 隐藏文本窗口 Private Declare Function acedGraphScr Lib "acad.exe" () As Long ' 命令行提示 Private Declare Function acedPrompt Lib "acad.exe" (ByVal str As String) As Boolean ' 卸载 arx Private Declare Function acedArxUnload Lib "acad.exe" (ByVal str As String) As Long ![]() Sub Center_E2E_Center() Dim P As Variant Dim P1 As Variant, P2 As Variant Dim E1 As AcadEntity Dim E2 As AcadEntity On Error GoTo xErr xNext: ThisDrawing.Utility.GetEntity E1, P, "第一个对象:" P1 = GetCenter(E1) E1.Visible = False ThisDrawing.Utility.GetEntity E2, P, "第二个对象:" P2 = GetCenter(E2) E1.Move P1, P2 E1.Visible = True GoTo xNext xErr: End Sub ![]()
|
Tiancao Blog All Rights Reserved 田草博客 版权所有 Copyright © |