Hatch Created in Grread Loop Not Displaying

[JackStone]

I have been attempting to recreate the ssget function to, among other things, allow for custom messages to be displayed on the command prompt.

 

To closely imitate the original ssget function I'm trying to create a hatched rectangle that is changed dynamically as the user moves the mouse. To achieve that I'm using grread. But when I create the polyline and then the hatch associated to it the hatch will not be displayed until the routine is finished and I've exited the grread loop.

 

Why won't my hatch be displayed while still in the grread-while loop?

 

The whole code is a bit too long thus far and most of it would be, I believe, useless to this problem. Here, however, are the subroutine I'm using to create hatches and the structure of the loop in question:

 

(defun dynamic-rectangle  (#StartPoint
                          /
                          *DynInp*
                          *DynType*
                          *DynVal*
                          *RectangleObject*
                          *HatchObject*
                          *OldTransparencyDisplay*
                          *ConcatenatedString*)
 (setq *OldTransparencyDisplay* (getvar 'TransparencyDisplay))
 (setvar 'TransparencyDisplay 1)
 (while
   (not
     (setq *Answer*
            (progn
              (setq *DynInp*  (grread 't 15 1)
                    *DynType* (car *DynInp*)
                    *DynVal*  (cadr *DynInp*))
              (cond
                ((= 5 *DynType*)
                 (if (equal *DynVal* #StartPoint)
                   nil
                   (if (and *RectangleObject* *HatchObject*)
                     (reposition-rectangle
                       *RectangleObject*
                       *HatchObject*
                       #StartPoint
                       *DynVal*)
                     (mapcar
                       'set
                       '(*RectangleObject* *HatchObject*)
                       (if (> (car *DynVal*) (car #StartPoint))
                         (draw-window-rectangle
                           #StartPoint
                           *DynVal*)
                         (draw-crossing-rectangle
                           #StartPoint
                           *DynVal*)))))
                 nil)
                ((= 3 *DynType*)
                 (list #StartPoint *DynVal*))
                ((= 2 *DynType*)
                 (princ (chr *DynVal*))
                 (if (member *DynVal* '(32 13))
                   (if (stringp-n *ConcatenatedString*)
                     *ConcatenatedString*
                     nil)
                   (progn
                     (if (= *DynVal* 
                       (setq *ConcatenatedString*
                              (str-RemoveLast
                                *ConcatenatedString*))
                       (setq *ConcatenatedString*
                              (strcat
                                (cond
                                  (*ConcatenatedString*)
                                  (""))
                                (chr *DynVal*))))
                     nil)))
                (T nil))))))
 (setvar 'TransparencyDisplay *OldTransparencyDisplay*))

(defun make-SolidHatch  (#PolylineObject
                        /
                        *HatchObject*)
 (if (objectp #PolylineObject)
   (progn
     (if (not (objectp modelspace))
       (init))
     (setq *HatchObject*
            (vla-addHatch
              modelspace
              acHatchPatternTypePreDefined
              "SOLID"
              :vlax-true))
     (vla-appendouterloop
       *HatchObject*
       (vlax-safearray-fill
         (vlax-make-safearray vlax-vbobject '(0 . 0))
         (list #PolylineObject)))
     (vla-evaluate *HatchObject*)
     *HatchObject*)
   (progn
     (princ "\nMAKE-SOLIDHATCH error: invalid argument.")
     (exit))))

The code above will not work because (I assume) you do not have many of the subroutines required. If it is necessary I can post them here, I just didn't want to exagerate on too many code lines that would not actually be useful.

 

Thank you all for your help!

[marko_ribar]

I have been attempting to recreate the ssget function to, among other things, allow for custom messages to be displayed on the command prompt.

 

I must admit I don't quite know what do you want to accomplish with routine, maybe this post can help you :

http://www.theswamp.org/index.php?topic=42250.msg473981#msg473981

[JackStone]

Oh, sorry, I should have explained myself better.

 

I know some of the work-arounds (though I didn't know about the nomutt system variable - thanks for that!) and this is by no means a fundamental program. See it more as an useful exercise.

 

I wanted to create a subroutine that would behave like ssget. That is, when you click on the screen to create a selection it should display that blue hatched rectangle (window mode of ssget) or that green hatched rectangle (crossing mode of ssget). See it as the getcorner procedure, except that the rectangle it displays is not hatched.

 

Have I managed to put it a little better now? Please say so if I should explain something further. Thank you for your assistance!

[Lee Mac]

As marko has linked, my function:

[color=GREEN];; ssget  -  Lee Mac[/color]
[color=GREEN];; A wrapper for the ssget function to permit the use of a custom selection prompt[/color]
[color=GREEN];;[/color]
[color=GREEN];; Arguments:[/color]
[color=GREEN];; msg    - selection prompt[/color]
[color=GREEN];; params - list of ssget arguments[/color]

([color=BLUE]defun[/color] LM:ssget ( msg params [color=BLUE]/[/color] sel )
   ([color=BLUE]princ[/color] msg)
   ([color=BLUE]setvar[/color] 'nomutt 1)
   ([color=BLUE]setq[/color] sel ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]ssget[/color] params))
   ([color=BLUE]setvar[/color] 'nomutt 0)
   ([color=BLUE]if[/color] ([color=BLUE]not[/color] ([color=BLUE]vl-catch-all-error-p[/color] sel))
       sel
   )
)

Will enable you to use a custom message during an ssget selection prompt.

 

If you were still looking to recreate ssget functionality using a custom function, the attached LM:ShadedSelection function offers an alternative method for the shading of the selection window (rather than continuously updating a hatch object):

 

 

Also attached is an old function LM:ucs-ssget created in an attempt to create a UCS aligned ssget function to include all of the options offered by the standard ssget function - it is still a work-in-progress even now, I just never got around to completing it.

 

Some food for thought perhaps.

ShadedSelection.lsp

ucs-ssget.lsp

[JackStone]

Very interesting solution, Lee. I especially liked the screen size idea.

 

However the problem persists. Why won't a hatch be shown while inside the grread loop? Am I doing it wrong? Is it a bug? Is there a way around it?

 

Thanks again for all the information!