自动修剪框内/外的曲线

荒野孤行

功能：以选取的参照框为分割基准，自动修剪框内/外的曲线。
还有些待修复的BUG，如：（1）当曲线的起点和终点在参照框上时 （2）当多段线沿着参照框弯折时（见图片演示的BUG）。
相对AutoCAD中Express工具中自带的extrim，可以删除框内的曲线。各位亦可根据此源码进行修改后判断曲线是在框内/上/外。
若有更好的建议，还望提供下思路，谢谢！
源码如下：

(defun c:t1 (/ sslst orien)
  (princ
    "\n功能：自动修剪与选定框相交的曲线，可选择修剪框内或框外的曲线部分."
  )
  (setvar "osmode" 15359)
  (setvar "cmdecho" 0)
  (vl-load-com)
  (command "undo" "be")
  (while
    (progn (setq ent (entsel "\n请选择参照曲线框：\n"))
           (not        (if (= ent nil)
                  nil
                  (wcmatch (cdr (assoc 0 (entget (car ent))))
                           "LWPOLYLINE,POLYLINE,SPLINE,ARC,CIRCLE"
                  )                        ;限定只能选取的曲线类型
                )
           )
    )
     (princ
       "\n提示：选取的不是多段线、样条曲线、圆弧、圆弧或未选取任何图元，请重新选取第一条曲线：\n"
     )
  )
  (princ "\n请选择曲线对象：")
  (if (not (setq ss (ssget '((0 . "CIRCLE,ARC,*LINE")))))
    (progn (princ "\n未选中任何曲线，程序退出。") (exit))
  )
  (setq        pt   (getpoint "\n指定要修剪的方向：")
        obj  (vlax-ename->vla-object (car ent))
        len  (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj))
        area (vlax-curve-getarea obj)
        i    0
        j    0
  )
(command "_.offset" 0.001 ent pt "")
  (setq ent_last (entlast))
  (setq        obj_last  (vlax-ename->vla-object ent_last)
        len_last  (vlax-curve-getdistatparam
                    obj_last
                    (vlax-curve-getendparam obj_last)
                  )
        area_last (vlax-curve-getarea obj_last)
  )
  (if (and (< len_last len) (< area_last area)) ;若选取的参照点是在框内
    (setq orien T)
    (setq orien nil)
  )
  (setvar "osmode" 0)
  (repeat (sslength ss)
    (setq ssnam (ssname ss i))
    (setq ssobj (vlax-ename->vla-object ssnam))
    (if        (setq jiaodian (vlax-invoke ssobj 'intersectwith obj 0))
                                        ;判断是否存在交点
      (if (and (= (length jiaodian) 3)
               (or (equal jiaodian (vlax-curve-getStartPoint ssobj))
                   (equal jiaodian (vlax-curve-getEndPoint ssobj))
               )
          )
        (setq j (+ j 1))
        (progn
          (setq        ptAllInt (vlax-invoke ssobj 'intersectwith obj_last 0)
                ptOneInt
                         (list (list (car ptAllInt)
                                     (cadr ptAllInt)
                                     (nth 2 ptAllInt)
                               )
                         )
          )
          (setq newent (cons ssnam ptOneInt))
          (command "TRIM" ent "" newent "")
        )
      )
      (if orien
        (progn
          (setq ptstart (vlax-curve-getstartpoint ssobj))
          (command "_.offset" 0.001 ent ptstart "")
          (setq ent_tmp (entlast))
          (setq        obj_tmp         (vlax-ename->vla-object ent_tmp)
                len_tmp         (vlax-curve-getdistatparam
                           obj_tmp
                           (vlax-curve-getendparam obj_tmp)
                         )
                area_tmp (vlax-curve-getarea obj_tmp)
          )
          (vla-delete obj_tmp)
          (if (and (< len_tmp len) (< area_tmp area))
            (vla-delete ssobj)
          )
        )
      )
    )
    (setq i (1+ i))
  )
  (vla-delete obj_last)
  (setvar "osmode" 15359)
  (command "undo" "e")
  (princ)
)

chixun99

这个程序判断2个交点以上时可能会有问题，修剪的线段如果是内部，可能把另一端的外部线修剪了。

荒野孤行

fsafaffa 发表于 2017-12-2 11:27
BUG修好了吗，顶

没有，待你们修啊。

13648893846

回帖是一种美德！感谢楼主的无私分享 谢谢

tender138

很牛的程序，修着备用，谢谢分享

xzd716

谢谢分享！

999999

谢谢大神分享，期待有其它大神修改

w245272914

我来回贴了，东西有用。不错的思路

fsafaffa

BUG修好了吗，顶

机械小男人雄起

感谢楼主，有用

逍遥天下

分享源码，顶顶顶