删除矩形内竖线

kzd2004

如图，当我画矩形的时候，自动删除里面的竖线，自己用trim编写的好卡，求助高人帮忙。

kwok

(defun c:tt (/ p1 p2 en )
  (setq p1 (getpoint "\n指定点："))
  (setq p2 (getcorner p1 "\n指定点："))
  (command "rectang" p1 p2)
  (setq en (entlast))
(command ".trim" en ""  "f" "non" p1 "non" p2 "" "")
  (princ)
  )

xyp1964

kzd2004

xyp1964 发表于 2024-1-15 12:44

谢谢你，正是需要的，大佬能给我源码吗？

kzd2004

大佬不回复，给画了个饼，请问还有知道的吗？请帮忙，谢谢。

x_s_s_1

胡编乱造版

1. (defun c:tt  (/ en en1 en2 en3 f pt1 pt2)
   
2.     (setq pt1 (getpoint "\n第一点:")
   
3.     pt2 (getcorner pt1 "\n第二点:"))
   
4.     (vl-cmdf "rectangle" "non" pt1 "non" pt2)
   
5.     (setq en  (vlax-ename->vla-object (entlast))
   
6.     en1 (car (vlax-invoke en 'offset 1e-3))
   
7.     en2 (car (vlax-invoke en 'offset -1e-3)))
   
8.     (if  (> (vlax-get en1 'length) (vlax-get en2 'length))
   
9.   (setq en3 en1
   
10.         en1 en2
    
11.         en2 en3))
    
12.     (setq f  (mapcar
    
13.      'cdr
    
14.      (vl-remove-if-not '(lambda (x) (= 10 (car x)))
    
15.            (entget (vlax-vla-object->ename en1)))))
    
16.     (vla-delete en1)
    
17.     (vla-delete en2)
    
18.     (vl-cmdf "trim"
    
19.        (vlax-vla-object->ename en)
    
20.        ""
    
21.        "f"
    
22.        "non"
    
23.        (car f)
    
24.        "non"
    
25.        (cadr f)
    
26.        "non"
    
27.        (caddr f)
    
28.        "non"
    
29.        (cadddr f)
    
30.        "non"
    
31.        (car f)
    
32.        ""
    
33.        ""))

(defun c:tt  (/ en en1 en2 en3 f pt1 pt2)<br />     (setq pt1 (getpoint "\n第一点:")<br />     pt2 (getcorner pt1 "\n第二点:"))<br />     (vl-cmdf "rectangle" "non" pt1 "non" pt2)<br />     (setq en  (vlax-ename->vla-object (entlast))<br />     en1 (car (vlax-invoke en 'offset 1e-3))<br />     en2 (car (vlax-invoke en 'offset -1e-3)))<br />     (if  (> (vlax-get en1 'length) (vlax-get en2 'length))<br />   (setq en3 en1<br />         en1 en2<br />         en2 en3))<br />     (setq f  (mapcar<br />      'cdr<br />      (vl-remove-if-not '(lambda (x) (= 10 (car x)))<br />            (entget (vlax-vla-object->ename en1)))))<br />     (vla-delete en1)<br />     (vla-delete en2)<br />     (vl-cmdf "trim"<br />        (vlax-vla-object->ename en)<br />        ""<br />        "f"<br />        "non"<br />        (car f)<br />        "non"<br />        (cadr f)<br />        "non"<br />        (caddr f)<br />        "non"<br />        (cadddr f)<br />        "non"<br />        (car f)<br />        ""<br />        ""))

bai2000

楼上，对直线、多义线支持有缺陷，会删除框外的线段

kzd2004

kwok 发表于 2024-1-15 10:42
(defun c:tt (/ p1 p2 en )
  (setq p1 (getpoint "\n指定点："))
  (setq p2 (getcorner p1 "\n指定点： ...

谢谢你了。

kzd2004

kwok 发表于 2024-1-15 10:42
(defun c:tt (/ p1 p2 en )
  (setq p1 (getpoint "\n指定点："))
  (setq p2 (getcorner p1 "\n指定点： ...

请问"non"这个是什么意思？

qazxswk

kzd2004 发表于 2024-1-17 22:17
请问"non"这个是什么意思？

临时取消捕捉。