修剪封口

luyu9635 发表于 2013-11-4 21:49:43

本帖最后由 luyu9635 于 2013-11-4 21:58 编辑

大家来看看这个怎么实现，本人写了个简单的，请高手完善，谢谢了，请看动画
;;luyu9635 2013.01.03
;;以线修剪并封口
(defun c:ff(/ en ent ent1 p1 p2 poi ss)
(cond
(
(setq ss(ssget'((0 . "*LINE"))))
(setvar 'cmdecho 0)(command ".undo" "be")
(setq p1(getpoint"\n指定第一点:") p2(getpoint p1 "\n指定第二点:"))(grdrawp1 p2 1)
(setq po(getpoint"\n剪掉哪边:"))
(entmake (list '(0 . "line") '(62 . 1) (cons 10 p1) (cons 11 p2)))
(setq en(entlast) vla(vlax-ename->vla-object en) new(ssadd) i 0)
(repeat (sslength ss)
      (setq ent(ssname ss i) ent1(vlax-ename->vla-object ent))
      (if (and (setq pts(intpt ent1 vla 0))(> (length pts) 1))
            (progn
            (entmake (list '(0 . "line") '(62 . 1) (cons 10 (car pts)) (cons 11 (cadr pts))))
            (ssadd (entlast) ss)
            )
      )
   (command ".trim" en "" (list ent po) "")
(setq i(1+ i))
)
(entdel en)(redraw)
(setvar "PEDITACCEPT" 1)
(if (= (sslength ss) 1)
      (vl-cmdf "PEDIT" (ssname ss 0) "j" "all" "" "")
      (command "PEDIT" "m" ss "" "j" "" "")
)
(setvar "PEDITACCEPT" 0)
(command ".undo" "e")(setvar 'cmdecho 1)

)
)
(princ)
)

;;两obj物件交点
(defun intpt (obj1 obj2 mod / lst lst2 x y z)
(setq lst (vlax-invoke obj1 'intersectwith obj2 mod))
(while (setq x (car lst))
(setq y (cadr lst)
z (caddr lst)
lst(cdddr lst)
lst2 (cons (list x y z) lst2)
)
)
)

白色微風1991 发表于 2022-8-19 15:04:30

直持樓主，，，謝謝樓主的分享

999999 发表于 2020-8-30 10:25:35

直持楼主，，，谢谢楼主的分享

emk 发表于 2013-11-4 22:02:52

演示图片压缩包【名字】长一点哈，没法下载

luyu9635 发表于 2013-11-4 22:09:14

emk 发表于 2013-11-4 22:02 static/image/common/back.gif
演示图片压缩包【名字】长一点哈，没法下载

刚才我试了，可以下啊

sicky111 发表于 2013-11-4 22:37:47

动画看不了，是我电脑的问题吗？

云中孤鹰 发表于 2013-11-5 09:55:38

确实不错！

香田里浪人 发表于 2013-11-5 13:02:10

下载试用，确实不错！很实用。

USER2128 发表于 2013-11-6 08:05:20

非常实用的程序！多谢楼主！

tianyi1230 发表于 2013-11-7 11:20:55

看起来不赖，楼主的东西还应该实用

yoyoho 发表于 2016-1-22 09:26:44

感谢楼主分享程序,似乎不支持line封口!

zwf100 发表于 2016-1-26 21:12:30

支持一下，好像很少用到

页: [1] 2

明经CAD社区's Archiver

修剪封口