社区 › Auto Lisp › 获取/转储图形对象

Grrr 发表于 2022-7-5 17:18:01

获取/转储图形对象

大家好，
我没有任何问题，只是想分享我的一些工作。
我认为这会让你（程序员）的日常工作变得轻松/舒适（如果你还没有自己写过这样的开发版本的话）。
; Dump/Entget a graphical object (entsel behaviour), with options
; author: Grrr (thanks to Lee Mac & Tharwat that I've reached such level of coding)
(defun C:test ( / *error* SysVarLst R o m )
(setvar 'errno 0)

(defun *error* ( msg )
        (mapcar '(lambda ( n v / ) (setvar n v)) (mapcar 'car SysVarLst) (mapcar 'cadr SysVarLst))
        (if (not (member msg '("Function cancelled" "quit / exit abort")))
                (princ (strcat "\nError: " msg))
        )
        (princ)
)

(setq SysVarLst
        (mapcar '(lambda ( a b / ) (list a (getvar a) b))
                (list "CLIPROMPTLINES" "CMDECHO" "PDMODE") ; PDMODE, because sometimes is hard to (entsel) a point with PDMODE of 0 value
                (list 1 0 3) ; the new intended values
        )
)

(while (/= 52 (getvar 'errno))
        (mapcar '(lambda ( n v / ) (setvar n v)) (mapcar 'car SysVarLst) (mapcar 'caddr SysVarLst))
        (initget "Entget Dump eXit")
        (if (not m) (setq m "Entget"))
        (setq R (entsel (strcat "\nSelect entity or <\"" m "\">: ")))
        (cond
                ((member (getvar 'errno) '( 7 ))
                        (princ "\nMissed, try again! ") ; non-nil return, stay in loop
                        (setvar 'errno 0)
                )
                ((and (not (listp R))(member (strcase R) '("E" "ENTGET")))
                        (if (not (= m "Entget")) (setq m "Entget"))
                )
                ((and (not (listp R))(member (strcase R) '("D" "DUMP")))
                        (if (not (= m "Dump")) (setq m "Dump"))
                )
                ((and (not (listp R))(member (strcase R) '("X" "EXIT")))
                        (princ "\nI hope this routine helped! ")
                        (mapcar '(lambda ( n v / ) (setvar n v)) (mapcar 'car SysVarLst) (mapcar 'cadr SysVarLst))
                        (setvar 'errno 52)
                        (vl-cmdf "_.textscr")
                )
                (R
                        (cond
                                ((= (strcase m) "ENTGET")
                                        (if (= (type (car R)) 'ENAME)
                                                (progn
                                                        (princ "\n******************** ENTGET RESULTS: ********************")
                                                        (foreach x (entget (car R)) (princ "\n")(print x))
                                                        (princ "\n******************** END OF RESULTS ********************")
                                                )
                                        )
                                )
                                ((= (strcase m) "DUMP")
                                        (if (= (type (setq o (vlax-ename->vla-object (car R)))) 'VLA-OBJECT)
                                                (progn
                                                        (princ "\n******************** DUMP RESULTS: ********************")
                                                        (vlax-dump-object o T)
                                                        (princ "\n******************** END OF RESULTS ********************")
                                                )
                                        )
                                )
                        ); cond
                )
                (T ; if user pressed enter
                        (princ "\nBye, user! ")
                        (setvar 'errno 52)
                        (mapcar '(lambda ( n v / ) (setvar n v)) (mapcar 'car SysVarLst) (mapcar 'cadr SysVarLst))
                        (vl-catch-all-apply (quote textscr) (list))
                )
        ); cond
); while go

(princ)
);| defun |; (vl-load-com) (princ)

broncos15 发表于 2022-7-5 18:05:40

非常酷的Grr！我唯一可以添加的（我已经添加到我的中）是可以选择进一步深入到特定的属性值（例如TrueColor，或者基本上是Civil 3D中的所有内容）。我通过在转储后提示用户输入属性值来实现这一点，如果用户愿意，可以进一步深入了解。

Grrr 发表于 2022-7-5 18:34:08

 
谢谢，broncos15！
你的想法听起来很好，但我对“探索”实体（使用entnext/entget、vanilla-lisp）还是比较生疏。
使用对象和集合的visual lisp方法似乎要简单得多（可能是因为我自己不需要翻译和理解任何相关的DXF组码）。
然而，我的计划是首先绘制ACAD对象模型的“地图”，类似于此：http://www.afralisp.net/reference/autocad-object-model.php或者至少找一个更好/更新的（正如你所见，也没有“TrueColor”）。

查看完整版本: 获取/转储图形对象