【K:DrawMkBox】矩形对角点生成标记叉并判断是否关闭视口

kucha007 · 发表于 2024-4-25 23:02:30

本帖最后由 kucha007 于 2024-4-25 23:11 编辑

论坛关于裁剪后的视口讨论比较少，分享出来做点贡献：

;根据矩形对角点生成标记叉并判断是否关闭视口
(defun K:DrawMkBox (StaPT DiaPT Col / X1 x2 Y1 y2 PtLst TgtEn ObjLst TmpMode XX)
;根据两点框选收集所有显示的视口成对象表(含裁剪视口)
(defun K:GetVP4TwoPT (StaPT DiaPT / SSVP i en ent obj ObjLst)
(setq ObjLst nil)
(setq SSVP
(ssget "C" StaPT DiaPT
(list
(cons -4 "<OR")
(cons -4 "<AND")
(cons -4 "<OR")
(cons 0 "LWPOLYLINE") ;多段线
(cons 0 "ELLIPSE") ;椭圆
(cons 0 "CIRCLE") ;圆
(cons -4 "OR>")
;(cons 102 "{ACAD_REACTORS");视口裁剪
(cons -4 "AND>")
(cons 0 "VIEWPORT")
(cons -4 "OR>")
)
)
);选择视口(含裁剪)
(if SSVP
(progn
(repeat (setq i (sslength SSVP))
(setq en (ssname SSVP (setq i (1- i)))
ent (entget en)
)
(if
(and
(setq ent (member '(102 . "{ACAD_REACTORS") ent))
(setq ent (member '(102 . "}") (reverse ent)))
)
(setq en (cdr (assoc 330 ent)))
);如果视口裁剪就更新图元名
(if
(and
(eq "VIEWPORT" (Cdr (Assoc 0 (Entget en))));是视口
(eq :vlax-true (vla-get-viewporton (setq obj (vlax-ename->vla-object en))));视口显示
(not (member obj ObjLst));选择集去重
)
(setq ObjLst (cons obj ObjLst))
)
)
)
)
ObjLst
)
(progn ;生成框叉
(setq X1 (max (car StaPT) (car DiaPT))
x2 (min (car StaPT) (car DiaPT))
Y1 (max (cadr StaPT) (cadr DiaPT))
y2 (min (cadr StaPT) (cadr DiaPT))
)
(setq PtLst
(list
(list X1 Y1);左上
(list X1 y2);左下
(list x2 Y1);右上
(list x2 y2);右下
(list X1 Y1);左上
)
)
(regapp "RvData");为扩展数据注册程序名
(setq TgtEn
(entmakex
(append
(list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 6 "Continuous");实线
(cons 62 Col);颜色
(cons 90 (length PtLst));顶点数
(cons 70 1);闭合
(cons 43 0.5);线宽0.5
)
(mapcar '(lambda (pt) (cons 10 (trans pt 1 0))) PtLst)
(list (list -3 (list "RvData" (cons 1000 "MkBox"))))
)
);绘制外围矩形
)
)
(if
(and
(eq (getvar "TILEMODE") 0)
(eq (getvar "CVPORT") 1)
(setq ObjLst (K:GetVP4TwoPT StaPT DiaPT))
(progn
(initget "Y N");非零非负值
(setq TmpMode (cond
((getkword (strcat "关闭显示下方视口避免卡顿?:[Y/N]: <N>")))
("N")
)
)
);获取转换模式
(eq TmpMode "Y")
);布局空间且有视口
(foreach XX ObjLst (vla-put-ViewportOn XX :vlax-false));关闭视口
)
TgtEn
)

;根据矩形对角点生成标记叉并判断是否关闭视口 
(defun K:DrawMkBox (StaPT DiaPT Col / X1 x2 Y1 y2 PtLst TgtEn ObjLst TmpMode XX) 
    ;根据两点框选收集所有显示的视口成对象表(含裁剪视口) 
    (defun K:GetVP4TwoPT (StaPT DiaPT / SSVP i en ent obj ObjLst) 
        (setq ObjLst nil) 
        (setq SSVP 
            (ssget "C" StaPT DiaPT 
              (list 
                (cons -4 "<OR") 
                  (cons -4 "<AND") 
                    (cons -4 "<OR") 
                      (cons 0 "LWPOLYLINE") ;多段线 
                      (cons 0 "ELLIPSE") ;椭圆 
                      (cons 0 "CIRCLE") ;圆 
                    (cons -4 "OR>") 
                    ;(cons 102 "{ACAD_REACTORS");视口裁剪 
                  (cons -4 "AND>") 
                  (cons 0 "VIEWPORT") 
                (cons -4 "OR>") 
              ) 
            ) 
        );选择视口(含裁剪) 
        (if SSVP 
          (progn 
              (repeat (setq i (sslength SSVP)) 
                (setq en (ssname SSVP (setq i (1- i))) 
                      ent (entget en) 
                ) 
                (if 
                    (and   
                      (setq ent (member '(102 . "{ACAD_REACTORS") ent)) 
                      (setq ent (member '(102 . "}") (reverse ent))) 
                    ) 
                    (setq en (cdr (assoc 330 ent))) 
                );如果视口裁剪就更新图元名 
                (if    
                    (and 
                        (eq "VIEWPORT" (Cdr (Assoc 0 (Entget en))));是视口 
                        (eq :vlax-true (vla-get-viewporton (setq obj (vlax-ename->vla-object en))));视口显示 
                        (not (member obj ObjLst));选择集去重 
                    ) 
                    (setq ObjLst (cons obj ObjLst)) 
                ) 
              ) 
          ) 
        ) 
        ObjLst 
    ) 
    (progn ;生成框叉 
        (setq X1 (max (car StaPT) (car DiaPT)) 
              x2 (min (car StaPT) (car DiaPT)) 
              Y1 (max (cadr StaPT) (cadr DiaPT)) 
              y2 (min (cadr StaPT) (cadr DiaPT)) 
        ) 
        (setq PtLst 
          (list 
            (list X1 Y1);左上 
            (list X1 y2);左下 
            (list x2 Y1);右上 
            (list x2 y2);右下 
            (list X1 Y1);左上 
          ) 
        ) 
        (regapp "RvData");为扩展数据注册程序名 
        (setq TgtEn 
          (entmakex 
            (append 
              (list '(0 . "LWPOLYLINE") 
                    '(100 . "AcDbEntity") 
                    '(100 . "AcDbPolyline") 
                    (cons 6 "Continuous");实线 
                    (cons 62 Col);颜色 
                    (cons 90 (length PtLst));顶点数 
                    (cons 70 1);闭合 
                    (cons 43 0.5);线宽0.5 
              ) 
              (mapcar '(lambda (pt) (cons 10 (trans pt 1 0))) PtLst) 
              (list (list -3 (list "RvData" (cons 1000 "MkBox")))) 
            ) 
          );绘制外围矩形 
        ) 
    ) 
    (if 
      (and 
        (eq (getvar "TILEMODE") 0) 
        (eq (getvar "CVPORT") 1) 
        (setq ObjLst (K:GetVP4TwoPT StaPT DiaPT)) 
        (progn 
            (initget "Y N");非零非负值 
            (setq TmpMode (cond 
                            ((getkword (strcat "关闭显示下方视口避免卡顿?:[Y/N]: <N>"))) 
                            ("N") 
                          ) 
            ) 
        );获取转换模式 
        (eq TmpMode "Y") 
      );布局空间且有视口 
      (foreach XX ObjLst (vla-put-ViewportOn XX :vlax-false));关闭视口 
    ) 
    TgtEn 
)

用法：

(K:DrawMkBox (getpoint) (getpoint) 1)

yefei812678 · 发表于 2024-4-26 07:57:51

谢谢分享快捷键多少啊

magicheno · 发表于 2024-4-26 11:26:14

感谢大佬分享

账号		自动登录	找回密码
密码			注册

【K:DrawMkBox】矩形对角点生成标记叉并判断是否关闭视口

本帖子中包含更多资源