【问题标题】:How to let user select entities or KWord in AutoLISP?如何让用户在 AutoLISP 中选择实体或 KWord?
【发布时间】:2021-03-20 18:02:10
【问题描述】:

在我的命令中,我想让用户选择实体,但如果他愿意,他应该能够使用 KWord。 类似于带提示的命令:

Select elements od [Settings]:

我知道我可以在 entsel 时使用 KWord。 但是entsel 只允许我选择一个实体, ssget 让我选择许多实体 - 这是需要的,但不能使用 KWords。 还是我错了?

你知道任何方式来加入这两者:选择许多实体和 KWord?

【问题讨论】:

    标签: autocad-plugin autolisp autocad-scripts


    【解决方案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. while 循环中使用entselnentsel 选择,允许多个单选选择(即使用选框孔径进行选择,没有窗口选择)。

    2. 通过在循环中使用grread 函数来开发您自己的ssget 函数,以持续捕获用户输入。

    我在 2010 年尝试了后者,当时我开发了一个“UCS 对齐的 ssget 函数”(即选择窗口与活动的 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)
    )
    

    【讨论】:

      猜你喜欢
      • 2018-03-28
      • 2021-07-18
      • 2016-08-19
      • 1970-01-01
      • 2023-01-08
      • 2018-07-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      相关资源
      最近更新 更多