[下载]：实现智能剪切的lisp程序

xyzjint_cn

该程序实现的功能如图中所示，只要选择矩形，便可将穿过矩形的直线剪切（以前是一条一条的选择），由于水平有限，程序的语句可能太繁琐，但功能对我面言很实用（以前我下载了一个，但效果不好，连矩形外也剪掉了），

请各位高手优化！
源程序如下：

2. 
   
3. (defun c:mytrim (/ rect e0 e1 pt x ptx pty  l1 i p1 p2 p1x p1y point count)
   
4.   (setvar "osmode" 0)
   
5.   (setq l1 nil)
   
6.   (setq i 0)
   
7.   (setq rect (car (entsel "\n请选择需剪切的矩形:")))
   
8.   (setq e0 (entget rect))
   
9.   (while (setq x (nth i e0))
   
10.     (if        (= (car x) 10)
    
11.       (progn
    
12.         (setq ptx (nth 1 x))
    
13.         (setq pty (nth 2 x))
    
14.         (setq x (list ptx pty))
    
15.         (setq l1 (cons x l1))
    
16.       )
    
17.     )
    
18.     (setq i (1+ i))
    
19.   )
    
20.   (reverse l1)
    
21.   (setq p1 (car l1))
    
22.   (setq p1x (nth 0 p1))
    
23.   (setq p1y (nth 1 p1))
    
24.   (setq count 0)
    
25.   (repeat 3
    
26.     (setq count (+ count 1))
    
27.     (setq pt (nth count l1))
    
28.     (setq ptx (nth 0 pt))
    
29.     (setq pty (nth 1 pt))
    
30.     (setq point (mapcar '+ p1 pt))
    
31.     (setq point (mapcar '/ point '(2.0 2.0 2.0)))
    
32.     (if
    
33.       (and (/= (nth 0 point) p1x)
    
34.            (/= (nth 0 point) ptx)
    
35.            (/= (nth 1 point) p1y)
    
36.            (/= (nth 1 point) pty)
    
37.       )
    
38.        (setq p point)
    
39.     )
    
40.   )
    
41.   (setq l1 nil)
    
42.   (command "offset" 5 rect p "")
    
43.   (setq e0 (entlast))
    
44.   (setq e1 (entget e0))
    
45.   (princ e1)
    
46.   (setq i 0)
    
47.   (while (setq x (nth i e1))
    
48.     (if        (= (car x) 10)
    
49.       (progn
    
50.         (setq ptx (nth 1 x))
    
51.         (setq pty (nth 2 x))
    
52.         (setq x (list ptx pty))
    
53.         (setq l1 (cons x l1))
    
54.       )
    
55.     )
    
56.     (setq i (1+ i))
    
57.   )
    
58.   (reverse l1)
    
59.   (setq p1 (car l1))
    
60.   (command "erase" e0 "")
    
61.   (setq count 0)
    
62.   (repeat 3
    
63.     (setq count (+ count 1))
    
64.     (setq pt (nth count l1))
    
65.     (command "trim" rect "" "f" p1 pt """")
    
66.   )
    
67.   (setq p1 (cadr l1))
    
68.   (command "erase" e0 "")
    
69.   (setq count 1)
    
70.   (repeat 2
    
71.     (setq count (+ count 1))
    
72.     (setq pt (nth count l1))
    
73.     (command "trim" rect "" "f" p1 pt """")
    
74.   )  
    
75.    (setvar "osmode" 687)
    
76. )

<br /> (defun c:mytrim (/ rect e0 e1 pt x ptx pty  l1 i p1 p2 p1x p1y point count)<br />   (setvar "osmode" 0)<br />   (setq l1 nil)<br />   (setq i 0)<br />   (setq rect (car (entsel "\n请选择需剪切的矩形:")))<br />   (setq e0 (entget rect))<br />   (while (setq x (nth i e0))<br />     (if        (= (car x) 10)<br />       (progn<br />         (setq ptx (nth 1 x))<br />         (setq pty (nth 2 x))<br />         (setq x (list ptx pty))<br />         (setq l1 (cons x l1))<br />       )<br />     )<br />     (setq i (1+ i))<br />   )<br />   (reverse l1)<br />   (setq p1 (car l1))<br />   (setq p1x (nth 0 p1))<br />   (setq p1y (nth 1 p1))<br />   (setq count 0)<br />   (repeat 3<br />     (setq count (+ count 1))<br />     (setq pt (nth count l1))<br />     (setq ptx (nth 0 pt))<br />     (setq pty (nth 1 pt))<br />     (setq point (mapcar '+ p1 pt))<br />     (setq point (mapcar '/ point '(2.0 2.0 2.0)))<br />     (if<br />       (and (/= (nth 0 point) p1x)<br />            (/= (nth 0 point) ptx)<br />            (/= (nth 1 point) p1y)<br />            (/= (nth 1 point) pty)<br />       )<br />        (setq p point)<br />     )<br />   )<br />   (setq l1 nil)<br />   (command "offset" 5 rect p "")<br />   (setq e0 (entlast))<br />   (setq e1 (entget e0))<br />   (princ e1)<br />   (setq i 0)<br />   (while (setq x (nth i e1))<br />     (if        (= (car x) 10)<br />       (progn<br />         (setq ptx (nth 1 x))<br />         (setq pty (nth 2 x))<br />         (setq x (list ptx pty))<br />         (setq l1 (cons x l1))<br />       )<br />     )<br />     (setq i (1+ i))<br />   )<br />   (reverse l1)<br />   (setq p1 (car l1))<br />   (command "erase" e0 "")<br />   (setq count 0)<br />   (repeat 3<br />     (setq count (+ count 1))<br />     (setq pt (nth count l1))<br />     (command "trim" rect "" "f" p1 pt """")<br />   )<br />   (setq p1 (cadr l1))<br />   (command "erase" e0 "")<br />   (setq count 1)<br />   (repeat 2<br />     (setq count (+ count 1))<br />     (setq pt (nth count l1))<br />     (command "trim" rect "" "f" p1 pt """")<br />   )  <br />    (setvar "osmode" 687)<br /> )

xiaping

这个程序与CAD扩展工具里的用特定边界剪切是不是一样？从介绍来看应该是差不多吧。

lsjjm

你5月7日不是发过这个问题的帖子吗，我给你写了一个程序。 你还说很实用，怎么， 又有什么新问题了吗？

xyzjint_cn

你的程序在实际使用中，有时将矩形的边或矩形外的线剪切掉了，我的程序参照你的程序重新编了一下，不好意思，借用了你的思路.(朋友多，互相学习)
有些语句实际上重复了，昨天我又改了下，源程序如下：
(defun c:mytrim
       (/ rect e0 e1 pt x ptx pty l1 i p1 p2 p1x p1y point count)
  (setvar "osmode" 0)
  (setq l1 nil)
  (setq i 0)
  (setq rect (car (entsel "\n请选择需剪切的矩形:")))
  (setq e0 (entget rect))
  (while (setq x (nth i e0))
    (if        (= (car x) 10)
      (progn
        (setq ptx (nth 1 x))
        (setq pty (nth 2 x))
        (setq x (list ptx pty))
        (setq l1 (cons x l1))
      )
    )
    (setq i (1+ i))
  )
  (reverse l1)
  (setq p1 (car l1))
  (setq p1x (nth 0 p1))
  (setq p1y (nth 1 p1))
  (setq count 0)
  (repeat 3
    (setq count (+ count 1))
    (setq pt (nth count l1))
    (setq ptx (nth 0 pt))
    (setq pty (nth 1 pt))
    (setq point (mapcar '+ p1 pt))
    (setq point (mapcar '/ point '(2.0 2.0 2.0)))
    (if
      (and (/= (nth 0 point) p1x)
           (/= (nth 0 point) ptx)
           (/= (nth 1 point) p1y)
           (/= (nth 1 point) pty)
      )
       (setq p point)
    )
  )
  (setq l1 nil)
  (command "offset" 5 rect p "")
  (setq e0 (entlast))
  (setq e1 (entget e0))
  (princ e1)
  (setq i 0)
  (while (setq x (nth i e1))
    (if        (= (car x) 10)
      (progn
        (setq ptx (nth 1 x))
        (setq pty (nth 2 x))
        (setq x (list ptx pty))
        (setq l1 (cons x l1))
      )
    )
    (setq i (1+ i))
  )
  (reverse l1)
  (setq p1 (car l1))
  (setq p2 p1)
  (command "erase" e0 "")
  (setq count 0)
  (repeat 3
    (setq count (+ count 1))
    (setq pt (nth count l1))
    (command "trim" rect "" "f" p1 pt "" "")
    (setq p1 pt)
  )
  (command "trim" rect "" "f" p1 p2 "" "")
  (setvar "osmode" 687)
)

xyzjint_cn

该程序的主要思路如下：
选择得到矩形RECT，求出矩形顶点的选择集，根据顶点集求出矩形的中心坐标，将矩形OFFSET得到一个原有矩形RECT内稍微小一点的矩形，得到新矩形顶点的选择集，根据4个顶点进行原有矩形RECT的剪切。
中间有些程序可移植到别的程序中（象求出矩形的顶点集，由此可求出LWPOLYLINE的顶点集）

pandoit

express工具里面好像有这个命令吧，你这个程序有什么特殊的地方吗？请详细介绍一下好吗？

2002zjp

我需要把矩形的边或矩形外的线也剪切掉的程序。谁有？

lijiao

能做一个剪切边界为圆或闭合的多义线来剪切的程序吗？

lsjjm

编程思路：以圆为剪切边的情况，先找出与圆相交的直线的在圆外的端点，然后以圆为剪切边剪切。
多边形或闭合的多义线利用fence来剪切。

qsh100

能做一个剪切边界为圆或闭合的多义线来剪切的程序吗

light_dream

能做一个剪切下来后复制到其他地方的程序吗？

newer

最初由 2002zjp 发布
[B]我需要把矩形的边或矩形外的线也剪切掉的程序。谁有？ [/B]

回复7，8，10，11楼的朋友：

晓东工具箱里面提供了“图形切割”，“图形裁减”，正是符合你们要求的。