选择多个对象。。。输出：选定对象所在的所有层，以及在哪个层上有多少选定对象。。。
vb层：绿色-2
图层：蓝色-1
图层：红色
这是一个更好的例子吗？
格里茨·约翰 通过一点复制和粘贴以及一些尝试和错误，我已经走到了这一步。
但是在最后得到一个错误来放置字符串
我在那里留下了原始代码来帮助我
我不太擅长Lisp程序，只是学习而已
(defun c:Test (/ spc p1 p2 str lead)
(vl-load-com)
;; Tharwat 08. 07. 2011
(cond ((not acdoc)
(setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
)
)
(setq spc (if (> (vla-get-activespace acdoc) 0)
(vla-get-modelspace acdoc)
(vla-get-paperspace acdoc)
)
)
(while
(and
(setq p1 (getpoint "\n specify First Point :"))
(setq p2 (getpoint p1 "\n Specify Second point :"))
(setq
str (car
(entsel "\n Specify any entity to get its Layer name :")
)
)
)
(progn
(setq lead (vla-addmleader
spc
(vlax-make-variant
(vlax-safearray-fill
(safearray vlax-vbdouble '(0 . 5))
(apply 'append (list p1 p2))
)
)
0
)
)
(vla-put-textstring
lead
(strcat
"Layer name = "
(cdr (assoc 8 (entget str)))
"\\P"
"Number of Object(s) :"
(itoa
(sslength
(ssget "_x" (list (cons 8 (cdr (assoc 8 (entget str))))))
)
)
)
)
)
)
(princ)
)
With a little copy and paste and some trial and error i have come this far.
but getting a error at the end to put the string
i left the original code in there tot help me
i'm not that great with lisp, just learning
(defun c:lala (/ spc p1 p2 str lead) (vl-load-com) ;; Tharwat 08. 07. 2011 (cond ((not acdoc) (setq acdoc (vla-get-activedocument (vlax-get-acad-object))) ) ) (setq spc (if (> (vla-get-activespace acdoc) 0) (vla-get-modelspace acdoc) (vla-get-paperspace acdoc) ) ) (while (and (setq p1 (getpoint "\n specify First Point :")) (setq p2 (getpoint p1 "\n Specify Second point :")); (setq str lst);;;;;; (car (entsel "\n Specify any entity to get its Layer name :"));;;(setq ss (ssget)) (progn (repeat (setq i (sslength ss)) (setq layer (cdr (assoc 8 (entget (ssname ss (setq i (1- i))))))) (if (not (member layer lst)) (setq lst (cons layer lst))) ) (setq lst (acad_strlsort lst)) )(setq str lst);;; ) (progn (setq lead (vla-addmleader spc (vlax-make-variant (vlax-safearray-fill (safearray vlax-vbdouble '(0 . 5)) (apply 'append (list p1 p2)) ) ) 0 ) ) (vla-put-textstring lead (cdr (assoc 8 (entget str)))) ) ) (princ))
页:
1
[2]