请问怎么把墙体切开

juliana207

各位老师能否做个lisp,  就是把类似这样闭合多段线丁字形墙, 点取2个点, 自动切开分成2个闭合的图形

xyp1964

;; 墙体切开

juliana207

xyp1964 发表于 2022-7-1 12:43
;; 墙体切开

院长这个需要您的工具箱支持把, 能否提供源码的? 谢谢

qazxswk

针对目前的图形，可以获取8个顶点坐标，然后以4个顶点坐标为一组，重新画出两个矩形，再删除原来的图形。但这个有点局限性，如果原图形上有很多顶点，比如超过8个顶点。用此方式可能就比较麻烦。

juliana207

这也是论坛忘记是那个的一个程序, 它是切开去掉一部分,能否帮忙改下? , 我是要切开2部分都保留谢谢!

juliana207

qazxswk 发表于 2022-7-4 18:39
针对目前的图形，可以获取8个顶点坐标，然后以4个顶点坐标为一组，重新画出两个矩形，再删除原来的图形。但 ...

请看下面的回复,以为我回复你上传不了附件咯

qazxswk

以下代码，只对于一些情况可行，并不通用。供参考。
(defun c:tt (/ ss pt p0 p2 p4 p6 )
(setq ss(entsel "\n选择对象"))
(setq pt(vl-remove-if-not'(lambda(x)(=(car x)10))(entget(car ss))) pt(mapcar'cdr pt))
(setq p0(nth 0 pt))
(setq p2(nth 2 pt))
(setq p4(nth 4 pt))
(setq p6(nth 6 pt))
(command "rectang" p0 p2)
(command "rectang" p4 p6)
(command "_.erase" ss "")
(princ))

qazxswk

下面这个代码，可以通用。方法有点笨，代码供参考。


(defun c:tt (/ ss p0 p1 p2 en en1 pt p3 p4)
(setq p1 (getpoint "\n分割线第一点"))
(setq p2 (getpoint p1 "\n分割线第二点"))
(setq ss (ssget "c" p1 p2 ))
(setq p0 (mapcar' *(mapcar' + p1 p2)'(0.5 0.5)))
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")(cons 90 2)
(cons 10 p1) (cons 10 p2)))
(setq en (entlast))
(command "rotate" en "" "non" p0 "c" 90)
(setq en1 (entlast))
(setq pt(vl-remove-if-not'(lambda(x)(=(car x)10))(entget (entlast))) pt(mapcar'cdr pt))
(setq p3(nth 0 pt))
(setq p4(nth 1 pt))
(if en1 (command "_.erase" en1 ""))
(command "-boundary" p3 "")
(command "-boundary" p4 "")
(command "_.erase" ss "")
(if en (command "_.erase" en ""))
(princ))

夏生生

仅针对标准图元，不保证函数拷贝全了

1. (defun c:test (/ a b el1 el2 lst nl ptl ss)
   
2.   (prompt"\n选择需转换图元:")
   
3.   (setq  ss  (ssget '((0 . "lwpolyline") (90 . 8) (70 . 1)))
   
4.   lst (xty-tr-ss2lst ss t)
   
5.   )
   
6.   (foreach n lst
   
7.     (setq ptl (mapcar
   
8.     'cdr
   
9.     (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget n))
   
10.     )
    
11.     nl  (xty-G-concave ptl)
    
12.     )
    
13.     (if  (= 2 (length nl))
    
14.       (progn (setq a   (car nl)
    
15.        b   (cadr nl)
    
16.        el1 (xty-L-retain (1+ a) (1+ b) ptl)
    
17.        el1 (if (= 6 (length el1))
    
18.        (vl-remove (nth b ptl) (vl-remove (nth a ptl) el1))
    
19.        el1
    
20.        )
    
21.        el2 (xty-L-remove el1 ptl)
    
22.        )
    
23.        (xty-make-lwpl el1 1 0)
    
24.        (xty-make-lwpl el2 1 0)
    
25.        )
    
26.       )
    
27.     (entdel n)
    
28.     )
    
29.   (princ)
    
30.   )
    
31. (defun xty-tr-ss2lst (ss form / n en lst)
    
32.   (repeat (setq n (sslength ss))
    
33.     (setq en (ssname ss (setq n (1- n))))
    
34.     (setq lst (cons en lst))
    
35.   )
    
36.   (setq lst(reverse lst))
    
37.   (if form lst (mapcar(function *xty-e2o*)lst))
    
38. )
    
39. (defun xty-G-Clockwise-p (lst)
    
40.   (minusp
    
41.     (apply '+
    
42.      (mapcar
    
43.        (function
    
44.          (lambda (a b)
    
45.      (- (* (car b) (cadr a)) (* (car a) (cadr b)))
    
46.          )
    
47.        )
    
48.        lst
    
49.        (cons (last lst) lst)
    
50.      )
    
51.     )
    
52.   )
    
53. )
    
54. (defun xty-G-concave (lst / p lst1 n)
    
55.   (setq p (xty-G-Clockwise-p lst))
    
56.   (setq lst(xty-L-listo- lst))
    
57.   (setq lst (xty-L-listn (append lst(list(cadr lst))) 3))
    
58.   (setq  n    -1
    
59.   lst1 nil
    
60.   )
    
61.   (while lst
    
62.     (setq n (1+ n))
    
63.     (if  (/= p (xty-G-Clockwise-p (car lst)))
    
64.       (setq lst1 (cons n lst1))
    
65.     )
    
66.     (setq lst (cdr lst))
    
67.   )
    
68.   (reverse lst1)
    
69. )
    
