标注与图框图层相同，请求修改

刘炎华

gaics 发表于 2020-9-20 07:53
增加了新功能？什么叫图层重叠？发个图来，晚点看看。

谢谢！下午发给您吧，一会要带小孩看牙齿

刘炎华

gaics 发表于 2020-9-20 07:53
增加了新功能？什么叫图层重叠？发个图来，晚点看看。

您好！
      我传上测试的图档，里面有说明了想要的效果，谢谢！
      麻烦帮我看下是哪里不行，加的选择范围是为了在大图档速度快些，现在搞不定的是过滤掉关闭的图层。

(setq *en2obj* vlax-ename->vla-object)

;;;图框位置
(defun titleplace (titlename p0 / entdata entgrp entname i n pb pc ptlist titlescale txdata clay)

;;获取已关闭、锁定或冻结图层名
  (vl-load-com)
  (vlax-for x (vla-get-layers
                (vla-get-activedocument (vlax-get-acad-object))
              )
    (if        (or (= (vla-get-lock x) :vlax-true)
            (= (vla-get-layeron x) :vlax-false)
            (= (vla-get-freeze x) :vlax-true)
        )
      (progn (setq ly (vla-get-name x))
             (if lys
               (setq lys (strcat ly "," lys))
               (setq lys ly)
             )
      )
    )
  )
;;获取已关闭、锁定或冻结图层名


        (setq vs 3000);;;此处定义图框识别的范围
        (setq pc (getvar "viewctr"))
        (setq pcx (car pc)
              pcy (cadr pc)
              pt1 (list (- pcx vs) (- pcy vs));;;此处为计算式
              pt2 (list (+ pcx vs) (+ pcy vs));;;此处为计算式
        )
  (if (setq entgrp (ssget "x" (list '(0 . "insert")
      '(-4 . "<and")
         '(-4 . ">,>,*") (cons 10 pt1)
         '(-4 . "<,<,*") (cons 10 pt2)
                              (cons 2 titlename)
                              (cons -4 "<not")
                              (cons 8 lys)
                              (cons -4 "not>")               
      '(-4 . "and>"))))
    (repeat (setq n (sslength entgrp))
      (setq entname (ssname entgrp (setq n (1- n))))
      (setq titlescale (vla-get-XScaleFactor (*en2obj* entname)))
      (setq clay (vla-get-layer (*en2obj* entname)));;;获取图框图层
      (setq
        ptlist (append (ax:getboundingbox entname) (list titlescale) (list clay));;;图层名加入ptlist
      )
      (setq txdata (append (list ptlist) txdata))
    )
  )
  (setq i 0)
  (if (and p0 txdata)
    (while (< i (length txdata))
      (setq pb (nth 0 (nth i txdata)))
      (setq pc (nth 1 (nth i txdata)))
      (if (and
            (> (nth 0 p0) (nth 0 pb))
            (< (nth 0 p0) (nth 0 pc))
            (> (nth 1 p0) (nth 1 pb))
            (< (nth 1 p0) (nth 1 pc))
          )
        (progn
          (setvar "dimscale" (nth 2 (nth i txdata)))
          (setvar "clayer" (nth 3 (nth i txdata)));;;设置当前图层
          (setq i (length txdata))
        )
        (setvar "dimscale" 1.0)
      )
      (setq i (+ i 1))
    )
  )
)

gaics

刘炎华 发表于 2020-9-20 15:20
您好！
      我传上测试的图档，里面有说明了想要的效果，谢谢！
      麻烦帮我看下是哪里不行，加的 ...

(defun titleplace (titlename p0 / entdata entgrp entname i n pb pc ptlist titlescale txdata clay ly lys)

刘炎华

gaics 发表于 2020-9-21 08:26
(defun titleplace (titlename p0 / entdata entgrp entname i n pb pc ptlist titlescale txdata clay l ...

加了，不行呢？是我加的那部分哪里不对？麻烦您试下看