Как разрешить пользователю выбирать объекты или KWord в AutoLISP?

В моей команде я хочу, чтобы пользователь мог выбирать объекты, но если он хочет, он должен иметь возможность использовать KWord. Что-то вроде команды с подсказкой:

Select elements od [Settings]:

Я знаю, что могу использовать KWord, пока entsel. Но entsel позволяет мне выбрать только одну сущность, ssget позволяет выбрать много сущностей, что необходимо, но не может использовать KWords. Или я что-то недопонял?

Знаете ли вы какой-либо способ присоединиться к обоим: выбрать много объектов и KWord?


person CAD Developer    schedule 09.12.2020    source источник


Ответы (1)


Поскольку функция AutoLISP ssget предлагает свои собственные ключевые слова, позволяющие пользователю инициировать любой из стандартных методов выбора (окно, пересечение, забор и т. д.), она не входит в число функций, поддерживаемых функцией initget (инициализация ключевого слова):

Expects a point or Window/Last/Crossing/BOX/ALL/Fence/WPolygon/CPolygon/Group/Add/Remove/Multiple/Previous/Undo/AUto/SIngle

На ум приходят два альтернативных метода, которые потенциально могут позволить пользователю указывать произвольные предопределенные ключевые слова, а также разрешать множественный выбор:

  1. Используйте выделение entsel или nentsel в цикле while, допуская множественное выделение одним нажатием (т. е. выделение с помощью апертуры пикбокса без выбора окна).

  2. Разработайте собственную функцию 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