[求助]一张大的底图，如何快速裁切出其中一块矩形区域另存？

nabworm

[求助]一张大的底图，如何快速裁切出其中一块矩形区域另存？

情况：底图很大，多段线、样条线、矩形、直线均有

目的：标准的矩形区域，不要有多余的边边角角

sony-lin

使用 矩形（trim）

利用图点两点 自动得到rectang

然后向外offset rectang

代码如下：

1. (defun C:JJ
       (/ PT1 PT2 S1 ANG D PT3 PT4)
   
   
2.     (princ
       "\n框选剪切")
   
   
3.     (if        (and
       (setq PT1 (getpoint
       "\n第一角点: "))
   
   
4.              (setq PT2 (getcorner PT1 " >>>第二角点: "))
   
   
5.         )
   
   
6.         (progn
   
   
7.             ;;绘制临时边界
   
   
8.             (command
       "_rectang" PT1 PT2)
   
   
9.             (setq S1 (entlast))
   
   
10.             ;;计算边界内的四个角点
    
    
11.             (setq ANG(+ pi (angle PT1 PT2))
    
    
12.                   D   (distance PT1 PT2)
    
    
13.                   D   (* D 1e-2)
    
    
14.                   T1 (polar PT1 ANG D)
    
    
15.                   T2 (polar PT2 (+ ANG pi) D)
    
    
16.                   T3 (list
        (car PT1)
        (cadr PT2))
    
    
17.                   T4 (list
        (car PT2)
        (cadr PT1))
    
    
18.             )
    
    
19.             ;;强力剪切
    
    
20.             (repeat
        10
    
    
21.                 (command
        "_.trim" S1 ""
        "f" PT1 PT3 PT2 PT4 PT1 ""
        "")
    
    
22.             )
    
    
23.             (command
        "_.erase" "all" "r" "w" PT1 PT2 "")
    
    
24.             ;;删去临时边界
    
    
25.             (command
        "_.erase" S1 "")
    
    
26.         )
    
    
27.     )
    
    
28.     (princ)
    
    
29. )
        ;_结束 defun

nabworm

牛人,研究 中

nabworm

时灵时不灵

有时会出些奇怪的问题，剪切得只剩几根线？

不知道是因为哪回事

还有图大的时候就会很慢(先截个大致范围后处理就行了)

总之很PF了

nabworm

repeat 10      ；是什么意思？

   "_.trim" S1 ""
    "f" PT1 PT3 PT2 PT4 PT1 ""
    "")

查遍资料也没找出TRIM居然有F这个豆豆，什么意思？ 

还真是大牛人啊

sony-lin

repeat 10 这里表示10次trim

10次主要是对于多段线的

这个是不能剪接参照 和块的！！

nabworm

受教1次，继续

xgr

试试我的代码

(defun c:txjq3 (/      aa     oldgroup     oldcmd oldblip  oldsnap
  en     dp     az     px     p1    ss1   ss2  sc
  en1    az1    p2     pn1    pn2    px1 pxmax
        )
  (setvar "LUPREC" 8)
  (setq oldgroup (getvar "pickstyle")) ;保存编组开关
  (setvar "pickstyle" 0)  ;关闭编组
  (setq oldcmd (getvar "cmdecho")) ;保存控制 command 函数运行期间，AutoCAD 是否回显提示和输入
  (setvar "cmdecho" 0)   ;关闭command 函数运行期间，AutoCAD 回显提示和输入
  (setq oldblip (getvar "blipmode")) ;保存控制点标记
  (setvar "blipmode" 0)   ;关闭点标记
  (setq oldsnap (getvar "osmode")) ;保存对象捕捉方式
  (setvar "osmode" 0)   ;关闭对象捕捉式
  (while
    (or (= (if (= (setq en (nentselp "\n选择作为剪切边界的闭合多段线:"))
    nil
        )
      (setq aa "空选择!")
    )
    "空选择!"
 )
 (= (if (/= (cdr (assoc 0 (entget (car en)))) "LWPOLYLINE")
      (setq aa "类型错误!")
    )
    "类型错误!"
 )
 (= (if (and (/= (cdr (assoc 70 (entget (car en)))) 129)
      (/= (cdr (assoc 70 (entget (car en)))) 1)
        )
      (setq aa "线段不闭合!")
    )
    "线段不闭合!"
 )
    )
     (alert (strcat "选择错误-" aa ",重新选择!"))
  )     ;选择控制
  (setq ent (car en))
  (setvar "osmode" oldsnap)
  (setvar "osmode" 16383)
  (setq dp (getpoint "\n请选择一点作为剪切基点......."))
  (setvar "osmode" 0)
  (setq az (entget (car en)))
  (setq px (list))
  (while (assoc 10 az)
    (setq p1 (cdr (assoc 10 az)))
    (setq az (cdr (member (assoc 10 az) az)))
    (setq px (cons p1 px))
  )
  (setq pxmax(list
    (apply 'mapcar (cons 'min px))
    (apply 'mapcar (cons 'max px))
  ))
  (command "zoom" "w" (car pxmax) (cadr pxmax))
  (setq ss (ssget "cp" px))
  (vl-cmdf "copy" ss "" dp pause)
  (setq dp1 (getvar "lastpoint"))
  (vl-cmdf "copy" en "" dp dp1)
  (setq en (entlast))
  (print "\n正在剪切复制选中的图形,请稍侯......")
  (setq px (list))
  (while (assoc 10 az)
    (setq p1 (cdr (assoc 10 az)))
    (setq az (cdr (member (assoc 10 az) az)))
    (setq px (cons p1 px))
  )
  (setq sc en)
  (command "offset" 0.1 sc dp "")
  (setq en1 (entlast))
  (setq az1 (entget en1))
  (setq px1 (list))
  (while (assoc 10 az1)
    (setq p2 (cdr (assoc 10 az1)))
    (setq az1 (cdr (member (assoc 10 az1) az1)))
    (setq px1 (cons p2 px1))
  )
  (setq px1 (cons (car px1) (reverse px1)))
  (command "erase" en1 "")
  (while (setq pn1 (car px1)
        pn2 (cadr px1)
  )
    (command "trim" en "" "f" pn1 pn2 "" "")
    (if (setq del (ssget "f" (list pn1 pn2)))
      (command "erase" del "")
    )
    (setq px1 (cdr px1))
  )
  (setvar "LUPREC" 8)
  (setvar "pickstyle" oldgroup)
  (setvar "cmdecho" oldcmd)
  (setvar "blipmode" oldblip)
  (setvar "osmode" oldsnap)
  (princ)
)
怎么加载不用多说吧！

图形剪切边界接触哦到块的话，请先分解块，剪切出来的图形复制在本图内，

如果要另存，请用带基点复制到新图。

nabworm

研究中

不错，非常细致

思路貌似与前例一样，就是为什么大家都知道这个TRIM有个F的用法，我却到处都查不到？

范例地图测试中,分解块的问题和我想的一样，毕竟任何块都要打散才能被VBA和VLISP操作

详细程序研究中............

继续

nabworm

效果基本上可以达到商用水准了

看来我还是要进行选择集和ActiveX方面的学习呀

源码跟踪学习中...

[从鱼到渔]