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

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

本帖最后由 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 "关闭显示下方视口避免卡顿?:: <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

感谢大佬分享
页: [1]
查看完整版本: 【K:DrawMkBox】矩形对角点生成标记叉并判断是否关闭视口