（完成）[编程申请]：再次求：批量消除“0长度线”的lisp

CCarch · 发表于 2002-8-4 03:52:59

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

从盐场回来，在没有网络的日子，我差点就死掉～～～
现在想寻求消除0长度的二维线的lisp，最好还是批量处理文件的lisp；）
这些0长度的线可能是R12装R14的是否错误产生的，我也不清楚从那里出现：（

各位lisp好手帮帮我，谢谢！

eachy · 发表于 2002-8-4 06:42:31

上一次发帖时论坛不正常，丢了帖子。

(defun c:del_zero (/ ss)
(xdrx_begin)
(princ "\n删除0长度曲线....")
(setq ss (ssget "X" '((0 . "*line"))))
(xdrx_setsstodb ss 0)
(while (setq e (xdrx_getentdata 0))
(setq sp (car (xdrx_curve_getpoint e))
mp (cadr (xdrx_curve_getpoint e))
ep (last (xdrx_curve_getpoint e))
)
(if (= 0
(distance sp mp)
(distance mp ep)
)
(xdrx_entity_delete e)
)
)
;;(command ".purge" "all" "y" "")
(xdrx_saveas (getvar "dwgname"))
;;(command ".open")
(xdrx_end)
(princ)
)

CCarch · 发表于 2002-8-4 22:36:35

谢谢eachy！！！非常感谢！！！
但是有问题，看下面的命令行提示：

[FONT=courier new]
*** 请访问“晓东的CAD空间 [url]http://xdsoft.126.com”获取最新版本[/url] ***
已成功加载 xdrx_api15.arx。
已成功加载 del_zero.lsp。
命令: del_zero
删除0长度曲线....
命令:
[/FONT]

复制代码

结果什么也没有变化，R14、R2002均是如此，到底是那里出现了错误呢？附上原文件

XDSoft · 发表于 2002-8-4 23:16:37

最初由 CCarch 发布
[B]谢谢eachy！！！非常感谢！！！
但是有问题，看下面的命令行提示：

写了另外一个版本，可以删除指定长度为上限的所有超短曲线(LINE,POLYLINE,LWPOLYLINE,ELLIPSE,ARC,CIRCLE,SPLINE),试试...

[FONT=courier new]
;|
命令：curve_rsline
功能：删除小于指定长度的超短线(line,polyline,lwpolyline,arc,circle,ellipse,spline)
程序配合XDRX_API build 20630＋版本使用，朋友们可以把这个LISP拷贝到“晓东工具箱”的安装的
LISP目录，自己加入到菜单里面就可以非常方便的使用了。
关于程序的建议请到“晓东CAD空间-编程申请”论坛
[url]http://www.xdcad.net/forum留言[/url]
|;
(defun c:curve_rsline (/ ss dis dist1 e)
(xdrx_begin)
(if (not (setq dis (getreal "\n请输入要删除的超短曲线长度上限<0>:")))
(setq dis 0.0)
)
(princ (strcat "\n删除长度小于 " (rtos dis 2 2) " 的曲线...."))
(setq ss (ssget "X" '((0 . "*line,arc,ellipse,circle"))))
(xdrx_setsstodb ss 0)
(while (setq e (xdrx_getentdata 0))
(setq dist1 (xdrx_getarea e)
dist1 (last dist1)
)
(if (<= dist1 dis)
(xdrx_entity_delete e)
)
)
(xdrx_saveas (getvar "dwgname"))
(xdrx_end)
(princ)
)
[/FONT]

[FONT=courier new] 
;| 
   命令：curve_rsline 
    
   功能：删除小于指定长度的超短线(line,polyline,lwpolyline,arc,circle,ellipse,spline) 
 
        程序配合XDRX_API build 20630＋版本使用，朋友们可以把这个LISP拷贝到“晓东工具箱”的安装的 
        LISP目录，自己加入到菜单里面就可以非常方便的使用了。 
        关于程序的建议请到“晓东CAD空间-编程申请”论坛 
        [url]http://www.xdcad.net/forum留言[/url]          
    
|; 
(defun c:curve_rsline (/ ss dis dist1 e) 
  (xdrx_begin) 
  (if (not (setq dis (getreal "\n请输入要删除的超短曲线长度上限<0>:"))) 
    (setq dis 0.0) 
  ) 
  (princ (strcat "\n删除长度小于 " (rtos dis 2 2) " 的曲线....")) 
  (setq ss (ssget "X" '((0 . "*line,arc,ellipse,circle")))) 
  (xdrx_setsstodb ss 0) 
  (while (setq e (xdrx_getentdata 0)) 
    (setq dist1 (xdrx_getarea e) 
          dist1 (last dist1) 
    ) 
    (if (<= dist1 dis) 
      (xdrx_entity_delete e) 
    ) 
  )                                      
  (xdrx_saveas (getvar "dwgname")) 
  (xdrx_end) 
  (princ) 
) 
[/FONT]

CCarch · 发表于 2002-8-5 00:01:17

完全搞定，感谢两位老二高手；）
其中，xd的可以定义线段长度的功能尤其灵活，相信在很多地方可以灵活应用！
再次感谢！！！

eachy · 发表于 2002-8-5 08:02:34

最初由 CCarch 发布
[B]谢谢eachy！！！非常感谢！！！
但是有问题，看下面的命令行提示：
[CODE]

*** 请访问“晓东的CAD空间 http://xdsoft.126.com”获取最新版本 ***
已成功加载 xdrx_api15.arx?.. [/B]

没问题呀，可以删除。

echo226 · 发表于 2006-3-30 17:47:53

完全搞定，感谢两位老二高手；）

lpg200033 · 发表于 2008-8-28 22:32:49

不知道为什么，我运行不起来啊

yukiboy · 发表于 2008-9-1 13:53:32

好东西

平面构成 · 发表于 2008-9-21 11:50:20

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

（完成）[编程申请]：再次求：批量消除“0长度线”的lisp

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子