CASS宗地标注文字简单的单个排版插件
1、打开cass软件，在“地籍”中”绘制权属线“命令，绘制一个宗地，并标注文字。提前设好参数，可以和我的图一样。
2、命令行输入vbaide并回车，打开vba窗口，在工程窗口右键插入模块，并在右侧模块代码窗口复制粘贴一下代码。
Option ExplicitSub az1() '排版，一点二点选方向，三点距离 Const PI = 3.1415927 '定义圆周率PI Dim Num As Integer Dim entry As AcadEntity On Error Resume Next '创建选择集 Dim dk As AcadSelectionSet, dksc As String, F_Type(0) As Integer, F_data(0) As Variant dksc = "dkscmc" If Not IsNull(ThisDrawing.SelectionSets.Item(dksc)) Then Set dk = ThisDrawing.SelectionSets.Item(dksc) dk.Delete End If Set dk = ThisDrawing.SelectionSets.Add(dksc) F_Type(0) = 0 F_data(0) = "TEXT" dk.SelectOnScreen F_Type, F_data '选择集中数Num Num = dk.Count '- 1 '选择三点 Dim pd0 As Variant, pd1 As Variant, pd2 As Variant pd0 = ThisDrawing.Utility.GetPoint(, "选择第一点") pd1 = ThisDrawing.Utility.GetPoint(, "选择第二点") pd2 = ThisDrawing.Utility.GetPoint(, "选择第三点") '平分单个距离aX,aY Dim aX As Double, aY As Double aX = (pd1(0) - pd0(0)) / Num: aY = (pd1(1) - pd0(1)) / Num '旋转角度xzd Dim xzd As Double xzd = Atn(Abs((pd1(1) - pd0(1)) / Abs(pd1(0) - pd0(0)))) If pd0(0) > pd1(0) And pd0(1) < pd1(1) Then xzd = PI - xzd ElseIf pd0(0) > pd1(0) And pd0(1) > pd1(1) Then xzd = xzd - PI ElseIf pd0(0) < pd1(0) And pd0(1) < pd1(1) Then xzd = xzd ElseIf pd0(0) < pd1(0) And pd0(1) > pd1(1) Then xzd = 0 - xzd End If '左侧垂直单位向量 Dim x As Double, y As Double x = -(pd1(1) - pd0(1)) / Sqr((pd1(1) - pd0(1)) ^ 2 + (pd1(0) - pd0(0)) ^ 2) y = (pd1(0) - pd0(0)) / Sqr((pd1(1) - pd0(1)) ^ 2 + (pd1(0) - pd0(0)) ^ 2) '第三点到直线的距离 Dim A As Double, B As Double, C As Double A = (pd1(1) - pd0(1)) / (pd1(0) - pd0(0)) B = -1 C = pd0(1) - A * pd0(0) '左侧垂直偏移距离d,字高H Dim d As Double, H As Double H = 1.2 '文字高度 d = Abs((A * pd2(0) + B * pd2(1) + C) / Sqr(A ^ 2 + B ^ 2)) / 2 - H / 2 pd0(0) = pd0(0) + d * x pd0(1) = pd0(1) + d * y '移动坐标 Dim i As Integer i = 0 pd0(0) = pd0(0) + aX / 2 pd0(1) = pd0(1) + aY / 2 For Each entry In dk entry.height = H entry.Alignment = acAlignmentLeft entry.Rotation = xzd entry.Move entry.insertionPoint, pd0 pd0(0) = pd0(0) + aX pd0(1) = pd0(1) + aY i = i + 1 Next entryEnd Sub
3、双击AutoCAD对象中的ThisDrawing,在其右侧代码窗口输入以下代码。
Public TestLoad As BooleanPrivate Sub AcadDocument_EndCommand(ByVal CommandName As String) If Not TestLoad Then ThisDrawing.SendCommand "(defun c:as()(vl-vbarun ""az1"")(princ))(princ)" & vbCr TestLoad = True End IfEnd Sub
4、点击vba中的保存。选在保存路径，工程名称。关闭vba窗口。
5、在命令行中输入设置的快捷键“as”,并选择要排版文字，选择第一点，第二点，第三点，完成文字排版。如图。
6、选择文字，可以从右下向左上框选，最终文字前后顺序为文字原来生成时的顺序。
如果文字时一个一个点选的，最终排序会是点击选择的前后顺序。
选择第一点第二点，第三点如图。第一点与第二点，确定的直线方向为文字排齐侯的底边方向。第三点如图所示可以选上边线段的任意点，第三点目的时确定，宗地两边距离，进一步确定文字便宜距离。
7、如果读者有看不懂或者发现有错误欢迎互相交流，我只是一个应用爱好者。
