[求助]请高手帮忙看看这个"线段等分打断"程序为什么会'认生"

pfd8667 · 发表于 2005-3-29 21:20:00

我是从论坛下载这"线段等分打断"程序,很实用方便,是我一人在单位四台机子拷贝加载,却获得二个效果,二台能运行命令行提示见图一,,二台无法运行命令行提示见图二.
四台机子都是XP操作系统,我都加载在CAD2004版本,CAD2004并没有装任何外挂工具,但二台无法运行的还装有CAD2002版本,我不懂编程,误认为是否二个版本冲突引起,就将CAD2002删除了,但还是不能运行,见笑了.
恳请高手帮看看到底是什么原因,会不会程序不完善呢,附上该程序,先谢谢了!

(defun c:xbr (/ os oe ss vss n d len e obj e)
(princ "\n等分打断线段")
(defun *error* (msg) (setvar "osmode" os)(vl-cmdf ".undo" "e")(setq *error* oe))
(vl-cmdf ".undo" "be")
(princ "\n选择要等分的对象:")
(setq oe *error*
os (getvar "osmode")
ss (ssget '((0 . "LINE,*POLYLINE,SPLINE,ARC")))
vss (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
(setvar "osmode" 0)
(or (setq n (getint "\n定数等分<需定距等分/直接回车>:")) (setq d (getdist "\n指定线段长度:")))
(vlax-for obj vss
(setq len (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj))
e (vlax-vla-object->ename obj))
(if n (setq d (/ len n) m n)
(setq m (1+ (fix (/ len d)))))
(repeat (1- m)
(if (setq pt (vlax-curve-getpointatdist obj d))
(vl-cmdf ".break" (list e pt) pt)
)
(setq e (entlast)
obj (vlax-ename->vla-object e))
)
)
(setvar "osmode" os)
(vl-cmdf ".undo" "e")(princ)
)

meflying · 发表于 2005-3-30 11:59:00

图不是很清楚，你还是描述一下出问题的系统是出现什么问题。我WIN2000+CAD2004运行没有问题

pfd8667 · 发表于 2005-3-30 15:18:00

管理员您好! 当选择线段回车后,就结束了.我不懂编程,一位斑主提出看法如下:请管理员参考,能给一个完善的程序. VLISP中这句会经常出错,
(vla-get-activeselectionset
(vla-get-activedocument (vlax-get-acad-object))
)
[转贴]
调用activeselectionset时真正的内部过程是
新建CURRENT选择集(如果选择集不存在则新建，如果选择集
存在则Clear清空)->用AddItems方法将最后一次选择集的物
件放到该选择集中。

meflying · 发表于 2005-3-30 17:05:00

本帖最后由作者于 2005-3-30 19:01:52 编辑

改成这样你再试试 (defun c:xbr (/ os oe ss vss n i d len e obj e)
(princ "\n等分打断线段")
(defun *error* (msg)
(setvar "osmode" os)
(vl-cmdf ".undo" "e")
(setq *error* oe)
)
(vl-cmdf ".undo" "be")
(princ "\n选择要等分的对象:")
(setq oe *error*
os (getvar "osmode")
ss (ssget '((0 . "LINE,*POLYLINE,SPLINE,ARC")))
)
(setvar "osmode" 0)
(or (setq n (getint "\n定数等分<需定距等分/直接回车>:"))
(setq d (getdist "\n指定线段长度:"))
)
(setq i 0)
(if ss
(repeat (sslength ss)
(setq e (ssname ss i))
(setq len (vlax-curve-getdistatparam e (vlax-curve-getendparam e)))
(if n
(setq d (/ len n)
m n
)
(setq m (1+ (fix (/ len d))))
)
(repeat (1- m)
(if (setq pt (vlax-curve-getpointatdist e d))
(vl-cmdf ".break" (list e pt) pt)
)
(setq e (entlast))
)
(setq i (1+ i))
)
(setvar "osmode" os)
(vl-cmdf ".undo" "e")
(princ)
)

pfd8667 · 发表于 2005-3-30 17:49:00

管理员您好!

谢谢您的热心帮助,在原不能运行命令的机子试了,还是不行,连命令也为未知命令了.

meflying · 发表于 2005-3-30 19:02:00

复制上来的时候不知道怎么漏了一个括号，4楼的程序已修改好，你再试试

pfd8667 · 发表于 2005-3-30 21:29:00

管理员您好!

不好意思,给你增添麻烦了,还是不行,也许这程序不完善,有时在画的曲线打断等分也不一样,我也想放弃了.谢谢了

龙龙仔 · 发表于 2005-3-31 08:14:00

;;4楼程序还是差一个")"(defun C:XBR (/ OS OE SS VSS N I D LEN E OBJ E)
(princ "\n等分打断线段") (defun *ERROR* (MSG)
(setvar "osmode" OS)
(vl-cmdf ".undo" "e")
(setq *ERROR* OE)
) (vl-cmdf ".undo" "be")
(princ "\n选择要等分的物件:")
(setq OE *ERROR*
OS (getvar "osmode")
SS (ssget '((0 . "LINE,*POLYLINE,SPLINE,ARC")))
)
(setvar "osmode" 0)
(or (setq N (getint "\n定数等分<需定距等分/直接回车>:"))
(setq D (getdist "\n指定线段长度:"))
)
(setq I 0)
(if SS
(repeat (sslength SS)
(setq E (ssname SS I))
(setq
LEN (vlax-curve-getdistatparam E (vlax-curve-getendparam E))
)
(if N
(setq D (/ LEN N)
M N
)
(setq M (1+ (fix (/ LEN D))))
)
(repeat (1- M)
(if (setq PT (vlax-curve-getpointatdist E D))
(vl-cmdf ".break" (list E PT) PT)
)
(setq E (entlast))
)
(setq I (1+ I))
)
)
(setvar "osmode" OS)
(vl-cmdf ".undo" "e")
(princ)
)

meflying · 发表于 2005-3-31 08:39:00

为什么？难怪开始会少一个括号，我记得我是测试过再复制上来的，而且怎么会少中间的括号，真是搞不明白了。。。

pfd8667 · 发表于 2005-3-31 10:38:00

龙龙仔您好! 您总算出面了,先谢谢您了,成功了. 但另外这程序还有个问题,在西南等轴测画曲线再用三维动态观察器转动后去打断时,有时会出现打断的等分数少了,产生长短不一,有时又是绝对等分,挺奇怪的.您不信的话多试试,不知这问题如何解决?

账号		自动登录	找回密码
密码			注册

[求助]请高手帮忙看看这个"线段等分打断"程序为什么会'认生"

本帖子中包含更多资源

本帖子中包含更多资源

浏览过的版块