70. (defun xty-make-lwpl (plist mode w / ocs ed)
    
71.   (setq ocs (trans '(0 0 1) 1 0 t))
    
72.   (setq  ed (list (cons 0 "LWPOLYLINE")
    
73.      (cons 100 "AcDbEntity")
    
74.      (cons 100 "AcDbPolyline")
    
75.      (cons 90 (length plist))
    
76.      (cons 70 mode)
    
77.      (cons 43 w)
    
78.      )
    
79.   )
    
80.   (foreach elem  plist
    
81.     (setq
    
82.       ed (append ed
    
83.      (list (cons 10 (trans elem 1 ocs))
    
84.      )
    
85.    )
    
86.     )
    
87.   )
    
88.   (setq ed (append ed (list (cons 210 ocs))))
    
89.   (entmakex ed)
    
90. )
    
91. (defun xty-L-cdrn  (n lst /)
    
92.   (repeat n (setq lst (cdr lst)))
    
93.   )
    
94. (defun xty-L-remove (dellst lst)
    
95.   (foreach n dellst (setq lst (vl-remove n lst)))
    
96.   lst
    
97.   )
    
98. (defun xty-L-carn  (n lst / lsta)
    
99.   (setq lsta nil)
    
100.   (repeat n
     
101.     (setq lsta (append lsta (list (car lst)))
     
102.     lst  (cdr lst)))
     
103.   lsta)
     
104. (defun xty-L-deln  (n lst /)
     
105.   (vl-remove (nth (1- n) lst) lst)
     
106.   )
     
107. (defun xty-L-retain  (m n lst /)
     
108.   (setq lst (xty-L-carn n lst))
     
109.   (setq lst (if(= 1 m)lst(xty-L-cdrn (1- m) lst)))
     
110.   )

(defun c:test (/ a b el1 el2 lst nl ptl ss)<br />   (prompt"\n选择需转换图元:")<br />   (setq  ss  (ssget '((0 . "lwpolyline") (90 . 8) (70 . 1)))<br />   lst (xty-tr-ss2lst ss t)<br />   )<br />   (foreach n lst<br />     (setq ptl (mapcar<br />     'cdr<br />     (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget n))<br />     )<br />     nl  (xty-G-concave ptl)<br />     )<br />     (if  (= 2 (length nl))<br />       (progn (setq a   (car nl)<br />        b   (cadr nl)<br />        el1 (xty-L-retain (1+ a) (1+ b) ptl)<br />        el1 (if (= 6 (length el1))<br />        (vl-remove (nth b ptl) (vl-remove (nth a ptl) el1))<br />        el1<br />        )<br />        el2 (xty-L-remove el1 ptl)<br />        )<br />        (xty-make-lwpl el1 1 0)<br />        (xty-make-lwpl el2 1 0)<br />        )<br />       )<br />     (entdel n)<br />     )<br />   (princ)<br />   )<br /> (defun xty-tr-ss2lst (ss form / n en lst)<br />   (repeat (setq n (sslength ss))<br />     (setq en (ssname ss (setq n (1- n))))<br />     (setq lst (cons en lst))<br />   )<br />   (setq lst(reverse lst))<br />   (if form lst (mapcar(function *xty-e2o*)lst))<br /> )<br /> (defun xty-G-Clockwise-p (lst)<br />   (minusp<br />     (apply '+<br />      (mapcar<br />        (function<br />          (lambda (a b)<br />      (- (* (car b) (cadr a)) (* (car a) (cadr b)))<br />          )<br />        )<br />        lst<br />        (cons (last lst) lst)<br />      )<br />     )<br />   )<br /> )<br /> (defun xty-G-concave (lst / p lst1 n)<br />   (setq p (xty-G-Clockwise-p lst))<br />   (setq lst(xty-L-listo- lst))<br />   (setq lst (xty-L-listn (append lst(list(cadr lst))) 3))<br />   (setq  n    -1<br />   lst1 nil<br />   )<br />   (while lst<br />     (setq n (1+ n))<br />     (if  (/= p (xty-G-Clockwise-p (car lst)))<br />       (setq lst1 (cons n lst1))<br />     )<br />     (setq lst (cdr lst))<br />   )<br />   (reverse lst1)<br /> )<br /> (defun xty-make-lwpl (plist mode w / ocs ed)<br />   (setq ocs (trans '(0 0 1) 1 0 t))<br />   (setq  ed (list (cons 0 "LWPOLYLINE")<br />      (cons 100 "AcDbEntity")<br />      (cons 100 "AcDbPolyline")<br />      (cons 90 (length plist))<br />      (cons 70 mode)<br />      (cons 43 w)<br />      )<br />   )<br />   (foreach elem  plist<br />     (setq<br />       ed (append ed<br />      (list (cons 10 (trans elem 1 ocs))<br />      )<br />    )<br />     )<br />   )<br />   (setq ed (append ed (list (cons 210 ocs))))<br />   (entmakex ed)<br /> )<br /> (defun xty-L-cdrn  (n lst /)<br />   (repeat n (setq lst (cdr lst)))<br />   )<br /> (defun xty-L-remove (dellst lst)<br />   (foreach n dellst (setq lst (vl-remove n lst)))<br />   lst<br />   )<br /> (defun xty-L-carn  (n lst / lsta)<br />   (setq lsta nil)<br />   (repeat n<br />     (setq lsta (append lsta (list (car lst)))<br />     lst  (cdr lst)))<br />   lsta)<br /> (defun xty-L-deln  (n lst /)<br />   (vl-remove (nth (1- n) lst) lst)<br />   )<br /> (defun xty-L-retain  (m n lst /)<br />   (setq lst (xty-L-carn n lst))<br />   (setq lst (if(= 1 m)lst(xty-L-cdrn (1- m) lst)))<br />   )