[VBA程序]：标注所有直线的坐标

purplebamboo

出次的程序 很简单 但是也许会有些用处
自己编的一个小程序 捕捉的是直线的起点 只要首位相连的直线 都能标坐标 可以自定义比例 且返回实体的个数 必须是直线 ！！用在道路用地图非常好用 先在cad里选择好直线到vbide里运行就好了

雪山飞狐(lzh)

你加密了，怎么到vbide里运行？
先选择再运行？光靠VBA是搞不定的

purplebamboo

密码是780411 是啊 比较郁闷 只能用alt+tab 切换 刚开始学 只知道firstselect这个选择级

雪山飞狐(lzh)

转自明经通道：
    如果写的程序直接在VBA IDE中点击运行项，PickfirstSelectionSet方法是可行，可以做到先选择后操作。
    但我们不可能运行VBA程序都这样做，最麻烦的一种就是使用工具菜单->宏对话框来执行程序，但这种方法已经不能使用PickfirstSelectionSet方法了，也就是说PickfirstSelectionSet方法得不到所要的选择集。
    通过其它很多方法如：
    直接使用命令-VBARUN UnNameGroup.dvb!AddUnNameGroup也不能用先选择后操作方法；
    直接用(VL-VBARUN "UnNameGroup.dvb!AddUnNameGroup") 执行也不能用先选择后操作方法；
    编个LISP程序来执行该宏也不行。
    关键问题是调用vba命令 _.vbarun,我们跳过vbarun就行了。

    如下：
Private Sub AcadDocument_BeginLisp(ByVal FirstLine As String)
Select Case UCase(FirstLine)
       Case "(C:GADD)"
             AddUnNameGroup
       Case "(C:GDEL)"
            MsgBox "gdel"
            DelUnNameGroup
End Select
End Sub

(defun c:gadd()(princ))  (defun c:gdel()(princ))

command:gadd
    就可以了！
   
    通过以上的描述，如果要使PickfirstSelectionSet方法可用，则必须跳过使用vbarun命令或函数来调用过程，而必须采用事件来自动激发。所以就得在LISP程序中定义一个空的程序，然后通过AcadDocument_BeginLisp事件来调用。

雪山飞狐(lzh)

我的办法是：
下列代码在Cad2005及2002中测试通过


Lisp代码



(defun c:aabbcc()
(setvar "cmdecho" 0)
(if (ssget) (command "-vbarun" "aabbcc"))
(setvar "cmdecho" 1)
(princ)
)



VBA代码



Sub aabbcc()
    ' This example lists all the objects in the pickfirst selection set.
    ' Before running this example, create some objects in the active
    ' drawing and select thos   e objects. The objects currently selected
    ' in the active drawing will be returned in the pickfirst selection set.
            
    Dim pfSS As AcadSelectionSet
    Dim ssobject As AcadEntity
    Dim msg As String
    msg = vbCrLfa
   
    Set pfSS = ThisDrawing.ActiveSelectionSet
   
    For Each ssobject In pfSS
        msg = msg & vbCrLf & ssobject.ObjectName
    Next ssobject
    MsgBox "The Pickfirst selection set contains: " & msg
   
End Sub

purplebamboo

十分感谢 学了不少知识

q_billy

是你写的吗？英文注释，牛逼

自由的鱼

不错！！

雪山飞狐(lzh)

实际上有更好的解决办法
见http://www.xdcad.net/forum/showthread.php?s=&threadid=242988