矩形内剪切

Qwer1243

按照偏移思路写的一个矩形内剪切，有需要的可以试用一下，也可以帮忙优化一下

2. ;;;;;;;;;矩形内剪切;;;;;;;;
   
3. (defun c:itr (/ data en ens i lst lupt maxx maxy minx miny os p1 p2 p3 p4 pt_zx pts rdpt rect ss)
   
4.   (command "undo" "be")
   
5.   (setq os (getvar "osmode"))
   
6.   (setvar "osmode" 0)
   
7.   (setq ss (ssget '((0 . "LWPOLYLINE") (70 . 1))))
   
8.   (setq i 0 ens nil)
   
9.   (repeat (sslength ss)
   
10.     (setq ens (cons (ssname ss i) ens))
    
11.     (setq i (1+ i))
    
12.   )
    
13.   ;;以下代码获取选取所有矩形的范围坐标
    
14.   (setq pts nil)
    
15.   (foreach rect ens
    
16.     (setq data (entget rect))
    
17.     (foreach lst data
    
18.       (if (= (car lst) 10)
    
19.         (setq pts (append pts (list (cdr lst))))
    
20.       )
    
21.     )
    
22.   )
    
23.   (setq pts (vl-sort pts (function (lambda (e1 e2) (< (car e1) (car e2))))))
    
24.   (setq minx (caar pts) maxx (caar (reverse pts)))
    
25.   (setq pts (vl-sort pts (function (lambda (e1 e2) (< (cadr e1) (cadr e2))))))
    
26.   (setq miny (cadar pts) maxy (cadar (reverse pts)))
    
27.   (setq lupt (list (- minx 100) (+ maxy 100))  rdpt (list (+ maxx 100) (- miny 100)))
    
28.   (command "_.zoom" lupt rdpt)
    
29.   (foreach rect ens
    
30.     ;;以下代码获取矩形的四点坐标
    
31.     (setq data (entget rect) pts  nil)
    
32.     (foreach lst data
    
33.       (if (= (car lst) 10)
    
34.         (setq pts (append pts (list (cdr lst))))
    
35.       )
    
36.     )
    
37.     (setq pt_zx (mapcar '(lambda (x y) (* (+ x y) 0.5)) (nth 0 pts) (nth 2 pts))) ;求矩形中心坐标
    
38.     (command "offset" 0.1 rect pt_zx "");偏移0.1可以调整，作为精度
    
39.     (setq en (entlast))
    
40.     ;;以下代码获取偏移矩形的四点坐标
    
41.     (setq data (entget en) pts  nil)
    
42.     (foreach lst data
    
43.       (if (= (car lst) 10)
    
44.         (setq pts (append pts (list (cdr lst))))
    
45.       )
    
46.     )
    
47.     (command "erase" en "")
    
48.     (setq p1 (nth 0 pts) p2 (nth 1 pts) p3 (nth 2 pts) p4 (nth 3 pts))
    
49.     ;;四点坐标相互剪切
    
50.     (progn
    
51.       (command "trim" rect "" "f" p1 p2 "" "")
    
52.       (command "trim" rect "" "f" p1 p4 "" "")
    
53.       (command "trim" rect "" "f" p3 p2 "" "")
    
54.       (command "trim" rect "" "f" p3 p4 "" "")
    
55.     )
    
56.   )
    
57.   (command "_.zoom" "p")
    
58.   (setvar "osmode" os)
    
59.   (command "undo" "e")
    
60.   (princ)
    
61. )

;;;;;;;;;矩形内剪切;;;;;;;;<br /> (defun c:itr (/ data en ens i lst lupt maxx maxy minx miny os p1 p2 p3 p4 pt_zx pts rdpt rect ss)<br />   (command "undo" "be")<br />   (setq os (getvar "osmode"))<br />   (setvar "osmode" 0)<br />   (setq ss (ssget '((0 . "LWPOLYLINE") (70 . 1))))<br />   (setq i 0 ens nil)<br />   (repeat (sslength ss)<br />     (setq ens (cons (ssname ss i) ens))<br />     (setq i (1+ i))<br />   )<br />   ;;以下代码获取选取所有矩形的范围坐标<br />   (setq pts nil)<br />   (foreach rect ens<br />     (setq data (entget rect))<br />     (foreach lst data<br />       (if (= (car lst) 10)<br />         (setq pts (append pts (list (cdr lst))))<br />       )<br />     )<br />   )<br />   (setq pts (vl-sort pts (function (lambda (e1 e2) (< (car e1) (car e2))))))<br />   (setq minx (caar pts) maxx (caar (reverse pts)))<br />   (setq pts (vl-sort pts (function (lambda (e1 e2) (< (cadr e1) (cadr e2))))))<br />   (setq miny (cadar pts) maxy (cadar (reverse pts)))<br />   (setq lupt (list (- minx 100) (+ maxy 100))  rdpt (list (+ maxx 100) (- miny 100)))<br />   (command "_.zoom" lupt rdpt)<br />   (foreach rect ens<br />     ;;以下代码获取矩形的四点坐标<br />     (setq data (entget rect) pts  nil)<br />     (foreach lst data<br />       (if (= (car lst) 10)<br />         (setq pts (append pts (list (cdr lst))))<br />       )<br />     )<br />     (setq pt_zx (mapcar '(lambda (x y) (* (+ x y) 0.5)) (nth 0 pts) (nth 2 pts))) ;求矩形中心坐标<br />     (command "offset" 0.1 rect pt_zx "");偏移0.1可以调整，作为精度<br />     (setq en (entlast))<br />     ;;以下代码获取偏移矩形的四点坐标<br />     (setq data (entget en) pts  nil)<br />     (foreach lst data<br />       (if (= (car lst) 10)<br />         (setq pts (append pts (list (cdr lst))))<br />       )<br />     )<br />     (command "erase" en "")<br />     (setq p1 (nth 0 pts) p2 (nth 1 pts) p3 (nth 2 pts) p4 (nth 3 pts))<br />     ;;四点坐标相互剪切<br />     (progn<br />       (command "trim" rect "" "f" p1 p2 "" "")<br />       (command "trim" rect "" "f" p1 p4 "" "")<br />       (command "trim" rect "" "f" p3 p2 "" "")<br />       (command "trim" rect "" "f" p3 p4 "" "")<br />     )<br />   )<br />   (command "_.zoom" "p")<br />   (setvar "osmode" os)<br />   (command "undo" "e")<br />   (princ)<br /> )

技术工作室

http://bbs.mjtd.com/forum.php?mo ... hlight=%C9%BE%B3%FD
这里的也挺好！

bai2000

没有和框相交的图元未被修剪，应该加个删除框内的图元的功能

mokson

值得学习借鉴！

aws

;---删除封闭多段线内的图元
(defun del-in-en(en / obj obj2 plst pts s)
        (setq obj(vlax-ename->vla-object en))
        (setq obj2(car(vlax-safearray->list(vlax-variant-value(vla-Offset obj -0.01)))))
        (setq pts(vlax-safearray->list(vlax-variant-value(vla-get-coordinates obj2))))
        (setq plst nil)
        (while(>=(length pts)2);---两个一组分割成点表
                (setq plst(cons(list(car pts)(cadr pts))plst))
                (setq pts(cddr pts))
        )
        (entdel(vlax-vla-object->ename obj2))
        (vl-cmdf "TRIM" en "" "f")(mapcar 'vl-cmdf plst)(vl-cmdf "" "")
        (if(setq s(ssget "cp" plst))(vl-cmdf "ERASE" s ""))
)


刚好，我前两天也写了一个，献丑

Qwer1243

bai2000 发表于 2024-5-11 06:51
没有和框相交的图元未被修剪，应该加个删除框内的图元的功能

因为我工作中需要的只有剪切，不需要删除矩形内图元，所以只写了剪切的功能

Qwer1243

aws 发表于 2024-5-11 08:56
;---删除封闭多段线内的图元
(defun del-in-en(en / obj obj2 plst pts s)
        (setq obj(vlax-ename->vla-o ...

感谢分享，学习一下