[LISP程序]：快速修剪，欢迎下载试用！

yedajiang · 发表于 2005-12-19 15:30:22

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

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

×

类似Pro/E的修剪工具，自己编写的，没有更好的办法，代码稍长了点，但功能还是可以的，欢迎下载试用。
程序需要ap-api函数支持，本函数论坛中有下载。
(defun c:trr(/ ap:sysvars ap:undoctl ap:old-error
      osm n lst lst_10 aid_lst aid_lst2 pt)
  (setvar "cmdecho" 0)
  (ap-push-error ap-error)
  (ap-exit-transparent)
  (ap-push-undo nil)
  (ap-push-vars '(("SKETCHINC")("SKPOLY")("osmode")))
  (setq osm (getvar "osmode"))
  (setvar "SKPOLY" 1)
  (setvar "SKETCHINC" 0.1)
  (setvar "osmode" 0)
  (princ "\n拾取修剪的开始点:")
  (vl-cmdf "sketch" "")
  (setq n 0)
  (setq lst(entget(entlast)))
  (while (setq lst_10 (assoc 10 lst))
(if lst_10(setq lst_10(trans(cdr lst_10)0 1)))
(if (= n 0)(setq aid_lst2 (list(strcat (rtos(car lst_10)2 4)","(rtos(cadr lst_10)2 4))))
   (progn
(setq aid_lst (cons(strcat (rtos(car lst_10)2 4)","(rtos(cadr lst_10)2 4)) aid_lst2))
(setq aid_lst2 aid_lst)))
(setq n (+ n 1))
(setq lst (subst '(120 120 120)(assoc 10 lst) lst)))
  (setq aid_lst2(reverse aid_lst2))
  (entdel(entlast))
  (repeat 2
(setq n -1)
(vl-cmdf "trim" "" "f")
(repeat (length aid_lst2)
   (vl-cmdf (setq pt (nth (setq n (1+ n)) aid_lst2))))
(vl-cmdf "" ""))
  (ap-pop-vars)
  (ap-pop-undo)
  (ap-pop-error)
  (setvar "cmdecho" 1)
  (princ)
  )
效果如图：

yedajiang · 发表于 2005-12-19 15:50:11

图片，如下：
一个贴子只能有一个附件吗？

shuaier · 发表于 2005-12-19 16:02:48

把ap-api函数一起放上来吗嘛,省的去搜索!

andyhua5240 · 发表于 2005-12-19 19:48:24

最初由 shuaier 发布
[B]把ap-api函数一起放上来吗嘛,省的去搜索! [/B]

支持长老的建议！希望把ap-ap函数放上来！
谢谢！

yedajiang · 发表于 2005-12-20 15:01:34

好吧，好像昨天上传了一次，没传上来

同志们，别光下载不回贴呀？？？？

xyz518mm · 发表于 2005-12-20 22:56:24

好东西喔
谢谢提供了

lhj743 · 发表于 2005-12-21 08:31:43

支持楼主！
强烈建议楼主改进！
能够修剪掉块那就是空前绝后的好程序了！

lfx49 · 发表于 2005-12-21 09:05:28

支持一下

secwolf · 发表于 2005-12-21 09:54:45

对,块是个好东西但也有调皮的时候.

yedajiang · 发表于 2005-12-21 12:06:43

块也要修剪呀？问题是有意义吗？
举个实例说明一下为什么要修剪块。。。。
编程应该没有太大的难度。

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

[LISP程序]：快速修剪，欢迎下载试用！

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

相关帖子