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))
)
)
)
刘炎华 发表于 2020-9-20 15:20
您好！
我传上测试的图档，里面有说明了想要的效果，谢谢！
麻烦帮我看下是哪里不行，加的 ...
(defun titleplace (titlename p0 / entdata entgrp entname i n pb pc ptlist titlescale txdata clay ly lys)
本帖最后由 刘炎华 于 2020-9-21 09:39 编辑
gaics 发表于 2020-9-21 08:26
(defun titleplace (titlename p0 / entdata entgrp entname i n pb pc ptlist titlescale txdata clay l ...
加了，不行呢？是我加的那部分哪里不对？麻烦您试下看