[分享]：程序：对图形中的块按顺序进行编号

subtlation

搜索图形中某种或某几种名称的块，并按块在图形中的位置边按顺序进行编号。
做这个程序初衷是给几千根桩编桩号用的。希望大家用过给出建议。
下载后解压成文件pileno.dvb,用appload加载，
输入WBN启动程序。


2004.1.7日重新上载（最新）
改正了角度不准确的问题。

lucyxia

我正好需要这样的东东，但是下载后加载并键入WBN没有反应，WHY？
我用的是2004

subtlation

一阵子没过来，今天才看到上面的回复。
原来的附件有的问题。再次上传。解压后放到cad支持路径下用appload加载。输入wbn启动命令。
希望用后给些意见。

请到一楼直接下载。

lywxf

可以执行，但是没看到结果。

subtlation

回复7楼，
可能的情况是：
1要选择块
2块的名称要选择对
3默认的字高是3.5比较小。
4默认的字体和图层问题。
如果1，2项都对，那就把字高字体图层等改为图纸中常用的格式。

myfreemind

桩号没有按顺序排列

chenhang1203

最初由 subtlation 发布
[B]一阵子没过来，今天才看到上面的回复。
原来的附件有的问题。再次上传。解压后放到cad支持路径下用appload加载。输入wbn启动命令。
希望用后给些意见。 [/B]

命令: ap APPLOAD 正在初始化 VBA 系统...已成功加载 PileNo.dvb。

命令: (defun c:WBN () (command "-vbarun" "pileNo.dvb!thisdrawing.pileno")) C:WBN

命令: wbn -vbarun
宏名: pileNo.dvb!thisdrawing.pileno
未找到宏。
命令: nil

myfreemind

最初由 chenhang1203 发布
[B]
?.. [/B]

DVB文件有没有放到搜索路径中？看一下！

lywxf

可以用了，发现递增顺序中第一项写反了，应该是Y向优先（不选择X向优先）

zzg123good

我一时想不起来有这方面的要求，但很想看看楼主是怎么排序的。

subtlation

程序的思路：
先把满足条件的图块放在一个选择集中，然后把选择集中快引用的插入点赋值到一个points（）点集中，用以下自编的函数排序。
Public Sub PtList(points, ByVal HAlign As Boolean, ByVal VAlign As Boolean, _
                                                     priority As Integer)
  '对点集points 进行排序
  'priority = 0 表示先排X坐标，priority = 1 表示先排Y坐标
  'HAlign = True 表示X坐标从小到大，HAlign = False 表示X坐标从大到小
  'VAlign = True 表示Y坐标从小到大，VAlign = False 表示Y坐标从大到小
  
  Dim pt1, pt2 As Variant
  Dim n As Integer
  Dim A, B As Boolean
  n = priority
  If n = 0 Then
    A = HAlign
    B = VAlign
  ElseIf n = 1 Then
    A = VAlign
    B = HAlign
  End If
  '主方向排序
  For i = LBound(points) To UBound(points)
    For j = i To UBound(points)
      pt1 = points(i)
      pt2 = points(j)
      If pt1(n) > pt2(n) Eqv A Then
        points(i) = pt2
        points(j) = pt1
      End If
    Next j
  Next i
  '副方向排序
  For i = LBound(points) To UBound(points)
    For j = i To UBound(points)
      pt1 = points(i)
      pt2 = points(j)
     If pt1(n) = pt2(n) Then
      If pt1(1 - n) > pt2(1 - n) Eqv B Then
        points(i) = pt2
        points(j) = pt1
      End If
     End If
    Next j
  Next i
  
End Sub

无忧

是不是也可以用这个思路来排轴号？

subtlation

可以啊，把轴号的圆做成块，用这个软件编号，只要控制插入点位置就行了。
不过我自己是做一个轴号的属性块。然后自己编个程序，复制一次就+1，
如果是字母（A，B。。。）等，就用她们的ascii码+1

ydf7332462

块名从图中选而不只是“桩”,好吗？

subtlation

回复17楼。
我已经重新上载了，你可以到一楼去下载。默认的图块名称是你选择的块引用中的一个。如果自己要改块名称，可以点击块名称旁边的按钮到屏幕中选择一个你需要编号的块引用。选择结束后会返回你需要的块名称。
如果需要有2种以上的块同时混合编号，就只能手动输入了。