根据矩形对角线生成矩形

LXH

如何根据对角线生成矩形，并把对角线删除 ，可以支持多选  小白请教   请求大佬帮助

煮茗

理论上一个对角线能绘制出无数个矩形，看你的示例图，是依据坐标系xy方向绘制，那就唯一了。
之前唐突，没看到批量绘制。
想说如果量不多，直接用矩形命令绘制更快。

LXH

是的  不多的画手动也可以   主要挺多的 而且手动容易漏

橡皮

你这个直接获取包围盒然后绘制就是了

LXH

橡皮 发表于 2024-6-21 11:31
你这个直接获取包围盒然后绘制就是了

大佬  小白没听懂

czb203

手动话也很快

fangmin723

1. (defun c:tt()
   
2.   (if (setq ss (ssget '((0 . "line"))))
   
3.     (progn
   
4.       (setq n -1)
   
5.       (while (setq ent (ssname ss (setq n (1+ n))))
   
6.         (vla-GetBoundingBox (vlax-ename->vla-object ent) 'minpt 'maxpt)
   
7.         (entdel ent)
   
8.         (setq lst (mapcar '(lambda(x) (vlax-safearray->list x)) (list minpt maxpt)))
   
9.         (setq minpt (car lst) maxpt (cadr lst))
   
10.         (setq lst (list minpt (list (car maxpt) (cadr minpt)) maxpt (list (car minpt) (cadr maxpt))))
    
11.         (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lst)) '(70 . 1)) (mapcar '(lambda (pt) (cons 10 pt)) lst)))
    
12.       )
    
13.     )
    
14.   )
    
15.   (prin1)
    
16. )

(defun c:tt()<br />   (if (setq ss (ssget '((0 . "line"))))<br />     (progn<br />       (setq n -1)<br />       (while (setq ent (ssname ss (setq n (1+ n))))<br />         (vla-GetBoundingBox (vlax-ename->vla-object ent) 'minpt 'maxpt)<br />         (entdel ent)<br />         (setq lst (mapcar '(lambda(x) (vlax-safearray->list x)) (list minpt maxpt)))<br />         (setq minpt (car lst) maxpt (cadr lst))<br />         (setq lst (list minpt (list (car maxpt) (cadr minpt)) maxpt (list (car minpt) (cadr maxpt))))<br />         (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lst)) '(70 . 1)) (mapcar '(lambda (pt) (cons 10 pt)) lst)))<br />       )<br />     )<br />   )<br />   (prin1)<br /> )

YuHB

2. (defun c:tt( / ss e ent kk pt1 pt2 pt3 pt4)
   
3.   (command "undo" "be")
   
4.   (setq ss (ssget '((0 . "LINE"))))
   
5.   (repeat (setq kk (sslength ss))
   
6.     (setq e (ssname ss (setq kk (1- kk)))
   
7.           ent (entget e)
   
8.           pt1 (cdr (assoc 10 ent))
   
9.           pt3 (cdr (assoc 11 ent))
   
10.           pt2 (list (car pt1) (cadr pt3))
    
11.           pt4 (list (car pt3) (cadr pt1))        
    
12.     )
    
13.     (MakePL (list pt1 pt2 pt3 pt4))
    
14.     (entdel e)   
    
15.   )
    
16.   (command "undo" "e")
    
17.   (prin1)
    
18. )
    
19. 
    
20. (defun MakePL(ptlst)
    
21.   (entmake (append (list
    
22.     '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")
    
23.     (cons 90 (length ptlst)) (cons 70 1))  
    
24.     (mapcar '(lambda (x) (cons 10 x)) ptlst)
    
25.     )
    
26.   )
    
27. )

(defun c:tt( / ss e ent kk pt1 pt2 pt3 pt4) <br />   (command "undo" "be")<br />   (setq ss (ssget '((0 . "LINE")))) <br />   (repeat (setq kk (sslength ss)) <br />     (setq e (ssname ss (setq kk (1- kk))) <br />           ent (entget e) <br />           pt1 (cdr (assoc 10 ent)) <br />           pt3 (cdr (assoc 11 ent))<br />           pt2 (list (car pt1) (cadr pt3))<br />           pt4 (list (car pt3) (cadr pt1))        <br />     )<br />     (MakePL (list pt1 pt2 pt3 pt4))<br />     (entdel e)    <br />   )<br />   (command "undo" "e")<br />   (prin1)<br /> )<br /> <br /> (defun MakePL(ptlst)<br />   (entmake (append (list <br />     '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")<br />     (cons 90 (length ptlst)) (cons 70 1))  <br />     (mapcar '(lambda (x) (cons 10 x)) ptlst)<br />     )<br />   )<br /> )

来个新手版的

LXH

fangmin723 发表于 2024-6-21 16:37

新手想问下  是代码复制到文本文档 然后改后缀为LSP吗

LXH

fangmin723 发表于 2024-6-21 16:37

感谢大佬  能用了 提高很多效率