长风（尚品） 发表于 2013-1-8 13:50:22

增强修剪

忘记是那位仁兄发的代码了。用了一下只能实现图中中间样子，那位能帮忙修改一下能施现第三个样式。谢谢
;;;修剪曲线距最近交点点取边
;;;功能: 以曲线与其它曲线最进交点为判断点,修剪曲线点取处的一边.
(defun c:zqxj (/ A BOX D11 D12 D21 D22 E EE EE2 LL P RR SS nm nm2)
   (vl-load-com)
   (while
   (and
       (setq a (entsel))
       (setq e(car a)
         nm (vla-get-objectname (vlax-ename->vla-object e))
       )
       (setq p (vlax-curve-getclosestpointto e (cadr a)))
   )
      (setq ee (entlast))
      (if (member nm '("AcDbRay" "AcDbXline"))
      (setq box (mapcar 'getvar '("vsmin" "vsmax")))
      (progn (vla-GetBoundingBox (vlax-ename->vla-object e) 'll 'rr)
         (setq box    (list (vlax-safearray->list ll)(vlax-safearray->list rr))
         )
      )
      )
      (setq ss (ssget "c" (car box) (cadr box) '((0 . "*LINE,ARC,RAY,CIRCLE,ELLIPSE"))))
      (command ".trim" ss "r" e "" "e" "n" (list e p) "");!!!
      (if (equal ee (setq ee2 (entlast)))
      nil
      (progn
      (setq nm2 (vla-get-objectname (vlax-ename->vla-object ee2))
            d11 (distance p (vlax-curve-getstartpoint e))
            d12 (if (= nm2 "AcDbRay")1e99(distance p (vlax-curve-getendpoint e)))
            d21 (distance p (vlax-curve-getstartpoint ee2))
            d22 (if (= nm2 "AcDbRay") 1e99(distance p (vlax-curve-getendpoint ee2)))
      )
      (if (member (min d11 d12 d21 d22) (list d11 d12))
      (entdel ee2)
      (entdel e)
      )
      )
      )
   )
   (princ)
)

注册 发表于 2013-1-9 15:17:18

长风老弟，论坛有这个代码额，双线裁剪，自己查一下

长风（尚品） 发表于 2013-1-9 16:50:37

注册 发表于 2013-1-9 15:17 static/image/common/back.gif
长风老弟，论坛有这个代码额，双线裁剪，自己查一下

有没有具体地址？找了几个都不太合适

crazylsp 发表于 2013-1-11 12:12:07

(if (equal ee (setq ee2 (entlast)))
      nil
      (progn
      (setq nm2 (vla-get-objectname (vlax-ename->vla-object ee2))
            d11 (distance p (vlax-curve-getstartpoint e))
            d12 (if (= nm2 "AcDbRay")1e99(distance p (vlax-curve-getendpoint e)))
            d21 (distance p (vlax-curve-getstartpoint ee2))
            d22 (if (= nm2 "AcDbRay") 1e99(distance p (vlax-curve-getendpoint ee2)))
      )
      (if (member (min d11 d12 d21 d22) (list d11 d12))
      (entdel ee2)
      (entdel e)
      )
      )
      )

把这一部分删去后再保存就可以达到想要的效果了

长风（尚品） 发表于 2013-1-11 13:14:50

crazylsp 发表于 2013-1-11 12:12 static/image/common/back.gif
把这一部分删去后再保存就可以达到想要的效果了

谢谢，是这样效果

mycad 发表于 2013-3-18 17:08:59

谢谢楼上的几位高手，学习了。

friendship 发表于 2013-12-20 23:28:17

谢谢你，挺好用的

混沌初开 发表于 2013-12-23 23:24:58

首先感谢两位大神的源码.输入TR后连续两次回车,再选择被修剪的物件,也可以达到楼主的要求!

caibaobao 发表于 2014-1-3 12:09:05

将楼主的源码保存为LSP后，运行提示“错误: 输入的列表有缺陷”？

caibaobao 发表于 2014-1-3 12:14:05

8楼楼主使用的CAD版本是多少？TR是否是trim命令？如果运行trim命令按楼主方法无法达到，请教啦
页: [1]
查看完整版本: 增强修剪