gaics 发表于 2020-9-18 15:41
跟我前面回复的代码没区别的。关闭cad再试试。先把你原来的lsp卸载
我把加载的lsp都卸了，试过还是不行
刘炎华 发表于 2020-9-18 15:47
我把加载的lsp都卸了，试过还是不行
子函数titleplace一次都没有调用吗？
换了一种方式，修改如下：
;;;创建线性标注
(defun c:dli ()
(saverror)
(setvar "cmdecho" 1)
(command ".dimlinear" pause)
(titleplace "GB_A*" (getvar "lastpoint"))
(while (wcmatch (getvar "cmdnames") (strcase "*dimlinear*"))
(command pause)
;;;(titleplace "GB_A*" (getvar "lastpoint"))
)
(restore)
(princ)
)
gaics 发表于 2020-9-18 16:05
换了一种方式，修改如下：
;;;创建线性标注
(defun c:dli ()
titleplace可用，还是不能换层呢
本帖最后由 gaics 于 2020-9-18 19:21 编辑
刘炎华 发表于 2020-9-18 17:18
titleplace可用，还是不能换层呢
我在另外一台电脑上运行也完全没有问题。你是在哪一行代码出错的？
再给你改一种方式，主要函数基本都没有改动，我真不知道你哪里出了问题。
把你测试文件发来看看，还有调试的错误提示。
;;;创建线性标注
(defun c:dli (/ pt)
(saverror)
(setvar "cmdecho" 1)
(setq pt(getpoint"请指定标注第一点："))
(titleplace "GB_A*" pt)
(command ".dimlinear" pt pause pause)
(restore)
(princ)
)
gaics 发表于 2020-9-18 19:16
我在另外一台电脑上运行也完全没有问题。你是在哪一行代码出错的？
再给你改一种方式，主要函数基本都没 ...
大致有原因了
单个图层的图框它是可以变过去的
工作中，我们用的图框是多个图层了，有些图还是叠起来的。
如我上传的附件内图框图层不同，它是不能分别出来。感谢您的耐心帮助！
gaics 发表于 2020-9-18 06:30
找到原因就好办了，在昨天代码的基础上改一下titleplace子函数就ok！
非常感谢您！太给力了！
您好！ 用了之后，有下面个问题
当多个图层叠起来的时候（如PH,PS,DIE....）我只开其中某一个层的时候它不能区分
以下为我把您之前的代码套进来的修改
您帮我看下哪里不对呢？
(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-18 19:16
我在另外一台电脑上运行也完全没有问题。你是在哪一行代码出错的？
再给你改一种方式，主要函数基本都没 ...
您好！
楼上还有个问题请教下
刘炎华 发表于 2020-9-20 07:47
您好！
楼上还有个问题请教下
增加了新功能？什么叫图层重叠？发个图来，晚点看看。