Поскольку функция AutoLISP ssget
предлагает свои собственные ключевые слова, позволяющие пользователю инициировать любой из стандартных методов выбора (окно, пересечение, забор и т. д.), она не входит в число функций, поддерживаемых функцией initget
(инициализация ключевого слова):
Expects a point or Window/Last/Crossing/BOX/ALL/Fence/WPolygon/CPolygon/Group/Add/Remove/Multiple/Previous/Undo/AUto/SIngle
На ум приходят два альтернативных метода, которые потенциально могут позволить пользователю указывать произвольные предопределенные ключевые слова, а также разрешать множественный выбор:
Используйте выделение entsel
или nentsel
в цикле while
, допуская множественное выделение одним нажатием (т. е. выделение с помощью апертуры пикбокса без выбора окна).
Разработайте собственную функцию ssget
, используя функцию grread
в цикле для непрерывного захвата пользовательского ввода.
Я попытался сделать последнее еще в 2010 году, когда разработал «функцию ssget, выровненную по UCS» (т. е. такую, чтобы окно выбора было выровнено с активной UCS) — с полным контролем над тем, как обрабатывается пользовательский ввод, вы можете затем определить свой собственный ключевые слова и реагировать соответствующим образом, когда ввод соответствует таким ключевым словам:
;;------------------=={ UCS Aligned ssget }==-----------------;;
;; ;;
;; Provides the user with a selection interface akin to ;;
;; those options provided by ssget, but aligned to the ;;
;; active UCS ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; msg - prompt to be displayed ;;
;; filter - optional SelectionSet filter ;;
;;------------------------------------------------------------;;
;; Returns: SelectionSet, else nil ;;
;;------------------------------------------------------------;;
(defun LM:UCS-ssget
(
msg filter /
*error* _redrawss _getitem _getwindowselection
acgrp e express g1 g2 gr grp i mss multiplemode pick pt removemode singlemode ss str
)
(defun *error* ( msg )
(_redrawss ss 4)
(if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
(princ (strcat "\nError: " msg))
)
(princ)
)
(defun _redrawss ( ss mode / i )
(if ss
(repeat (setq i (sslength ss))
(redraw (ssname ss (setq i (1- i))) mode)
)
)
)
(defun _getitem ( collection item )
(if
(not
(vl-catch-all-error-p
(setq item
(vl-catch-all-apply 'vla-item (list collection item))
)
)
)
item
)
)
(defun _getwindowselection ( msg p1 filter flag / gr p2 p3 p4 lst )
(princ msg)
(while (not (= 3 (car (setq gr (grread t 13 0)))))
(cond
( (= 5 (car gr))
(redraw)
(setq p3 (cadr gr)
p2 (list (car p3) (cadr p1) (caddr p3))
p4 (list (car p1) (cadr p3) (caddr p3))
)
(grvecs
(setq lst
(list
(cond
( (eq "_C" flag) -256)
( (eq "_W" flag) 256)
( (minusp (- (car p3) (car p1))) -256)
( 256 )
)
p1 p2 p1 p4 p2 p3 p3 p4
)
)
)
t
)
( (princ (strcat "\nInvalid Window Specification." msg)) )
)
)
(redraw)
(ssget (cond ( flag ) ( (if (minusp (car lst)) "_C" "_W") )) p1 p3 filter)
)
(setq express
(and (vl-position "acetutil.arx" (arx))
(not
(vl-catch-all-error-p
(vl-catch-all-apply
(function (lambda nil (acet-sys-shift-down)))
)
)
)
)
)
(setq acdoc (cond ( acdoc ) ( (vla-get-activedocument (vlax-get-acad-object)) ))
acgrp (vla-get-groups acdoc)
)
(if
(not
(and
(= 1 (getvar 'PICKFIRST))
(setq ss (cadr (ssgetfirst)))
)
)
(setq ss (ssadd))
)
(setq str "")
(sssetfirst nil nil)
(princ msg)
(while
(progn
(setq gr (grread t 13 2)
g1 (car gr)
g2 (cadr gr)
)
(_redrawss ss 3)
(cond
( (= 5 g1) )
( (= 3 g1)
(cond
( RemoveMode
(if
(and
(setq pick (ssget g2 filter))
(setq pick (ssname pick 0))
)
(if (ssmemb pick ss)
(progn (ssdel pick ss) (redraw pick 4))
)
(if (setq pick (_getwindowselection "\nSpecify Opposite Corner: " g2 filter nil))
(repeat (setq i (sslength pick))
(if (ssmemb (setq e (ssname pick (setq i (1- i)))) ss)
(progn (ssdel e ss) (redraw e 4))
)
)
)
)
(princ msg)
)
( MultipleMode
(if
(and
(setq pick (ssget g2 filter))
(setq pick (ssname pick 0))
)
(ssadd pick mss)
)
t
)
( t
(if
(and
(setq pick (ssget g2 filter))
(setq pick (ssname pick 0))
)
(if (and express (acet-sys-shift-down))
(if (ssmemb pick ss)
(progn (ssdel pick ss) (redraw pick 4))
)
(ssadd pick ss)
)
(if (setq pick (_getwindowselection "\nSpecify Opposite Corner: " g2 filter nil))
(if (and express (acet-sys-shift-down))
(repeat (setq i (sslength pick))
(if (ssmemb (setq e (ssname pick (setq i (1- i)))) ss)
(progn (ssdel e ss) (redraw e 4))
)
)
(repeat (setq i (sslength pick))
(ssadd (ssname pick (setq i (1- i))) ss)
)
)
)
)
(princ msg)
(not SingleMode)
)
)
)
( (= 2 g1)
(cond
( (member g2 '(32 13))
(cond
( (zerop (strlen str))
nil
)
( t
(if mss
(progn
(repeat (setq i (sslength mss))
(ssadd (ssname mss (setq i (1- i))) ss)
)
(setq mss nil)
)
)
(cond
( (wcmatch (setq str (strcase str)) "R,REMOVE")
(setq
MultipleMode nil
SingleMode nil
RemoveMode T
)
)
( (wcmatch str "M,MULTIPLE")
(setq
RemoveMode nil
SingleMode nil
MultipleMode T
mss (ssadd)
)
)
( (wcmatch str "A,ADD,AUTO")
(setq
MultipleMode nil
RemoveMode nil
SingleMode nil
)
t
)
( (wcmatch str "SI,SINGLE")
(setq
MultipleMode nil
RemoveMode nil
SingleMode T
)
)
( (wcmatch str "G,GROUP")
(while
(progn (setq grp (getstring t "\nEnter group name: "))
(cond
( (eq "" grp)
nil
)
( (setq grp (_getitem acgrp grp))
(vlax-for obj grp
(if (not (ssmemb (setq e (vlax-vla-object->ename obj)) ss))
(ssadd e ss)
)
)
nil
)
( (princ "\nInvalid group name.") )
)
)
)
t
)
( (or
(eq str "ALL")
(wcmatch str "P,PREVIOUS")
(wcmatch str "L,LAST")
)
(princ
(strcat "\n"
(if
(setq pick
(ssget
(cond
( (eq str "ALL") "_X")
( (wcmatch str "P,PREVIOUS") "_P")
( (wcmatch str "L,LAST") "_L")
)
filter
)
)
(progn
(repeat (setq i (sslength pick))
(ssadd (ssname pick (setq i (1- i))) ss)
)
(itoa (sslength pick))
)
"0"
)
" found"
)
)
t
)
( (or
(eq str "BOX")
(wcmatch str "W,WINDOW")
(wcmatch str "C,CROSSING")
)
(princ
(strcat "\n"
(if
(and
(setq pt (getpoint "\nSpecify first corner: "))
(setq pick
(_getwindowselection "\nSpecify opposite corner: " pt filter
(cond
( (eq str "BOX") nil)
( (wcmatch str "W,WINDOW") "_W")
( (wcmatch str "C,CROSSING") "_C")
)
)
)
)
(progn
(repeat (setq i (sslength pick))
(ssadd (ssname pick (setq i (1- i))) ss)
)
(itoa (sslength pick))
)
"0"
)
" found"
)
)
t
)
( (wcmatch str "U,UNDO")
(if pick
(cond
( (eq 'ENAME (type pick))
(ssdel pick ss)
(redraw pick 4)
)
( (eq 'PICKSET (type pick))
(repeat (setq i (sslength pick))
(setq e (ssname pick (setq i (1- i))))
(ssdel e ss)
(redraw e 4)
)
)
)
)
t
)
( (eq "?" str)
(princ
(strcat
"\nExpects a point or"
"\nWindow/Last/Crossing/BOX/ALL/Fence/WPolygon/CPolygon"
"/Group/Add/Remove/Multiple/Previous/Undo/AUto/SIngle"
)
)
)
( (princ "\n** Invalid Keyword **") )
)
(setq str "")
(princ msg)
)
)
)
( (< 32 g2 127)
(setq str (strcat str (princ (chr g2))))
)
( (= g2 8)
(if (< 0 (strlen str))
(progn
(princ (vl-list->string '(8 32 8)))
(setq str (substr str 1 (1- (strlen str))))
)
)
t
)
( t )
)
)
)
)
)
(_redrawss ss 4)
ss
)
;; Test function
(defun c:test nil
(sssetfirst nil (LM:UCS-ssget "\nSelect Objects: " nil))
(princ)
)
person
Lee Mac
schedule
09.12.2020