Jump to content

Recommended Posts

Posted (edited)

Just putting this up here as something I wanted for a while and had 10 minutes to think last night.

 

 

I'd been wanting a routine "Select an entity or enter a value". Been doing it with initget which gives discrete values and not every possibility. So made up the following.

 

All good so far, haven't found out where it is broken yet.

 

Just to get your brains working then, trying to figure out how to change the mouse pointer as it hovers over an entity and not select it? Using grread and it's options you either get mouse pointer change and it selects automatically or no mouse pointer change and select with a mouse click as far as I can see. Any ideas?

 

Thanks

 

(defun c:EntOrValue ( / msg MyResult)
  (setq msg "\nSelect an Entity or enter a value: \n")
  (setq MyResult (EntorValue msg)
) ; end defun


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun EntorValue ( MSG / EndLoop sel MyEnt MyValue enta entb pt)
  (setq MyValue "")
  (setq MyEnt (list))
  (setq EndLoop "No")
  (princ MSG)
  (while (= EndLoop "No") ; start loop
    (setq sel (nth 1 (grread nil 0 2))) ; read keyboard / mouse inputs. Ignore mouse position, only if clicked
    (if (= (type sel) 'LIST)
      (progn ; if sel is a LIST,... ie. a mouse click, a point returned
        (setq MyEnt (nentselp sel)) ; select entity from point
        (if (= nil MyEnt)
          (Princ "\nMissed! Try again. Select text or enter a value: ") ; entity not selected
          (setq EndLoop "Yes") ; entity selected, end while loop
        ) ; end if
      ) ; end progn
      (progn ; if sel is not a LIST, i.e. a single keyboard entry
        (if (or (and (> sel 47)(< sel 57))(= sel 46)) ; numbers only
          (progn
            (princ (chr sel))
            (setq MyValue (strcat MyValue (chr sel) ))
          )
        )
        (if (= sel 45) ; -ve ; make negative number
          (progn
            (setq MyValue (strcat (chr sel) MyValue ))
            (princ " Making -ve\n")(princ MyValue)
          ) ; end progn
        ) ; end if

        (if (= sel 13) ; enter - end number input, end loop
          (progn
            (setq EndLoop "Yes")
          ) ; end progn
        ) ; end if
      ) ; end progn
    ) ; end if list
  ) ; end while


  (if ( = (length MyEnt) 0) ; if entity not selected
    (progn
      MyValue ; return number entered
    ) ; end progn
    (progn
      ;;GetEnt code
      (setq enta (car MyEnt))
      (setq pt (cdr (assoc 10 (entget enta))) )
      ;;fix for nenset or entsel requirements
      (setq entb (last (last (nentselp pt)))) ;; use sel?
      (if (and (/= entb nil) (/= (type entb) 'real) )
        (progn
          (if (wcmatch (cdr (assoc 0 (entget entb))) "ACAD_TABLE,*DIMENSION,*LEADER")(setq enta entb))
        )
      )
      (setq MyEnt enta)
      MyEnt ; return entity name, including nested say text from dimensions
    ) ; end progn
  ) ; end if
)

 

Edited by Steven P
  • Like 1
  • Thanks 1
Posted

Thanks Lee, I'll look at that today

 

Posted

Thanks for the link, I am happy with this code for now:

 

(defun EntorValue ( MSG / EndLoop sel MyEnt MyValue enta entb pt)
  (princ MSG) ; message
  (setq MyValue "")
  (setq MyEnt (list))
  (setq EndLoop "No")
  (while (= EndLoop "No")
    (setq grsel (grread nil 4 2)) ; Read from mouse or keyboard entry
    (setq sela (car grsel)) ; type of entry
    (if (or (= sela 2)(= sela 3) ) ; text entry or mouse click
      (setq sel (nth 1 grsel)) ; what was entered, a point, or text
    )
    (if (= (type sel) 'LIST)
      (progn
        (setq MyEnt (nentselp sel)) ; if mouse entry selected en entity
        (if (= nil MyEnt)
          (Princ "\nMissed! Try again: ")
          (setq EndLoop "Yes")
        ) ; end if
      ) ; end progn
      (progn
        (if (or (and (> sel 47)(< sel 57))(= sel 46)) ; if keyboard entry is a number
          (progn
            (princ (chr sel))
            (setq MyValue (strcat MyValue (chr sel) ))
          )
        )
        (if (= sel 45) ; -ve ; if keyboead entry is '-' add '-' to beginning of string
        ;;Future check to be done if using A-Z keyboard entry, not just numbers
        ;;Future check in case number is allready -ve
          (progn
            (setq MyValue (strcat (chr sel) MyValue ))
            (princ " Making -ve\n")(princ MyValue)
          ) ; end progn
        ) ; end if

        (if (= sel 13) ; enter ; end keyboard entry. Note mouse selection cancels keyboard entry
          (progn
            (setq EndLoop "Yes")
          ) ; end progn
        ) ; end if
      ) ; end progn
    ) ; end if list
  ) ; end while


  (if ( = (length MyEnt) 0)
    (progn
      MyValue ; return MyValue
    ) ; end progn
    (progn ; entget for nested entities ; Also see Lee Mac CTX for alternative method
      ;;GetEnt code
      (setq enta (car MyEnt))
      (setq pt (cdr (assoc 10 (entget enta))) )
      ;;fix for nenset or entsel requirements
      (setq entb (last (last (nentselp pt)))) ;; use sel?
      (if (and (/= entb nil) (/= (type entb) 'real) )
        (progn
          (if (wcmatch (cdr (assoc 0 (entget entb))) "ACAD_TABLE,*DIMENSION,*LEADER")(setq enta entb))
        )
      )
      (setq MyEnt enta)
      MyEnt ; return entity name
    ) ; end progn
  ) ; end if
)

 

  • 10 months later...
Posted (edited)

The problem with both Steven P and Lee Mac versions is it doesn't highlight entity on hover and doesn't allow select overlapping entities individually (via popup)

Edited by vanowm
  • 2 years later...
Posted

Going back to an old post here, Al. !!

 

I've been updating the above this week - didn't realise how old it was till I came back here.

 

Made a modification to add the commands: EntOrValue (command line ENTry OR select text with a numerical VALUE), EntorText (as before, but select any text), EntorEnt (as before but select any entity) and EntOrPoint (as before but return a point) - pretty much using this base but with filters, and of course, standing on the back of Lee Mac (who was also standing on the back of others for his GRRead LISP giving snaps.. most excellent).

 

So doing some reading at lunch... and warning here... Bings Co-Pilot is quoting the above 'EntOrValue' as if it is a native AutoCAD command... "To select an entity or allow text entry in AutoCAD using LISP, you can use the entorvalue function." (Obviously I am now writing 'AutoCAD Function EntOrValue' as much as I can to screw up the system).

 

 

 

(and a thanks to Lee Mac for the work he did on Grsnaps)

  • 2 months later...
Posted

Inspired by SWL210 tonight...

 

An update to this one.... it is a bit more complex then just grabbing an entity or entering a text value...

Went down the grread route which gave the results I want.

 

 

Command is

(entortext "Message" '(List 1) '(List 2) )

 

Message: Text message such as "Enter a value, or select some text"

'(List 1) - Control characters to end the selection process in ASCII codes: 13 = Enter, 32 = Space

('List 2)  - Text Control for selections:

                 "A" - Alphabetical characters only (a, A - z, Z) as text entry or any text entity selection

                 "N" - Numerical Characters only (1-9 .) as text entry, or pure numerical text entity selection

                 "P" - Punctuation characters (< > , . / ?.....) as "A" but text is only punctuation

                 "M" - Mathematical modifiers (+ - / *.....) as "A" but text is only numerical modifiers (I should change this t be the same as "N")

                 "E" - any entity is selectable. Without E is selection is text only

List 2 can be joined eg '("A" "M" "N" "P") to select any text (also '("N" "P") works and enter any text

Special option: If 'N' is used only numerical text is selectable, 'A' will allow any text entity to be selectable. Combined also works for selecting any text (but only entering A-Z, 1-9 here no punctuation)

 

For example "Select an entity or 'O' for Options") '(79 111) '("E")  Note: Distinguishes between cases....

Note here 'O' for options, for example, excludes that as part of a text string to be returned - selection is ended on 'O'

 

There are examples, entorent, entorstring, entorvalue to look at in there.

 

 

Returns:

If text is entered:       '("text", ASCII of enter method (13, 32..), nil)

If Entity is selected: '(<entity name>, point selected, insert point of selection

If Escape pressed: ("Lucky escape" 27 nil) - escape is captured and returned to the calling function - handy if selecting in a while loop

 

If that makes sense, have a play.

 

 

Oh, and an easter egg for you which might or might not work...

 

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun EntorCommand (/ *error* RunLispCommand RunNativeCommand MyCommand LispCheck Result ErrorMessage CommandStatus )
  (defun *error* (Msg)
    (if (> (getvar "CMDACTIVE") 0) (command) ) ; ;; Cancel any native command still running.
    (cond
      ((null Msg) (princ "\nCommand ended with error."))
      ((wcmatch (strcase Msg) "*BREAK*,*CANCEL*,*EXIT*" )
        (princ "\nCommand cancelled.")
      )
      (t (princ (strcat "\nCommand error: " Msg )))
    ) ; End Cond
    (princ)
  ) ; End Defun *error*
 
  (defun RunLispCommand (LispFunction /)
    (apply LispFunction nil)
  ) ; End Defun RunLispCommand
 
  (defun RunNativeCommand (CommandName /)
    (command CommandName)
    (while (> (getvar "CMDACTIVE") 0)
      (command pause)
    ) ; End While
   ) ; End Defun RunNativeCommand
 
  (setq MyCommand (strcase (getstring "\nPausing Text Selection.\n(Command Line to) Enter Command: " )))
  (setq LispCheck (vl-catch-all-apply 'eval (list (read (strcat "C:" MyCommand) ))))
  (if (and
      LispCheck
      (not (vl-catch-all-error-p LispCheck))
    ) ; end and
    (progn ; LISP
      (setq Result (vl-catch-all-apply 'RunLispCommand (list (read (strcat "C:" MyCommand)))))
      (if (vl-catch-all-error-p Result)
        (progn ; LISP Error
          (setq ErrorMessage (vl-catch-all-error-message Result))
          (if (wcmatch (strcase ErrorMessage) "*BREAK*,*CANCEL*,*EXIT*,*ABORT*" )
            (princ (strcat "\nLISP command " MyCommand " cancelled: " ErrorMessage ))
            (princ (strcat "\nLISP Command " MyCommand " ended with an error: " ErrorMessage ))
          ) ; End If
        ) ; End Progn
        (progn ; LISP Completed
          (setq CommandStatus "completed")
        ) ; End Progn
      ) ; End If
    ) ; End Progn

    (progn ; Native AutoCAD Command
      (setq Result (vl-catch-all-apply 'RunNativeCommand (list MyCommand) ))
      (if (vl-catch-all-error-p Result)
        (progn ; Native Command Error
          (setq ErrorMessage (vl-catch-all-error-message Result))
          (if (> (getvar "CMDACTIVE") 0) (command) ) ; Ends command if running
          (if (wcmatch (strcase ErrorMessage) "*BREAK*,*CANCEL*,*EXIT*,*ABORT*")
            (princ (strcat "\nCommand " MyCommand " cancelled: " ErrorMessage ))
            (princ (strcat "\nCommand " MyCommand " ended with an error: " ErrorMessage ))
          ) ; End If
        ) ; End Progn
        (progn ; Native Command Completed
          (setq CommandStatus "completed")
        ) ; End Progn
      ) ; End If
    ) ; End Progn
  ) ; End If
 
  (princ "\nEnded Command")
  (princ)
) ; End Defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;Ent Or Text options:
;;msg: Message to user
;;EndString: ASCII character code List '(13 32....) that will end the selection process. Note: add upper and lower cases
;;TextTypes: A list of letters to accept A: Alphabet, E: Entities, M: Mathematical symbols, N: Numbers, P: Punctuation symbols
(defun EntOrEnt (msg EndString / TextTypes)(EntorText msg EndString '("E"))) ; entities only ; Equivalent to EntSel + Escape!
(defun EntOrStr (msg EndString / TextTypes)(EntorText msg EndString '("N" "M" "A" "P" "E")))
(defun EntOrVal (msg EndString / TextTypes)(EntorText msg EndString '("N" "M" "E")))
(defun EntorText ( msg EndString TextTypes / MyTextType EndLoop grsel sela sel MyEnt MyValue MyCharacters MyCommand enta entb pt lw MyList MyTextString EscapeCode NestedSelection)
  (setq EscapeCode nil)
  (if (= (type EndString) 'LIST)
    (progn)
    (setq EndString (list 13 32)) ;; 13: Enter, 32: Space ('T' in getstring)
  )   ; End String
  (if (= (type msg) 'Str)
    (princ msg)
    (princ (setq msg "Select or enter text: "))
  )
  (if (= (type TextTypes) 'LIST)
    (progn)
    (setq TextTypes (list "A" "N" "P" "M")) ;; A: Alphabet, N: Numerical, P: Punctuation, M: Mathemtatical
  )   ; End String

;;Starting values
  (setq MyValue "")
  (setq MyEnt (list))
  (setq EndLoop "No")
  (setq MyCommand 0)
  (setq MyTextType nil)
  (if (or (member "N" TextTypes)(member "n" TextTypes))
    (setq MyTextType (strcat (if (= MyTextType nil) "" MyTextType) "1234567890.,"))) ; Numerical
  (if (or (member "A" TextTypes)(member "a" TextTypes))
    (setq MyTextType (strcat (if (= MyTextType nil) "" MyTextType) "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))) ; Alphabet
  (if (or (member "P" TextTypes)(member "p" TextTypes))
    (setq MyTextType (strcat (if (= MyTextType nil) "" MyTextType) "`#`~`@\\|<`,>`.`?/¬``!\"£$%^&`*()`-_="))) ; Punctuation
  (if (or (member "M" TextTypes)(member "m" TextTypes))
    (setq MyTextType (strcat (if (= MyTextType nil) "" MyTextType) "=/+-`*`.`,"))) ; Maths Functions
  (if (or (member "E" TextTypes)(member "e" TextTypes))
    (setq MyTextType (strcat (if (= MyTextType nil) "" MyTextType) ""))) ; Entity (implied in code if not listed)
  (if (= MyTextType nil)(setq MyTextType "1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ"))

;;Loop for grread function
  (while (= EndLoop "No")
    (setq grsel (vl-catch-all-apply 'grread '(nil 13 2))) ; catch errors (escape key)
    (if (vl-catch-all-error-p grsel) ;; escape pressed, end loop
      (progn
        (setq EndLoop "Yes")
        (princ (strcat "\n" (setq MyValue "Lucky escape")))
        (setq escapecode 27)
        (setq MyEnt nil)
        (if lw (redraw lw 4) )
      ) ;end progn escape pressed
      (progn
        (setq sela (car grsel))

        (if (= sela 5) ; Highlight on hover
          (progn
            (if lw (redraw lw 4) ) ;Remove any highlight
            (if
              (and
                (setq pt (cadr grsel) )
                (setq lw (ssget pt))
                (setq lw (ssname lw 0))
              ) ; end and
              (redraw lw 3)
            ) ; end if
          ) ; end progn
        ) ; end if

        (if (or (= sela 2)(= sela 3) ) ; text entry or mouse click
          (progn
            (setq sel (nth 1 grsel))
            (if (= (type sel) 'LIST)
              (progn
                (setq MyList '("TEXT" "MTEXT" "RTEXT" "ATTRIB" "ATTDEF" "DIMENSION" "INSERT")) ; list of entity types allowed to select
                (if (or (member "E" TextTypes)(member "e" TextTypes))
                  (setq MyList (append MyList (list
                    "LINE" "POLYLINE" "3DPOLYLINE" "LWPOLYLINE" "MLINE" "SPLINE" "POLYGON" "MPOLYGON" "VIEWPORT" "WIPEOUT"
                    "ELLIPSE" "CIRCLE" "ARC" "POINT"
                    "HATCH" "SURFACE" "SOLID3D" "SHAPE" "FACE" "3DFACE" "SOLID" "3DSOLID"
                    "TRACE" "RAY" "XLINE"
                    "RASTER" "XREF"
                  )))
                )
;;SP TO complete this list with:
;;ACAD_PROXY_ENTITY, BODY, HELIX, IMAGE, LEADER LIGHT, MULTILEADER, MLEADERSTYLE,
;;OLEFRAME, OLE2FRAME, REGION, SECTION, SEQEND, SHAPE, SUN, TABLE, TOLERANCE,UNDERLAY, VERTEX,
                (setq MyEnt (nentselp sel))
                (cond
                  ((or
                      (= nil MyEnt)
                      (= (member (cdr (assoc 0 (entget(car MyEnt)))) MyList) nil)
                    ) ; Endor
                    (progn
                      (Princ "\nMissed! Try again.\n")(princ msg) ;; or add in here 'ssget'
                      (setq MyEnt nil)
                    )
                  )
                  ( T ;; Text selected
                    (if (equal TextTypes '("E"))(princ ": Ahh, you selected a thing")(princ ": Fantastic selecting ability."))
                    ;;Check if numerical only selection

                    (if (or (equal TextTypes '("N")) (equal TextTypes '("n")) ) ; endor
                      (progn
                        (setq entb (last (last (nentselp (last grsel))))); grsel point value
                        (if (and (/= entb nil) (/= (type entb) 'real))
                          (if (wcmatch (cdr (assoc 0 (entget entb))) "ACAD_TABLE,*DIMENSION,*LEADER")(setq MyEnt (list entb (last grsel))))
                          (progn)
                        )
                        (setq MyTextString (cdr (assoc 1 (entget (car MyEnt)))) )
                        (setq mytextString (LM:Unformat MytextString nil)) ; Unformat string
                        (if (or
                            (wcmatch (strcat MyTextString) "*[~1234567890`.`,]*")
                            (and
                              (vl-string-search "." MyTextString)
                              (vl-string-search "." MyTextString (+ (vl-string-search "." MyTextString) 1))
                            ) ; end and
                          ) ; endor
                          (progn
                            (princ (strcat " However, selection is not numerical,\n" Msg ", or [esc]: "))
                            (setq MyEnt nil)
                          ) ; end progn
                          (progn
                            (setq EndLoop "Yes")
                          )
                        ) ; end if number check
                      ) ; end progn numerical
                      (progn
                        (setq EndLoop "Yes")
                      ) ; end progn
                    ) ; end if

                  ) ; end cond T
                ) ; end conds
                (if lw (redraw lw 4)) ; remember to (redraw xyz 3) in originating code to keep highlight
                (setq sel nil)
              ) ; end progn ; selection is list
              (progn
                (setq MyCharacters (list 137)) ; list of single characters to accept
                (if (member 32 Endstring)(progn)(setq MyCharacters (cons 32 MyCharacters))) ; add [space] if 't'
                (if (or ;;limit characters able to able to be used ;; remove escape keys later
                      (wcmatch MyTextType (strcat "*" (strcase (chr sel)) "*"));; Strcase to include caps
                      (= sel 92) ; '\' character for commands
                      (member sel MyCharacters)
                    ) ; endor
                  (progn
                    (if (= sel 92) ;; If double '\\' enter commands - check if '\' entered
                      (progn
                        (setq MyCommand (+ MyCommand 1))
                        (if (= MyCommand 2)
                          (progn
                            (princ (chr 8)) ; remove last '\' from command line
                            (setq MyValue (vl-string-right-trim (chr 92) MyValue)) ; remove '\' from result

                            (EntorCommand)

                            (setq MyCommand 0)
                            (setq sel nil)
                            (princ "\nResume Text Selection.\n")(princ MSG)(if MyValue (princ MyValue))
                          ) ; end progn command = 2
                          (progn
                            (if (member sel EndString) ;; remove escape keys from MyValue
                              (progn)
                              (progn
                                (princ (chr sel))
                                (setq MyValue (strcat MyValue (chr sel) ))
                              ) ; end progn
                            ) ; end if
                          ) ; end progn
                        ) ; end if
                      ) ; end progn
                      (progn
                        (setq MyCommand 0)
                        (if (member sel EndString) ;; remove escape keys from MyValue
                          (progn)
                          (progn
                            (princ (chr sel))
                            (setq MyValue (strcat MyValue (chr sel) ))
                          ) ; end progn
                        ) ; end if
                      ) ; end progn
                    ) ; end if
                  )
                )
                (if (member sel EndString) ; enter
                  (progn
                    (setq EndLoop "Yes")
                    (setq EscapeCode sel)
                  ) ; end progn
                  (progn
                  )
                ) ; end if
                (if (= sel 8) ; backspace
                  (progn
                    (if (> (strlen MyValue) 0)
                      (progn
                        (setq MyValue (substr MyValue 1 (- (strlen MyValue) 1)))
                        (princ (chr sel))
                      ) ; end progn
                    ) ; end if
                  ) ; end progn
                  (progn
                  )
                ) ; end if
              ) ; end progn
            ) ; end if list
          ) ; end progn
        ) ; end if text / mouse entry
      ) ; end progn
    ) ; end if catch-all-error
  ) ; end while

  (if (or ( = (length MyEnt) 0)(= MyEnt nil)) ;; if no entity selected.. text entry
    (progn ;; If text is entered
    ) ; end progn
    (progn
      (setq enta (car MyEnt))
      (setq pt (cdr (assoc 10 (entget enta))) )
      (setq entb (last (last (nentselp pt)))) ;; use sel? ;; nested entities
      (if (and
          (/= entb nil)
          (/= (type entb) 'real)
          (wcmatch (cdr (assoc 0 (entget entb))) "ACAD_TABLE,*DIMENSION,*LEADER")
        ) ; end and
        (setq MyValue entb) ; If entity is DIM, Table, Leader
        (setq MyValue enta) ; ELse entity
      ) ; end if
    ) ; end progn
  ) ; end if

;;Result - '(MyValue Pt)
;;'Ended ##' : An escape character code if entered
;;'Lucky Escape' : Escape key pressed
;;<Entity name: ##> : The selected entity
;;Other character : Entered Characters
;;(cadr grsel) - mouse point
;;pt - entity insert point (assoc 10)

  (if EscapeCode
    (setq MyValue (list MyValue EscapeCode nil))
    (setq MyValue (list MyValue (cadr grsel) pt))
  )
  MyValue
)

 

Al Still thinks this is a native command "EntOrText" by the way...

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...