Jump to content

Hatch Origin Change not working

3dwannab

By 3dwannab
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

3dwannab Experienced

3dwannab

Posted
Posted

With the code below this sometimes works and other times not. The test point command places points on top of each other when it shouldn't.

 

I can't figure out why. See lines 126-155 of the code below.

 

It's the offset section of the code that I can't get working. I've tried to see if a VLA method could work but the help found here is a bit beyond my understanding.

 

See the attached sample drawing. I want to offset each hatch by an x,y value.

 

Similar thread here. 

 

  

;;------------ ------=={ HH_Origin_Location.lsp }==---------------------;;
;;  Author: 3dwannab, 2023
;;----------------------------------------------------------------------;;
;;  Version 0.1    -    2017.03.18 - First release.
;;  Version 0.2    -    2018.04.11 - Added OSNAPHATCH to 1 to allow picking hatch snap points.
;;                                   Added a pickAll option to affect all selected Hatches, not just one at a time.
;;                                   initget 1) added to force point pickage.
;;  Version 0.2    -    2023.09.25 - Added offset option.
;;----------------------------------------------------------------------;;
;;  Hatch Location Options:
;;  BottomLeft/BottomRight/TopRight/TopLeft/Center/Pickone/pickAll/Offset

;; pickAll affects all selected and asks user to pick one point.
;; Pickone allows the user to select hatch then point. This will go in a loop, ESC to exit.
;;----------------------------------------------------------------------;;

