难题求教！如何获取图层在对应视口中的视口颜色和线型
我想要获取指定视口内、具有视口替代特性的所有图层、
以及图层对应的视口颜色和线型、如上图：
我查了一下视口的组码、其中有几个组码是关于视口特性替代的、如下图：
但是我用entget函数却始终无法得到335 343和344这几个组码数据、代码如下：
(setq vp (car(entsel"\n拾取视口")))
(setq vp_data (entget vp))
所以想请教一下各位大神、
有没有什么办法可以用Lisp获取到视口替代图层及对应颜色和线型
附件已经上传、其中"图层1"在当前视口内是有替代特性的
本帖最后由 vitalgg 于 2024-4-21 16:46 编辑
(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))))
;; 命令 vpov
(defun c:vpov ()
(if (and (setq vp (car(entsel"拾取视口")))
(equal "VIEWPORT"(entity:getdxf vp 0)))
(progn
(setq ci (color:interface))
(foreach
layer% (layer:list)
(setq overdatas (entity:getdxf(entity:getdxf (tblobjname "layer" layer%)360)360))
(if overdatas
(progn
(if (atom overdatas)(setq overdatas(list overdatas)))
(if (apply 'or (mapcar '(lambda(x)
(equal
(entity:getdxf x 335)
(entity:getdxf vp -1)
))
overdatas))
(progn
(princ (strcat "\n"layer%":"))
(foreach
od% overdatas
(if (and od% (equal (entity:getdxf od% 335) (entity:getdxf vp -1)))
(progn
(cond
((entity:getdxf od% 420)
(vla-put-entitycolor ci (entity:getdxf od% 420))
(princ (strcat "\nCOLOR: "
(itoa (vla-get-colorindex ci))
"("
(itoa (entity:getdxf od% 420))
")"
)))
((entity:getdxf od% 343)
(princ (strcat "\nLINETYPE: "))
(princ (entity:getdxf (entity:getdxf od% 343)2)))))))))))))))
命令 VPOV
本帖最后由 xiaocainiao 于 2024-4-21 17:18 编辑
vitalgg 发表于 2024-4-21 16:44
命令 VPOV
大神、能分享一个color:interface函数的源代码吗、谢谢 本帖最后由 vitalgg 于 2024-4-21 18:49 编辑
xiaocainiao 发表于 2024-4-21 16:56
大神、能分享一个color:interface函数的源代码吗、谢谢
代码不能用？
先执行第一行代码
然后CAD命令行输入
(fun:src color:interface)
vitalgg 发表于 2024-4-21 18:44
代码不能用？
先执行第一行代码
能用、主要我是想要源码自己改一下、让他完全能符合自己的需求 xiaocainiao 发表于 2024-4-21 18:52
能用、主要我是想要源码自己改一下、让他完全能符合自己的需求
CAD命令行输入
(fun:src 函数名)
即可显示函数的定义
如：
(fun:src color:interface)
(fun:src layer:list) vitalgg 发表于 2024-4-21 18:56
CAD命令行输入
(fun:src 函数名)
即可显示函数的定义
谢谢、会用了 420组码转换时会用到的 函数
;; Negative Colour -> Colour-Lee Mac
;; c - 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)
)
) guosheyang 发表于 2024-4-22 12:41
420组码转换时会用到的 函数
;; Negative Colour -> Colour-Lee Mac
;; c -Negative colour valu ...
谢谢大神！我先研究一下 vitalgg 发表于 2024-4-21 16:44
命令 VPOV
(apply 'or (mapcar '(lambda(x)
(equal
(entity:getdxf x 335)
(entity:getdxf vp -1)
))
overdatas)
大神！这两天用您的代码发现有时候获取不到图层的视口替代特性了、
我自己排查了一下、发现是这段代码的判断不准确、其他的部分都没有问题、
所以想请教一下、有没有其他精确的判断方法、
因为是偶尔碰见这种情况、所以没有保存测试文件
页:
[1]
2