修剪封口

luyu9635

大家来看看这个怎么实现 ，本人写了个简单的，请高手完善，谢谢了，请看动画
;;luyu9635 2013.01.03
;;以线修剪并封口
(defun c:ff(/ en ent ent1 p1 p2 po  i ss)
(cond
   (
    (setq ss(ssget'((0 . "*LINE"))))
    (setvar 'cmdecho 0)(command ".undo" "be")
    (setq p1(getpoint"\n指定第一点:") p2(getpoint p1 "\n指定第二点:"))(grdraw  p1 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

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

999999

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

emk

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

luyu9635

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

刚才我试了，可以下啊

sicky111

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

云中孤鹰

确实不错！

香田里浪人

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

USER2128

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

tianyi1230

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

yoyoho

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

zwf100

支持一下，好像很少用到