(defun c:HOL nil (c:HH_Origin_Location))
(defun c:HH_Origin_Location (/ *error* acDoc ans bdata ent i offsetPt pt ptHatchOriginX ptHatchOriginXYNew ptHatchOriginY ss var_cmdecho var_nomutt var_osnaphatch) 

  (defun *error* (errmsg) 
    (and acDoc (vla-EndUndoMark acDoc))
    (and errmsg 
         (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*"))
         (princ (strcat "\n<< Error: " errmsg " >>\n"))
    )
    (setvar 'CMDECHO var_cmdecho)
    (setvar 'NOMUTT var_nomutt)
    (setvar 'OSNAPHATCH var_osnaphatch)
    (princ)
  )

  (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (or (vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc))

  (setq var_cmdecho (getvar "CMDECHO"))
  (setq var_nomutt (getvar "NOMUTT"))
  (setq var_osnaphatch (getvar "OSNAPHATCH"))

  (setvar 'cmdecho 0)
  (setvar 'nomutt 1)
  (setvar 'osnaphatch 1)

  (initget "bottomLeft bottomRight toprIght toplEft Center Pickone pickAll Offset")
  (setq ans (getkword "\nChoose hatch location: [bottom Left/bottom Right/top rIght/top lEft/Center/Pick one/pick All/Offset] <pickAll>: "))
  (if (not ans) (setq ans "pickAll"))
  (princ (strcat "\n" ans " option choosen.\n"))

  (cond 
    ((= "pickAll" ans)
     (initget 1)
     (setq pt (getpoint "\n\t\tNew hatch origin : "))
    )
    ((= "Offset" ans)
     (initget 1)
     (setq offsetPt (getpoint "\nOffset by (x,y) : "))
    )
  )

  (progn 

    (cond 
      ((= "Pickone" ans)
       (sssetfirst)
       (setvar 'osmode 1023)
       (while 
         (not 
           (progn 
             (and 
               (setq ent   (car (entsel "\nSelect hatch (ESC to exit): "))
                     bdata (if ent (entget ent))
               )
               (= (cdr (assoc 0 bdata)) "HATCH")
               (progn 
                 (initget 1)
                 (setq pt (getpoint "\nNew hatch origin: "))
                 (command "_.HatchEdit" ent "_O" "_S" pt "_Y")
               )
             )
           )
         )
         (cond 
           ((/= (cdr (assoc 0 bdata)) "HATCH")
            (princ "\n: -------------------------\n\t\t*** Nothing selected, or it is not a Hatch! ***\n")
           )
         )
       )
      )
    )

    (cond 
      ((/= "Pickone" ans)
       (if (setq ss (ssget "_:L" '((0 . "HATCH")))) 
         (repeat (setq i (sslength ss)) 

           (setq ent (ssname ss (setq i (1- i))))

           (cond 
             ((= "bottomLeft" ans)
              (command-s "_.HatchEdit" ent "_O" "_D" "_L" "_Y")
              (princ)
             )
             ((= "bottomRight" ans)
              (command-s "_.HatchEdit" ent "_O" "_D" "_R" "_Y")
              (princ)
             )
             ((= "toprIght" ans)
              (command-s "_.HatchEdit" ent "_O" "_D" "_I" "_Y")
              (princ)
             )
             ((= "toplEft" ans)
              (command-s "_.HatchEdit" ent "_O" "_D" "_E" "_Y")
              (princ)
             )
             ((= "Center" ans)
              (command-s "_.HatchEdit" ent "_O" "_D" "_C" "_Y")
              (princ)
             )
             ((= "pickAll" ans)
              (command-s "_.HatchEdit" ent "_O" "_S" pt "_Y")
              (princ)
             )
             ((= "Offset" ans)

              ; (if (cdr (assoc 44 bdata))

              (setq bdata (entget ent))

              (setq ptHatchOriginX (cdr (assoc 43 bdata)))
              (setq ptHatchOriginY (cdr (assoc 44 bdata)))
              (setq ptHatchOriginXYNew (mapcar '+ offsetPt (list ptHatchOriginX ptHatchOriginY 0)))


              ; Here I've tried the VLA approach but not sure how to get this to work.
              ; (setq origin (vla-get-origin o))
              ; (princ origin)

              (princ "\n")
              (princ "Testing lines...")
              (princ "\n")
              (princ ptHatchOriginX)
              (princ "\n")
              (princ ptHatchOriginY)
              (princ "\n")
              (princ (list ptHatchOriginX ptHatchOriginY))
              (princ "\n")
              (princ ptHatchOriginXYNew)
              (princ "\n")
              (princ offsetPt)

              (command-s "_.HatchEdit" ent "_O" "_S" ptHatchOriginXYNew "_Y")

              (princ)

              (command "point" (list ptHatchOriginX ptHatchOriginY 0))
              (command "point" ptHatchOriginXYNew)

              ; )
             )
           )
         )
       )
      )
    )
    T
  )
  (princ (strcat "\n\t\t<<< " (itoa (sslength ss)) (if (> (sslength ss) 1) " hatches" " hatch") " changed using " ans " option >>>\n"))
  (*error* nil)
  (princ)
)
(vl-load-com)
(princ 
  (strcat 
    "\nHatch_Origin_Location.lsp | Version 0.2 | \\U+00A9 3dwannab "
    (menucmd "m=$(edtime,0,yyyy)")
    ""
    "\nType \"HOL\" or \"HH_Origin_Location\" to Run."
  )
)

(princ)
; (c:HH_Origin_Location) ;; Unblock for testing

 

How do I offset each of these hatches.dwg

pkenewell Experienced

pkenewell

Posted
Posted

This seems to work fine for me. However, I had to change the hatch pattern because I do not have the same pattern as yours. Perhaps you need to post the *.pat file associated with the hatch you are using as well.

 

Another general thing I noticed is that the object snaps, might be interfering with the Hatch edit command. use the "_non" osnap to disable the osnaps when placing the point in the command. Try changing the following lines (#s 76, 119 and 150 respectively): 

(command-s "_.HatchEdit" ent "_O" "_S" pt "_Y")
TO
(command-s "_.HatchEdit" ent "_O" "_S" "_non" pt "_Y")

AND

(command-s "_.HatchEdit" ent "_O" "_S" ptHatchOriginXYNew "_Y")
TO
(command-s "_.HatchEdit" ent "_O" "_S" "_non" ptHatchOriginXYNew "_Y")

 

Also add the same in front of placing your test points for accurate locating: 

(command "point" "_non" (list ptHatchOriginX ptHatchOriginY 0))
(command "point" "_non" ptHatchOriginXYNew)

 

  • Like 1
pkenewell Experienced

pkenewell

Posted
Posted (edited)

There is also an error on the "Pickone" option because you do not create a selection set "ss" from the selected entities, then at the end you try to reference a selection set that doesn't exist. You need to add this under the Hatchedit command function in your "Pickone" condition: 

(setq ss (if ss (ssadd ent ss) (ssadd ent)))

 

Edited by pkenewell
3dwannab Experienced

3dwannab

Posted
  • Author
Posted (edited)
22 hours ago, pkenewell said:

There is also an error on the "Pickone" option because you do not create a selection set "ss" from the selected entities, then at the end you try to reference a selection set that doesn't exist. You need to add this under the Hatchedit command function in your "Pickone" condition: 

(setq ss (if ss (ssadd ent ss) (ssadd ent)))

 

 

Not quite sure where in the code you are referring to.

 

Thanks. Adding "_non"  to the pick points worked. I wreaked my head trying to fix this. I guess adding osnap = 0 would do the same thing.

 

Anyway, here is the new code. I've added a filter to select all hatches bar SOLID and gradient too.

 

Attached is the hatch .pat file also and a new sample drawing for anyone wishing to test this.

  

;;----------------------------------------------------------------------;;
;;  Author: 3dwannab, 2023
;;----------------------------------------------------------------------;;
;;  Version 0.1    -    2017.03.18 - First release.
;;  Version 0.2    -    2018.04.11 - Added OSNAPHATCH to 1 to allow picking hatch snap points.
;;                                   Added a pickAll option to affect all selected Hatches, not just one at a time.
;;                                   initget 1) added to force point pickage.
;;  Version 0.2    -    2023.09.25 - Added offset option.
;;  Version 0.3    -    2023.09.27 - Fixed offset option with "_non". Thanks @pkenewell on CADTutor.
;;                                   Change ssget filter to not select 'SOLID' or 'Gradient' hatches.
;;----------------------------------------------------------------------;;
;;  Hatch Location Options:
;;  BottomLeft/BottomRight/TopRight/TopLeft/Center/Pickone/pickAll/Offset

;; pickAll affects all selected and asks user to pick one point.
;; Pickone allows the user to select hatch then point. This will go in a loop, ESC to exit.
;;----------------------------------------------------------------------;;

(defun c:HOL nil (c:HH_Origin_Location))
(defun c:HH_Origin_Location (/ *error* acDoc ans bdata ent i offsetPt pt ptHatchOriginX ptHatchOriginXYNew ptHatchOriginY ss1 var_cmdecho var_nomutt var_osnaphatch)

  (defun *error* (errmsg)
    (and acDoc (vla-EndUndoMark acDoc))
    (and errmsg
         (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*"))
         (princ (strcat "\n<< Error: " errmsg " >>\n"))
    )
    (setvar 'CMDECHO var_cmdecho)
    (setvar 'NOMUTT var_nomutt)
    (setvar 'OSNAPHATCH var_osnaphatch)
    (princ)
  )

  (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (or (vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc))

  (setq var_cmdecho (getvar "CMDECHO"))
  (setq var_nomutt (getvar "NOMUTT"))
  (setq var_osnaphatch (getvar "OSNAPHATCH"))

  (setvar 'cmdecho 0)
  (setvar 'nomutt 1)
  (setvar 'osnaphatch 1)

  (initget "bottomLeft bottomRight toprIght toplEft Center Pickone pickAll Offset")
  (setq ans (getkword "\nChoose hatch location: [bottom Left/bottom Right/top rIght/top lEft/Center/Pick one/pick All/Offset] <pickAll>: "))
  (if (not ans) (setq ans "pickAll"))
  (princ (strcat "\n" ans " option choosen.\n"))

  (cond
    ((= "pickAll" ans)
     (initget 1)
     (setq pt (getpoint "\n\t\tNew hatch origin : "))
    )
    ((= "Offset" ans)
     (initget 1)
     (setq offsetPt (getpoint "\nOffset by (x,y) : "))
    )
  )

  (progn

    (cond
      ((= "Pickone" ans)
       (sssetfirst)
       (setvar 'osmode 1023)
       (while
         (not
           (progn
             (and
               (setq ent   (car (entsel "\nSelect hatch (ESC to exit): "))
                     bdata (if ent (entget ent))
               )
               (= (cdr (assoc 0 bdata)) "HATCH")
               (progn
                 (initget 1)
                 (setq pt (getpoint "\nNew hatch origin: "))
                 (command "_.HatchEdit" ent "_O" "_S" pt "_Y")
               )
             )
           )
         )
         (cond
           ((/= (cdr (assoc 0 bdata)) "HATCH")
            (princ "\n: -------------------------\n\t\t*** Nothing selected, or it is not a Hatch! ***\n")
           )
         )
       )
      )
    )

    (cond
      ((/= "Pickone" ans)
       (if (setq ss1 (ssget '((0 . "HATCH") (2 . "~SOLID") (-4 . "<NOT") (2 . "*`,*") (-4 . "NOT>"))))

         (repeat (setq i (sslength ss1))

           (setq ent (ssname ss1 (setq i (1- i))))

           (cond
             ((= "bottomLeft" ans)
              (command-s "_.HatchEdit" ent "_O" "_D" "_L" "_Y")
              (princ)
             )
             ((= "bottomRight" ans)
              (command-s "_.HatchEdit" ent "_O" "_D" "_R" "_Y")
              (princ)
             )
             ((= "toprIght" ans)
              (command-s "_.HatchEdit" ent "_O" "_D" "_I" "_Y")
              (princ)
             )
             ((= "toplEft" ans)
              (command-s "_.HatchEdit" ent "_O" "_D" "_E" "_Y")
              (princ)
             )
             ((= "Center" ans)
              (command-s "_.HatchEdit" ent "_O" "_D" "_C" "_Y")
              (princ)
             )
             ((= "pickAll" ans)
              (command-s "_.HatchEdit" ent "_O" "_S" "_NON" pt "_Y")
              (princ)
             )
             ((= "Offset" ans)

              (setq bdata (entget ent))

              (setq ptHatchOriginX (cdr (assoc 43 bdata)))
              (setq ptHatchOriginY (cdr (assoc 44 bdata)))
              (setq ptHatchOriginXYNew (mapcar '+ offsetPt (list ptHatchOriginX ptHatchOriginY 0)))

              ; TESTING LINES
              ; (princ "\n")
              ; (princ "Testing lines...")
              ; (princ "\n")
              ; (princ (list ptHatchOriginX ptHatchOriginY))
              ; (princ "\n")
              ; (princ ptHatchOriginXYNew)
              ; (princ "\n")
              ; (princ offsetPt)
              ; (command "_.point" "_NON" (list ptHatchOriginX ptHatchOriginY 0))
              ; (command "_.point" "_NON" ptHatchOriginXYNew)

              (command-s "_.HatchEdit" ent "_O" "_S" "_NON" ptHatchOriginXYNew "_Y")

              (princ)
             )
           )
         )
       )
      )
    )
    T
  )

  (if ss1
    (progn
      (princ (strcat "\n\t\t<<< " (itoa (sslength ss1)) (if (> (sslength ss1) 1) " hatches" " hatch") " changed using " ans " option >>>\n"))
      (sssetfirst nil ss1)
      (command "_.regen")
    )
  )
  (*error* nil)
  (princ)
)
(vl-load-com)
(princ
  (strcat
    "\nHatch_Origin_Location.lsp | Version 0.3 | \\U+00A9 3dwannab "
    (menucmd "m=$(edtime,0,yyyy)")
    ""
    "\nType \"HOL\" or \"HH_Origin_Location\" to Run."
  )
)
(princ)
  ; (c:HH_Origin_Location) ;; Unblock for testing

 

Panel 600x600mm with 10mm Gap.pat How do I offset each of these hatches.dwg

Edited by 3dwannab
pkenewell Experienced

pkenewell

Posted
Posted
1 minute ago, 3dwannab said:

Not quite sure where in the code you are referring to.

 

Add the line right after line 78 within your ((= "Pickone" ans)... conditional statement. You should also add a "_non" in line 78.

 

See my changes commented in this partial excerpt of your code: 

      ((= "Pickone" ans)
       (sssetfirst)
       (setvar 'osmode 1023)
       (while
         (not
           (progn
             (and
               (setq ent   (car (entsel "\nSelect hatch (ESC to exit): "))
                     bdata (if ent (entget ent))
               )
               (= (cdr (assoc 0 bdata)) "HATCH")
               (progn
                 (initget 1)
                 (setq pt (getpoint "\nNew hatch origin: "))
                 (command "_.HatchEdit" ent "_O" "_S" "_non" pt "_Y") ; LINE 78 <--- add "_non" here.
                 (setq ss (if ss (ssadd ent ss) (ssadd ent))) ; NEW LINE 79 <--- Add this line to make selection set for reading at end of routine.
               )
             )
           )
         )
         (cond
           ((/= (cdr (assoc 0 bdata)) "HATCH")
            (princ "\n: -------------------------\n\t\t*** Nothing selected, or it is not a Hatch! ***\n")
           )
         )
       )
      )

 

At the end of the routine, you get the length of "ss" for reporting how many hatch objects you changed. If you use the "Pickone" option in your current routine, the "ss" variable never gets populated and the routine crashes out at line #163: 

(princ (strcat "\n\t\t<<< " (itoa (sslength ss1)) (if (> (sslength ss1) 1) " hatches" " hatch") " changed using " ans " option >>>\n"))

 

pkenewell Experienced

pkenewell

Posted
Posted

@3dwannab

A couple more notes:

1) setting "NOMUTT" is unnecessary and removes your program prompts from the command line, while it has no effect on the HATCHEDIT command. Makes it confusing.

2) Your loop structure forces a hard exit from the "Pickone" option, better to change to a different loop to avoid this.

3) you should check for missed picks in the (entsel) using errno system variable. 

 

FWIW, this is how I would write the code. 

(defun c:HH_Origin_Location (/ acdoc ans ent *error* oecho oosnh pt px py pnew ss)
   
   ; Local error function
   (defun *error* (errmsg)
      (and acDoc (vla-EndUndoMark acDoc))
      (and errmsg
         (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*"))
         (princ (strcat "\n<< Error: " errmsg " >>\n"))
      )
      (setvar 'cmdecho oecho)
      (setvar 'osnaphatch oosnh)
      (princ)
  )

  (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object))
        oecho (getvar 'cmdecho)
        oosnh (getvar 'osnaphatch)
  )
  (or (vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc))

   (setvar 'cmdecho 0)
   (setvar 'osnaphatch 1)

   (initget "bottomLeft bottomRight toprIght toplEft Center Pickone pickAll Offset")
   (if (not (setq ans (getkword "\nChoose hatch location: [bottom Left/bottom Right/top rIght/top lEft/Center/Pick one/pick All/Offset] <Pick one>: ")))
      (setq ans "Pickone")
   )

   (if (= ans "Pickone")
      (while
         (progn
            (setvar "errno" 0)
            (setq ent (entsel "\n\nSelect Hatch <Exit>: "))
            (cond
               ((= 7 (getvar "errno"))(princ "\nNo Object Selected. Try Again...\n"))
               ((vl-consp ent)
                  (if (/= (cdr (assoc 0 (entget (car ent)))) "HATCH")
                     (princ "\nInvalid Object Selected. Please Select a HATCH Object. ")
                     (progn
                        (if (setq pt (getpoint "\nNew hatch origin: "))
                           (progn
                              (command "_.HatchEdit" (car ent) "_O" "_S" "_non" pt "_Y")
                              (setq ss (if ss (ssadd (car ent) ss) (ssadd (car ent))))
                           )
                           (princ "\nNo Point Selected. Please restart Selection. ")
                        )
                        T
                     )
                  )
               )
            )
         )
      )
      (progn
         (cond
            ((= ans "pickAll")(setq pt (getpoint "\nNew hatch origin: ")))
            ((= ans  "Offset")(setq pt (getpoint  "\nOffset by (x,y): ")))
         )
         (if (and (or (not (wcmatch ans "pickAll,Offset")) pt)
                  (progn (princ "\nSelect Hatch Objects: ")(setq ss (ssget "_:L" '((0 . "HATCH")))))
             )
            (repeat (setq i (sslength ss)) 
               (setq ent (ssname ss (setq i (1- i))))
               (cond 
                  ((= ans  "bottomLeft")(command-s "_.HatchEdit" ent "_O" "_D" "_L" "_Y"))
                  ((= ans "bottomRight")(command-s "_.HatchEdit" ent "_O" "_D" "_R" "_Y"))
                  ((= ans    "toprIght")(command-s "_.HatchEdit" ent "_O" "_D" "_I" "_Y"))
                  ((= ans     "toplEft")(command-s "_.HatchEdit" ent "_O" "_D" "_E" "_Y"))
                  ((= ans      "Center")(command-s "_.HatchEdit" ent "_O" "_D" "_C" "_Y"))
                  ((= ans     "pickAll")(command-s "_.HatchEdit" ent "_O" "_S" "_non" pt "_Y"))
                  ((= ans      "Offset")
                     (setq el   (entget ent)
                           pX   (cdr (assoc 43 el))
                           pY   (cdr (assoc 44 el))
                           pNEW (mapcar '+ pt (list pX pY 0))
                     )
                     (command-s "_.HatchEdit" ent "_O" "_S" "_non" pNEW "_Y")
                  )
               )
            )
         )
      )
   )

   (if ss (princ (strcat "\n " (itoa (sslength ss)) (if (> (sslength ss) 1) " hatches" " hatch") " changed using " ans " option. ")))

   (*error* nil)
   (princ)
)

 

  • Like 1
pkenewell Experienced

pkenewell

Posted
Posted
1 minute ago, 3dwannab said:

Thanks for the corrections. 😄

 

I was trying to get the vla method to work with the origin method to prevent the command line outputs but the example found here is well beyond my knowledge.

 

https://help.autodesk.com/view/OARX/2022/ENU/?guid=GUID-9EB3E590-E112-4FA7-A266-3B60E5A0B1AF

 

 

Yeah - I looked into that. It is certainly possible, but you would have to manually code much of the functionality of the HATCHEDIT command, such as all the "Bottom Left, Top Left, etc...". More than I have time to play with in code. Using HATCHEDIT works just fine for it 😄

  • Like 1
3dwannab Experienced

3dwannab

Posted
  • Author
Posted

Yeah, that's true. Thanks for your help. It doesn't bother me that much either.

 

I think in your example the ssget would be better with to avoid the selection of solid hatches and gradients.

  

(setq ss (ssget "_:L" '((0 . "HATCH") (2 . "~SOLID") (-4 . "<NOT") (2 . "*`,*") (-4 . "NOT>"))))

 

  • Like 1

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.

×
 Share
Go to topic listing
×
×
  • Create New...