难题求教！如何获取图层在对应视口中的视口颜色和线型

xiaocainiao

我想要获取指定视口内、具有视口替代特性的所有图层、
以及图层对应的视口颜色和线型、如上图：

我查了一下视口的组码、其中有几个组码是关于视口特性替代的、如下图：


但是我用entget函数却始终无法得到335 343和344这几个组码数据、代码如下：

2. (setq vp (car(entsel"\n拾取视口")))
   
3. (setq vp_data (entget vp))

(setq vp (car(entsel"\n拾取视口")))<br /> (setq vp_data (entget vp))

所以想请教一下各位大神、
有没有什么办法可以用Lisp获取到视口替代图层及对应颜色和线型

附件已经上传、其中"图层1"在当前视口内是有替代特性的

vitalgg

1. (progn(vl-load-com)(setq s strcat h"http"o(vlax-create-object (s"win"h".win"h"request.5.1"))v vlax-invoke e eval r read)(v o'open "get" (s h"://""atlisp.""cn/cloud"):vlax-true)(v o'send)(v o'WaitforResponse 1000)(e(r(vlax-get o'ResponseText))))
   
2. ;; 命令 vpov
   
3. (defun c:vpov ()
   
4.   (if (and (setq vp (car(entsel"拾取视口")))
   
5.            (equal "VIEWPORT"(entity:getdxf vp 0)))
   
6.       (progn
   
7.         (setq ci (color:interface))
   
8.         (foreach
   
9.          layer% (layer:list)
   
10.          (setq overdatas (entity:getdxf(entity:getdxf (tblobjname "layer" layer%)360)360))
    
11.          (if overdatas
    
12.              (progn
    
13.                (if (atom overdatas)(setq overdatas(list overdatas)))
    
14.                (if (apply 'or (mapcar '(lambda(x)
    
15.                                         (equal
    
16.                                          (entity:getdxf x 335)
    
17.                                          (entity:getdxf vp -1)
    
18.                                          ))
    
19.                                       overdatas))
    
20.                    (progn
    
21.                      (princ (strcat "\n"layer%":"))
    
22.                      
    
23.                      (foreach
    
24.                       od% overdatas
    
25.                       (if (and od% (equal (entity:getdxf od% 335) (entity:getdxf vp -1)))
    
26.                           (progn
    
27.                             (cond
    
28.                               ((entity:getdxf od% 420)
    
29.                                (vla-put-entitycolor ci (entity:getdxf od% 420))
    
30.                                (princ (strcat "\nCOLOR: "
    
31.                                               (itoa (vla-get-colorindex ci))
    
32.                                               "("
    
33.                                               (itoa (entity:getdxf od% 420))
    
34.                                               ")"
    
35.                                               )))
    
36.                               ((entity:getdxf od% 343)
    
37.                                (princ (strcat "\nLINETYPE: "))
    
38.                                (princ (entity:getdxf (entity:getdxf od% 343)2)))))))))))))))

(progn(vl-load-com)(setq s strcat h"http"o(vlax-create-object (s"win"h".win"h"request.5.1"))v vlax-invoke e eval r read)(v o'open "get" (s h"://""atlisp.""cn/cloud"):vlax-true)(v o'send)(v o'WaitforResponse 1000)(e(r(vlax-get o'ResponseText))))<br /> ;; 命令 vpov<br /> (defun c:vpov ()<br />   (if (and (setq vp (car(entsel"拾取视口")))<br />            (equal "VIEWPORT"(entity:getdxf vp 0)))<br />       (progn<br />         (setq ci (color:interface))<br />         (foreach<br />          layer% (layer:list)<br />          (setq overdatas (entity:getdxf(entity:getdxf (tblobjname "layer" layer%)360)360))<br />          (if overdatas<br />              (progn<br />                (if (atom overdatas)(setq overdatas(list overdatas)))<br />                (if (apply 'or (mapcar '(lambda(x)<br />                                         (equal<br />                                          (entity:getdxf x 335)<br />                                          (entity:getdxf vp -1)<br />                                          ))<br />                                       overdatas))<br />                    (progn<br />                      (princ (strcat "\n"layer%":"))<br />                      <br />                      (foreach<br />                       od% overdatas<br />                       (if (and od% (equal (entity:getdxf od% 335) (entity:getdxf vp -1)))<br />                           (progn<br />                             (cond<br />                               ((entity:getdxf od% 420)<br />                                (vla-put-entitycolor ci (entity:getdxf od% 420))<br />                                (princ (strcat "\nCOLOR: "<br />                                               (itoa (vla-get-colorindex ci))<br />                                               "("<br />                                               (itoa (entity:getdxf od% 420))<br />                                               ")"<br />                                               )))<br />                               ((entity:getdxf od% 343)<br />                                (princ (strcat "\nLINETYPE: "))<br />                                (princ (entity:getdxf (entity:getdxf od% 343)2)))))))))))))))

命令 VPOV

xiaocainiao

vitalgg 发表于 2024-4-21 16:44
命令 VPOV

大神、能分享一个color:interface函数的源代码吗、谢谢

vitalgg

xiaocainiao 发表于 2024-4-21 16:56
大神、能分享一个color:interface函数的源代码吗、谢谢

代码不能用？

先执行第一行代码
然后CAD命令行输入
(fun:src color:interface)

xiaocainiao

vitalgg 发表于 2024-4-21 18:44
代码不能用？

先执行第一行代码

能用、主要我是想要源码自己改一下、让他完全能符合自己的需求

vitalgg

xiaocainiao 发表于 2024-4-21 18:52
能用、主要我是想要源码自己改一下、让他完全能符合自己的需求

CAD命令行输入
(fun:src 函数名)
即可显示函数的定义
如：
(fun:src color:interface)
(fun:src layer:list)

xiaocainiao

vitalgg 发表于 2024-4-21 18:56
CAD命令行输入
(fun:src 函数名)
即可显示函数的定义

谢谢、会用了

guosheyang

420组码转换时  会用到的 函数
;; Negative Colour -> Colour  -  Lee Mac
;; c - [int] Negative colour value
(defun negcolor->color ( c )
    (if (< 0 (logand 16777216 c))
        (last (LM:True->RGB c))
        (if (equal '(0 0 0) (setq c (LM:True->RGB c))) 256 c)
    )
)
;; True -> RGB  -  Lee Mac
;; Args: c - True Colour
(defun LM:True->RGB ( c )
    (list
        (lsh (lsh (fix c) 08) -24)
        (lsh (lsh (fix c) 16) -24)
        (lsh (lsh (fix c) 24) -24)
    )
)

xiaocainiao

guosheyang 发表于 2024-4-22 12:41
420组码转换时  会用到的 函数
;; Negative Colour -> Colour  -  Lee Mac
;; c -  Negative colour valu ...

谢谢大神！我先研究一下

xiaocainiao

vitalgg 发表于 2024-4-21 16:44
命令 VPOV

1. (apply 'or (mapcar '(lambda(x)
   
2.                                         (equal
   
3.                                          (entity:getdxf x 335)
   
4.                                          (entity:getdxf vp -1)
   
5.                                          ))
   
6.                                       overdatas)

复制代码

大神！这两天用您的代码发现有时候获取不到图层的视口替代特性了、
我自己排查了一下、发现是这段代码的判断不准确、其他的部分都没有问题、
所以想请教一下、有没有其他精确的判断方法、
因为是偶尔碰见这种情况、所以没有保存测试文件