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

刘炎华

gaics 发表于 2020-9-18 15:41
跟我前面回复的代码没区别的。关闭cad再试试。先把你原来的lsp卸载

我把加载的lsp都卸了，试过还是不行

gaics

刘炎华 发表于 2020-9-18 15:47
我把加载的lsp都卸了，试过还是不行

子函数titleplace一次都没有调用吗？

gaics

换了一种方式，修改如下：
;;;创建线性标注
(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 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
我在另外一台电脑上运行也完全没有问题。你是在哪一行代码出错的？
再给你改一种方式，主要函数基本都没 ...

您好！
     楼上还有个问题请教下
     

gaics

刘炎华 发表于 2020-9-20 07:47
您好！
     楼上还有个问题请教下

增加了新功能？什么叫图层重叠？发个图来，晚点看看。