需要LISP程序来选择al
嘿，伙计们，我相信有人能很快回答这个问题，所以我没有花太多时间寻找答案，我找不到。基本上，当我从别人那里“清理”一幅画时，我必须删除很多东西。所以我使用QSELECT抓取层中的所有内容，然后删除它。
这个过程需要很长时间，我必须为我不需要的每一层反复做。如果有很多层，那么在qselect中查找它们可能会很单调。
所以基本上，我想要一个LISP程序，我只需要键入命令，例如，SALL，或其他什么，然后程序运行。它让我点击任何一个对象，然后立即选择与我点击的对象位于同一层的每个对象，当然包括我点击的对象。
我有一个类似的程序，用于删除层中的每个项目，但我不希望它自动删除所有内容。我需要在删除之前查看所选内容。所以我只想点击一个对象，让该层的每个对象都被选中。
知道什么节目吗？
谢谢 这是一个“Q&D”Lisp程序。
(defun c:SALL ()
(setq TargEnt (car (entsel "\nSelect object on layer to select: ")))
(setq TargLayer (assoc 8 (entget TargEnt)))
(sssetfirst nil (ssget "_X" (list TargLayer)))
(princ)
) 嘿，太棒了！
我忘了提我有acad 2002。但效果一样。
由于它很小，您介意解释一下该代码在为我的lisping研究做什么吗？
否则，再次感谢，这将很好。 好的，但我主要是从参考手册中抄下来的，因为没有太多的逻辑。
(defun c:SALL ()
;;define a function named "sall"
(setq TargEnt (car (entsel "\nSelect object on layer to select: ")))
;;prompt user to select object, entsel stores pick pint & entity name
;; 'car' extracts name, set it to variable 'Targent'
(setq TargLayer (assoc 8 (entget TargEnt)))
;;extract layer name of entity using 'entget' to retrieve entity data
;;'assoc' to extract portion of data pair, '8' is the layer name group code
(sssetfirst nil (ssget "_X" (list TargLayer)))
;;ssget used to select all items (the 'x' option) having same layer name
;;sssetfirst used to grip & highlight items
(princ)
)
谢谢你的提示。
我将该代码与另一个称为TLEN的lisp相结合，该lisp给出了连接线的长度。
现在，当我需要测量这个东西时，我所做的就是键入命令，然后单击一个对象。它会自动选择层中的所有内容，然后对其进行测量。
很好，这个过程过去需要很长时间，连接线，使用测量工具QSELECT，进行广义猜测。现在需要几秒钟，而且非常准确！ (defun c:LL2(/)
(princ"click object belong to a layer to copy or move all objects layer")
(setq myobjectsbylayer (ssget "X" (list (cons 8 (cdr (assoc 8 (entget (car (entsel)))))))))
(initget "Copy Move")
(setq x(getkword"\n hit inter for copy with base point or type <M> for move >"))
(if(not x)
(progn
(setq mypoint (getpoint "Specify base point or press Enter for 0,0: "))
(if (not mypoint) (setq mypoint (list 0 0)))
(command "copybase" mypoint myobjectsbylayer "")
)
)
(if(= x "Move")
(progn
(setq mypoint (getpoint "Specify base point "))
(command"move"myobjectsbylayer"" mypoint)
)
)
) 如果要一次选择多个图层。
;;=============================================================
;; Sel.lsp by Charles Alan Butler
;; Copyright 2004
;; by Precision Drafting & Design All Rights Reserved.
;;
;; Version 1.0 BetaJuly 23,2004
;; Version 1.1 BetaJuly 13,2005
;;
;; Creates a selection set of objects on a layer(s)
;; User picks objects to determine the layer(s)
;; Then User selects objects for ss or presses enter to
;; get all objects on the selected layer(s)
;; You may select the selection set before starting this
;; routine. Then select the layers to keep in the set
;;=============================================================
(defun c:sel (/ ent lay ss lay:lst lay:prompt ss:first ent:lst)
;;get anything already selected
(setq ss:first (cadr(ssgetfirst))
ss (ssadd))
;;Get user selected layers
(if ss:first
(setq lay:prompt "\nSelect the object to choose layers to keep.")
(setq lay:prompt "\nSelect object for layer filter.")
)
(while (setq ent (entsel lay:prompt))
(setq ent:lst (cons (car ent) ent:lst))
(setq lay:lst
(cons (setq lay (cdr(assoc 8 (entget (car ent))))) lay:lst))
(prompt (strcat "\n*-* Selected Layer -> " lay))
)
;;Un HighLite the entities
(and ent:lst (mapcar '(lambda (x) (redraw x 4)) ent:lst))
(if (> (length lay:lst) 0); got layers to work with
(progn
(setq lay "")
(setq lay:lst (vl-sort lay:lst '<)) ; removes douplicates
(foreach itmlay:lst ; combine lay names into one , del string
(setq lay (strcat lay itm ",")))
(setq lay (substr lay 1 (1- (strlen lay)))); remove the last ,
(if ss:first ; ALREADY GOT SELECTION SET
(while (setq ent (ssname ss:first 0))
(if (member (cdr(assoc 8 (entget ent))) lay:lst)
(ssadd (ssname ss:first 0) ss)
)
(ssdel (ssname ss:first 0) ss:first)
)
(progn ; else get a selection set to work with
(prompt (strcat "\nOK >>--> Select objects for Selection set or "
"ENTER for All objects on layer(s) " lay))
;;get objects using filter with user select
(if (null (setq ss (ssget (list (cons 8 lay)))))
;; or get ALL objects using filter
(setq ss (ssget "_X" (list (cons 8 lay)(cons 410 (getvar "ctab")))))
)
)
)
(if (> (sslength ss) 0)
(progn
(prompt (strcat "\n" (itoa (sslength ss))
" Object(s) selected on layer(s) " lay
"\nStart an ACAD command."))
(sssetfirst nil ss)
)
(prompt "\n***Nothing Selected***")
)
)
)
(princ)
)
(prompt "\nSelect on Layer loaded, Enter Sel to run.")
(princ) 是否可以修改为也有一个（princ“\n items selected”）？
(setq ss(ssget "_X" (list TargLayer)))
(alert (strcat "Items selected " (sslength SS)))
(sssetfirst nil ss)
我想我一定是把它粘贴到错误的地方了，我得到了“错误：错误的参数类型：stringp 78”
我尝试的是：
(defun c:SALL ()
(setq TargEnt (car (entsel "\nSelect object on layer to select: ")))
(setq TargLayer (assoc 8 (entget TargEnt)))
(setq ss(ssget "_X" (list TargLayer)))
(alert (strcat "Items selected " (sslength SS)))
(sssetfirst nil ss)
(princ)
)
页:
[1]
2