he520930 发表于 2007-11-10 14:32:00

[求助]写个小程序(这个对我来说很实用)

求你写一个简单而实用的小程序:<br/>用法:运行命令---点选某图纸中任一对象文字(目的是读取这个文字的颜色)---然后框选图形或整个图形(就可以把刚才点选的文字相同颜色的文字全部选了)----然后回车----点起点(复制文字起点)---点终点(复制相同文字终点)就行了.<br/>总的来说:就是读取文字颜色来复制框选中相同颜色的文字的小程序.本来我可以用CAD<br/>本身的"快速选择"的功能就可以了,但图形太大,用这个"快速选择"运行得太慢,希望热心人能帮助一下.谢谢了!

BDYCAD 发表于 2007-11-10 15:10:00

本帖最后由 作者 于 2007-11-10 15:11:43 编辑

;;;编程:BDYCAD   时间:20071110
(defun c:test(/ BASCOLOR COLORSEL ENAME I II MOVEEPT MOVESPT NEW-VLNAME P1 P2 SS VLNAME)
(if(setq Ename(car(entsel"\n请选择对象：")))
    (if(setq p1(getpoint"\n请输入起点："))
      (if(setq p2(getpoint p1"\n请全入终点："))
(progn
   (setq BasColor(vla-get-color(vlax-ename->vla-object Ename))
ColorSel(cons 62 BasColor)
)
   (if(setq SS(ssget"X"(list ColorSel(cons 0 "TEXT"))))
   (progn
       (setq i 0)
       (setq MoveSpt(vlax-3d-point p1)MoveEpt(vlax-3d-point p2))
       (repeat(sslength ss)
(setq Ename(ssname ss i)
      Vlname(vlax-ename->vla-object Ename)
      New-Vlname(vla-copy Vlname))
(vla-move New-Vlname MoveSpt MoveEpt)
(setq i(1+ ii)))
       )
   )
   )
)
      )
    )
(princ)
)

BDYCAD 发表于 2007-11-10 16:16:00

本帖最后由 作者 于 2007-11-10 16:17:10 编辑

改一下程序运行顺序!!!!;;;编程:BDYCAD   时间:20071110
(defun c:test(/ BASCOLOR ENAME I MOVEEPT MOVESPT NEW-VLNAME P1 P2 SS VLNAME)
(if(setq SS(ssget'((0 . "TEXT"))))
   (if(setq Ename(car(entsel"\n请选择对象：")))
   (if(setq p1(getpoint"\n请输入起点："))
       (if(setq p2(getpoint p1"\n请全入终点："))
(progn
    (setq BasColor(vla-get-color(vlax-ename->vla-object Ename)) )
    (progn
      (setq i 0)
      (setq MoveSpt(vlax-3d-point p1)MoveEpt(vlax-3d-point p2))
      (repeat(sslength ss)
   (setq Ename(ssname ss i)
Vlname(vlax-ename->vla-object Ename)
)
   (if(=(vla-get-color Vlname)BasColor)
   (progn
       (setq New-Vlname(vla-copy Vlname))
       (vla-move New-Vlname MoveSpt MoveEpt)
       ))
   (setq i(1+ i)))
      )
    )
)
       )
   )
    )
   (princ)
   )


hydkot99 发表于 2008-2-20 08:08:00

错误: no function definition: VLAX-ENAME-&gt;VLA-OBJECT
页: [1]
查看完整版本: [求助]写个小程序(这个对我来说很实用)