Hatch within Ver 10.1.9

Raam Finzi

I need to fill multiple objects with a hatch pattern. I have a lisp routine that works fine on ver 7.  What it does is, selecting a group of entities  by window or crossing, and applying the desired hatch on that group. However, on Ver 10, it seems that the group is forgotten, the moment that the line containing the command "-hatch"  is executed. The same Selection works just fine with other commands.

John Gaunt

I haven't used the command line way of hatching for such a long time I hadn't realised it is now the only way to pick an internal point to hatch an area.

Glad you raised it, albeit for a different reason.

If I preselect objects then start the -h command and respond "S"elect, I find it remembers the slection.

Raam Finzi

Yes, You can do it this way, Manually. Not inside a lisp routine.

John Gaunt

Since it works as a command, there must be something else about your lisp which stops it.

My lisp skills are ordinary, but there some experts here if you want to post it you might be lucky.

Without seeing it, not much can be suggested.

Raam Finzi

PASTE CODE HERE
;* UKWORD User key word. DEF, if any, must match one of the KWD strings
;* BIT (1 for no null, 0 for none) and KWD key word ("" for none) are same as
;* for INITGET. MSG is the prompt string, to which a default string is added as
;* <DEF> (nil or "" for none), and a : is added.
;*
(defun ukword (bit kwd msg def / inp)
  (if (and def (/= def ""))                     ;test for both nil and null string
    (setq msg (strcat "\n" msg "<" def ">: ")   ;string'em  with default
          bit (* 2 (fix (/ bit 2))) ;a default and no null bit code conflict so
    );setq                          ;this reduces bit by 1 if odd, to allow null
    (if (= " " (substr msg (strlen msg) 1))     ;no def, if last char is space
      (setq msg (strcat "\n" (substr msg 1 (1- (strlen msg))) ": ")) ;then strip space
      (setq msg (strcat "\n" msg ": "))         ;else msg OK
  ) );if,if
  (initget bit kwd)                             ;initialize the key words
  (setq inp (getkword msg))                     ;and use the GET command
  (if inp inp def)               ;compare the results, return appropriate value
);defun

(DEFUN clerr (msg)
 (princ "\nAborting...by User")
 (princ msg)
 (Command "layer" "s" cl "")
 (SetVar "TEXTSTYLE" act)
 (setq *error* olderr)             ; Restore old *error* handler
 (Terpri)
)

(Defun c:Filit (/ ly cl num sset hnd itm)
 (setq olderr *error* *error* clerr)
 (SetQ action (ukword 1 "Area Houses Concrete" "Area/Houses/Concrete " action))
 (SetQ cl (GetVar "clayer"))
  (command "UNDO" "G")
  (SetQ sset (ssget '((-4 . "<OR")(0 . "POLYLINE")(0 . "LWPOLYLINE")(0 . "CIRCLE")(-4 . "OR>"))))
  (if sset
   (progn
    (SetQ num (sslength sset) itm 0)
    (while (< itm num)
     (SetQ hnd (ssname sset itm))
     (SetQ ly (cdr (assoc 8 (EntGet hnd))))
     (Command "layer" "s" ly "")
      (Cond
       ((Eq action "Area")
        (command "_HATCH" "_S" hnd "")
        (SetQ itm (1+ itm))
       )  ;eq
       ((Eq action "Houses")
        (command "_HATCH" "TRIDOTS" "" "" hnd "")
        (SetQ itm (1+ itm))
       )  ;eq
       ((Eq action "Concrete")
        (command "_HATCH" "ANSI31" "" "" hnd "")
        (SetQ itm (1+ itm))
       )  ;eq
       ((Eq action "Quit")
        (Setq action nil)
       )
      ) ; cond
    )
    (command "_DRAWORDER" sset "" "_F")
   )
 )
 (command "UNDO" "E")
 (setq *error* olderr)             ; Restore old *error* handler
 (Command "layer" "s" cl "")
 (princ)
)
(C:filit)

Here is a code for filling closed objects with one of three patterns chossen. It works fine on ver 7.

John Gaunt

At a quick look, -hatch works from the command line, but _hatch brings up the popup. You want the first I think?

Alexander Van Heuverzwyn

We changed the syntax of command -HATCH since V7. Also when run from lisp a call to HATCH will not open the dialog, it will run hatch on commandline.

Roy Klein Gebbinck

Try this:

(defun c:Filit (/ ly cl num sset hnd itm)
;;; works in BC7 en BC10
;;; strange message in BC7:
;;;     Current hatch pattern: ANSI31
;;;     Warning: 'ANSI31' Has no global match in its initget string!
;;;             Empty string returned.
  (setq
     olderr *error*
        *error* clerr
     action (ukword 1 "Area Houses Concrete" "Area/Houses/Concrete " action)
       cl (getvar "clayer")
      sset (ssget '((-4 . "<OR")(0 . "POLYLINE")(0 . "LWPOLYLINE")(0 . "CIRCLE")(-4 . "OR>")))
    )
 (setvar "cmdecho" 0)
  (command "_.undo" "_group")
   (if sset
      (progn
            (setq
             num (sslength sset)
               itm 0
         )
         (while (< itm num)
             (setq
                 hnd (ssname sset itm)
                 ly (cdr (assoc 8 (entget hnd)))
               )
             (command "_.layer" "_set" ly "")
              (cond
                 ((= action "Area")
                        (command "_.-bhatch" "_select" hnd "" "")
                 )
                 ((= action "Houses")
                      (command "_.-bhatch" "_select" hnd "" "_properties" "TRIDOTS" "_proceed" "")
                  )
                 ((= action "Concrete")
                        (command "_.-bhatch" "_select" hnd "" "_properties" "ANSI31" "_proceed" "")
                   )
             )
             (setq itm (1+ itm))
           )
         (command "_.draworder" sset "" "_front") ; not necessary for BC10
     )
 )
 (setq *error* olderr)
 (command "_.layer" "_set" cl "")
  (command "_.undo" "_end")
 (princ)
)

Raam Finzi

Thanks.It works. I would never guess the change necessary to invoke this lisp routine.