请问怎么把墙体切开
各位老师能否做个lisp,就是把类似这样闭合多段线丁字形墙, 点取2个点, 自动切开分成2个闭合的图形;; 墙体切开
xyp1964 发表于 2022-7-1 12:43
;; 墙体切开
院长这个需要您的工具箱支持把, 能否提供源码的? 谢谢 针对目前的图形，可以获取8个顶点坐标，然后以4个顶点坐标为一组，重新画出两个矩形，再删除原来的图形。但这个有点局限性，如果原图形上有很多顶点，比如超过8个顶点。用此方式可能就比较麻烦。 这也是论坛忘记是那个的一个程序, 它是切开去掉一部分,能否帮忙改下? , 我是要切开2部分都保留谢谢! qazxswk 发表于 2022-7-4 18:39
针对目前的图形，可以获取8个顶点坐标，然后以4个顶点坐标为一组，重新画出两个矩形，再删除原来的图形。但 ...
请看下面的回复,以为我回复你上传不了附件咯:'( 以下代码，只对于一些情况可行，并不通用。供参考。
(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 于 2022-7-5 20:23 编辑
下面这个代码，可以通用。方法有点笨，代码供参考。:lol
(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))
仅针对标准图元，不保证函数拷贝全了
(defun c:test (/ a b el1 el2 lst nl ptl ss)
(prompt"\n选择需转换图元:")
(setqss(ssget '((0 . "lwpolyline") (90 . 8) (70 . 1)))
lst (xty-tr-ss2lst ss t)
)
(foreach n lst
(setq ptl (mapcar
'cdr
(vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget n))
)
nl(xty-G-concave ptl)
)
(if(= 2 (length nl))
(progn (setq a (car nl)
b (cadr nl)
el1 (xty-L-retain (1+ a) (1+ b) ptl)
el1 (if (= 6 (length el1))
(vl-remove (nth b ptl) (vl-remove (nth a ptl) el1))
el1
)
el2 (xty-L-remove el1 ptl)
)
(xty-make-lwpl el1 1 0)
(xty-make-lwpl el2 1 0)
)
)
(entdel n)
)
(princ)
)
(defun xty-tr-ss2lst (ss form / n en lst)
(repeat (setq n (sslength ss))
(setq en (ssname ss (setq n (1- n))))
(setq lst (cons en lst))
)
(setq lst(reverse lst))
(if form lst (mapcar(function *xty-e2o*)lst))
)
(defun xty-G-Clockwise-p (lst)
(minusp
(apply '+
(mapcar
(function
(lambda (a b)
(- (* (car b) (cadr a)) (* (car a) (cadr b)))
)
)
lst
(cons (last lst) lst)
)
)
)
)
(defun xty-G-concave (lst / p lst1 n)
(setq p (xty-G-Clockwise-p lst))
(setq lst(xty-L-listo- lst))
(setq lst (xty-L-listn (append lst(list(cadr lst))) 3))
(setqn -1
lst1 nil
)
(while lst
(setq n (1+ n))
(if(/= p (xty-G-Clockwise-p (car lst)))
(setq lst1 (cons n lst1))
)
(setq lst (cdr lst))
)
(reverse lst1)
)
(defun xty-make-lwpl (plist mode w / ocs ed)
(setq ocs (trans '(0 0 1) 1 0 t))
(setqed (list (cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(cons 90 (length plist))
(cons 70 mode)
(cons 43 w)
)
)
(foreach elemplist
(setq
ed (append ed
(list (cons 10 (trans elem 1 ocs))
)
)
)
)
(setq ed (append ed (list (cons 210 ocs))))
(entmakex ed)
)
(defun xty-L-cdrn(n lst /)
(repeat n (setq lst (cdr lst)))
)
(defun xty-L-remove (dellst lst)
(foreach n dellst (setq lst (vl-remove n lst)))
lst
)
(defun xty-L-carn(n lst / lsta)
(setq lsta nil)
(repeat n
(setq lsta (append lsta (list (car lst)))
lst(cdr lst)))
lsta)
(defun xty-L-deln(n lst /)
(vl-remove (nth (1- n) lst) lst)
)
(defun xty-L-retain(m n lst /)
(setq lst (xty-L-carn n lst))
(setq lst (if(= 1 m)lst(xty-L-cdrn (1- m) lst)))
)
页:
[1]