（完成）[求助]：求LSP，怎样自动为图纸中的块的标上序号（在各个块的旁边）

zhiyun

求LSP，怎样自动为图纸中的块的标上序号（在各个块的旁边）

lsjjm

请参考:
[php]
(defun c:test ()
  (setq bb (ssget '((0 . "insert"))))
  (setq h (* (getvar "dimscale")(getvar "dimtxt"))
        n 0)
  (while (< n (sslength bb))
    (setq p0 (cadr (acet-geom-extents (ssname bb n))))
    (vl-cmdf "text" (polar p0 0 1 ) h 0 (strcat "Block No:" (itoa (1+ n))) "")
    (setq n (1+ n))
  )
)
[/php]

zhiyun

谢谢，我看看。。。但选择对象后出现错误：空函数？？？为什么呢

自由的鱼

标什么序号？

xgwl

这个test 与块被写入的顺序有关， 如果将几个块同时拷后，编号就变了！如果能完美些，这是个的用的程序！

zhiyun

4楼楼主说：   9pt 10pt 11pt 12pt 13pt 15pt  

标什么序号？  
--------
就是：假设图纸上插入10个相同的图块后，运行程序，在图块附近自动标上1，2，3。。。。。
假如标上后的图纸又删掉了其中一个图块，再运行该程序，图块重新排序！谢谢
j

自由的鱼

最初由 zhiyun 发布
[B]4楼楼主说：   9pt 10pt 11pt 12pt 13pt 15pt  

标什么序号？  
--------
就是：假设图纸上插入10个相同的图块后，运行程序，在图块附近自动标上1，2，3。。。。。
假如标上后的图纸又删掉了其中一个图块，再?.. [/B]

序号和图块的位置有没有关系？

先试下这个程序，没有按照块名过滤，序号我放到LBL层，若要重新标号就删除旧号

Option Explicit

Sub tt()
Call ThisDrawing.Layers.Add("LBL")
Dim txt As AcadText
Dim bk As AcadBlockReference
Dim ent As AcadEntity
Dim pnt(0 To 2) As Double
Dim pt As Variant
Dim SSET As AcadSelectionSet
Dim i As Integer
Dim Ftype(0) As Integer
Dim Fdata(0) As Variant
Ftype(0) = 0
Fdata(0) = "INSERT"
Set SSET = ThisDrawing.SelectionSets.Add("tttttt")
SSET.SelectOnScreen Ftype, Fdata
For i = 0 To SSET.Count - 1
pt = SSET.Item(i).InsertionPoint
pnt(0) = pt(0) + 3
pnt(1) = pt(1) + 3
pnt(2) = 0
Set txt = ThisDrawing.ModelSpace.AddText(i + 1, pnt, 2)
txt.Layer = "LBL"
Next
SSET.Delete

End Sub

htm

我也想要这个程序，楼上的是VB的，看不懂，最好有lsp的。

ruan_gdqf

7楼楼主　最好发个LISP程序上来。
1楼楼主　要的的LSP程序

eachy

最初由 zhiyun 发布
[B]求LSP，怎样自动为图纸中的块的标上序号（在各个块的旁边） [/B]

xgwl

程序在哪?   怎么找不到?  另: 我觉得还是放在块的正上方比较好! 就象其他二次开发的软件给各自门窗编号一样,正上方比较顺眼些!

eachy

最初由 xgwl 发布
[B]程序在哪?   怎么找不到?  另: 我觉得还是放在块的正上方比较好! 就象其他二次开发的软件给各自门窗编号一样,正上方比较顺眼些! [/B]

先试试效果，位置好办

xgwl

好程序！ 但为什么编好号的文字和原先块成为一体了？ 有时用户可能会调整字的大小或位置等！成为一体反而觉得不方便了！

eachy

最初由 xgwl 发布
[B]好程序！ 但为什么编好号的文字和原先块成为一体了？ 有时用户可能会调整字的大小或位置等！成为一体反而觉得不方便了！ [/B]

用 Ctrl+H 可以开关，一体仅是编组，用夹点可以任意移动的。

xgwl

知道了！谢谢！ 看看大家觉得数字该放哪比较好！ 或者给出个选择, 让用户自己选字的位置!:)