Author Topic: Hatch by polyline Question  (Read 7189 times)

0 Members and 1 Guest are viewing this topic.

ronjonp

  • Needs a day job
  • Posts: 7025
Hatch by polyline Question
« Reply #15 on: August 23, 2005, 07:03:02 PM »
not pretty but this works....

Code: [Select]
(defun c:plh (/  u-plinegen u-clayer u-plinewid *error* drawpline)        

;_____________________________
;Error function
;_____________________________

(defun *error* (msg)
   (if
      (not
        (member
          msg
          '("console break" "Function cancelled" "quit / exit abort" "")
        )
      )
       (princ (strcat "\nError: " msg))
    ) ; if
(setvar 'plinegen u-plinegen)
(setvar 'clayer u-clayer)
(setvar 'plinewid u-plinewid)
    (princ)
  ) ;end error function


;_____________________________
;Function to draw polyline
;_____________________________

(defun drawpline (/)
  (command "_.pline")
  ;;   repeat a point input until Enter
  (if (while (> (getvar "CMDACTIVE") 0)
(command pause)
      )
    (*error* "")
  )
)

;_____________________________
;Get User Variables
;_____________________________

(setq u-plinegen (getvar 'plinegen)
u-clayer   (getvar 'clayer)
u-plinewid (getvar 'plinewid)
)

(if (tblsearch "layer" "mylayer")
(command "-layer" "thaw" "mylayer" "on" "mylayer" "")
)
      (setvar 'plinegen 1)
      (setvar 'plinewid (* (getvar "dimscale") 0.025))
      (command "_.-Layer" "_Make" "mylayer" "_L" "hidden2" "" "_Color" "4" "" "")
   (drawpline)
(command ".hatch" "ANSI31" "1" "45" "last" "")

;_____________________________
;Reset User Variables
;_____________________________

   (setvar 'plinegen u-plinegen)
   (setvar 'clayer u-clayer)
   (setvar 'plinewid u-plinewid)

  )

Windows 10 x64 - AutoCAD /C3D 2020

Custom Build PC

CAB

  • Global Moderator
  • Seagull
  • Posts: 10362
Hatch by polyline Question
« Reply #16 on: August 23, 2005, 07:15:30 PM »
Well I tried to use MP's subroutine to draw the pline first but got an error
using ACAD2000. Must be the version of ACAD?

Entity handle:162A9 caused this error: Invalid number of parametersEntity
handle:16A33 caused this error: Invalid number of parameters

Anyway here is my febal attempt

;;  Draw a polyline then it auto hatches it
;;  No error checking on my code
Code: [Select]
(defun c:phatch (/ elast space)

  ;;  sub by MP
  (defun _HatchIt (space object / hatch err)
    (setq err
           (vl-catch-all-apply
             '(lambda ()
                (setq hatch
                       (vlax-invoke
                         space 'AddHatch achatchstylenormal
                         ;; pattern type                
                         "ANSI31"
                         ;; pattern name
                         :vlax-false
                         ;; associativity
                         AcHatchObject
                         ;; hatch object type
                        )
                )
                (vlax-invoke
                  hatch
                  'AppendOuterLoop
                  (list object)
                )
                (vlax-invoke hatch 'Evaluate)
              )
           )
    )
    (if (vl-catch-all-error-p err)
      (princ
        (strcat
          "Entity handle:"
          (vla-get-handle object)
          " caused this error: "
          (vl-catch-all-error-message err)
        )
      )
    )
  )


  (setq elast (entlast))
  (prompt "\nDraw area to hatch, use C to close area.")
  ;;   repeat a point input until Enter
  (command "PLINE")
  (while (> (getvar "CMDACTIVE") 0)
    (command pause)
  )
  (if (and (/= (entlast) elast)
           (= (cdr (assoc 0 (entget (entlast)))) "LWPOLYLINE")
      )
    (progn
      (setq space
             (vlax-get-property
               (vlax-get-property
                 (vlax-get-acad-object)
                 'ActiveDocument
               )
               (if (eq 1 (getvar "cvport"))
                 'PaperSpace
                 'ModelSpace
               )
             )
      )
      (_HatchIt space (vlax-ename->vla-object (entlast)))
    )
  )
  (princ)
)
I've reached the age where the happy hour is a nap. ()
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10362
Hatch by polyline Question
« Reply #17 on: August 23, 2005, 07:17:07 PM »
Ron, you snuck in there while I wasn't watchen... :)
I've reached the age where the happy hour is a nap. ()
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

ronjonp

  • Needs a day job
  • Posts: 7025
Hatch by polyline Question
« Reply #18 on: August 23, 2005, 07:22:13 PM »
Yeah but my look at my hacked together code compared to yours. :)

Windows 10 x64 - AutoCAD /C3D 2020

Custom Build PC

MP

  • Seagull
  • Posts: 17400
Hatch by polyline Question
« Reply #19 on: August 23, 2005, 07:24:51 PM »
Works fine under 2004. Hmmm.
\|// Set goal. Experiment tirelessly until
|Oo| practice has become expertise.  Loop.
|- | LinkedIn | Dropbox

CAB

  • Global Moderator
  • Seagull
  • Posts: 10362
Hatch by polyline Question
« Reply #20 on: August 23, 2005, 07:39:10 PM »
Yea, I just cranked up 2004 & my routine using your sub worked fine.

Go figure :roll:

By the way, nice code MP  :)
I've reached the age where the happy hour is a nap. ()
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

MP

  • Seagull
  • Posts: 17400
Hatch by polyline Question
« Reply #21 on: August 23, 2005, 08:31:35 PM »
This just in: Works in AutoCAD 2006. :roll:

I don't have 2002 here at home but maybe I can figure what make it face plant in older versions tomorrow at work (when I can steal a moment or two).
\|// Set goal. Experiment tirelessly until
|Oo| practice has become expertise.  Loop.
|- | LinkedIn | Dropbox

MP

  • Seagull
  • Posts: 17400
Hatch by polyline Question
« Reply #22 on: August 23, 2005, 08:34:04 PM »
Hey -- thanks Alan. :)
\|// Set goal. Experiment tirelessly until
|Oo| practice has become expertise.  Loop.
|- | LinkedIn | Dropbox

CAB

  • Global Moderator
  • Seagull
  • Posts: 10362
Hatch by polyline Question
« Reply #23 on: August 23, 2005, 08:40:50 PM »
Any time :)
I've reached the age where the happy hour is a nap. ()
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Jeff_M

  • King Gator
  • Posts: 3942
  • C3D user & customizer
Hatch by polyline Question
« Reply #24 on: August 23, 2005, 10:33:24 PM »
Michael,
This is what fails in 2002:
Code: [Select]
AcHatchObject      ;; hatch object type
This is not a parameter that needs to be set in 2002.....looks like Adesk changed the AddHatch method. From the Help:
Quote
RetVal = object.AddHatch(PatternType, PatternName, Associativity)

MP

  • Seagull
  • Posts: 17400
Hatch by polyline Question
« Reply #25 on: August 23, 2005, 10:59:54 PM »
Thanks Jeff, excellent detective work. It's easy to code around this (though coded blind).

I'll try to run this under 2000/2002 tomorrow, hopefully it won't toss too much egg on me face.

Code: [Select]
(defun c:HatchEm ( / *error* _HatchIt _HatchItSub version ss i space )

    (cond
        (   (> 15 (setq version (atoi (getvar "acadver"))))
            ;;  shreik! AutoCAD 14 and older
            (princ "Upgrade your AutoCAD mang!\n")
            (defun *error* (x) (princ))
            (exit)
        )
        (   (< 15 version)
            ;;  AutoCAD 2004+
            (defun _HatchItSub ( space )
                (vlax-invoke
                    space
                   'AddHatch
                    acHatchStyleNormal ;; pattern type              
                    "ANSI31"           ;; pattern name
                    :vlax-false        ;; associativity
                    AcHatchObject      ;; hatch object type
                )
            )
        )
        (   ;;  AutoCAD 2000 / 2002
            (defun _HatchItSub ( space )
                (vlax-invoke
                    space
                   'AddHatch
                    acHatchStyleNormal ;; pattern type              
                    "ANSI31"           ;; pattern name
                    :vlax-false        ;; associativity
                )
            )
        )    
    )

    (defun _HatchIt ( space object / hatch err )
        (setq err
            (vl-catch-all-apply
               '(lambda ()
                    (setq hatch (_HatchItSub space))
                    (vlax-invoke
                        hatch
                       'AppendOuterLoop
                       (list object)
                    )  
                    (vlax-invoke hatch 'Evaluate)
                )  
            )  
        )
        (if (vl-catch-all-error-p err)
            (princ
                (strcat
                    "Entity handle:"
                    (vla-get-handle object)
                    " caused this error: "
                    (vl-catch-all-error-message err)
                )
            )  
        )  
    )
   
    (cond
        (   (setq ss
                (ssget
                   '(   (0 . "lwpolyline,polyline")
                        (-4 . "&")
                        (70 . 1)
                    )
                )
            )
            (setq space
                (vlax-get-property
                    (vlax-get-property
                        (vlax-get-acad-object)
                       'ActiveDocument
                    )
                    (if (eq 1 (getvar "cvport"))
                       'PaperSpace
                       'ModelSpace
                    )
                )
            )  
            (repeat (setq i (sslength ss))
                (_HatchIt
                    space
                    (vlax-ename->vla-object
                        (ssname ss (setq i (1- i)))
                    )
                )
            )
        )
    )
   
    (princ)

)
\|// Set goal. Experiment tirelessly until
|Oo| practice has become expertise.  Loop.
|- | LinkedIn | Dropbox

CAB

  • Global Moderator
  • Seagull
  • Posts: 10362
Hatch by polyline Question
« Reply #26 on: August 23, 2005, 11:38:50 PM »
That did the trick, works in A2k. :)
I've reached the age where the happy hour is a nap. ()
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

MP

  • Seagull
  • Posts: 17400
Hatch by polyline Question
« Reply #27 on: August 23, 2005, 11:44:17 PM »
Thanks Alan -- If I didn't have a headache I'd optimize it a bit but alas ... :(

Nonetheless thank you for testing it.

:)
\|// Set goal. Experiment tirelessly until
|Oo| practice has become expertise.  Loop.
|- | LinkedIn | Dropbox

Jeff_M

  • King Gator
  • Posts: 3942
  • C3D user & customizer
Hatch by polyline Question
« Reply #28 on: August 24, 2005, 12:25:15 AM »
Well Michael, you never cease to amaze me. It's late and you have a headache, yet your code always manages to look 10x better than mine AND you manage to throw a bit of humor into your code as well.

I'm glad I could spot the trouble spot rather quickly for you. I was going to offer a solution, nearly the same as yours (I never even would of thought to include the check for < 15...) but it was nearly dinner time and my night to cook. I'm glad you posted before I made it back :P , you saved me from mangling your code.

MP

  • Seagull
  • Posts: 17400
Hatch by polyline Question
« Reply #29 on: August 24, 2005, 07:58:09 AM »
You're too generous and humble Jeff! And for the record I've never seen you post mangled code, oh contraire, you've posted a lot of gems. Between your coding skills and a penchant to jump in and help your're not only a great asset but a great friend to swamp folk.

When do we eat?

:)
\|// Set goal. Experiment tirelessly until
|Oo| practice has become expertise.  Loop.
|- | LinkedIn | Dropbox