Topic: Check my code

[V-Man]

I have the following code that works great in ACADMAP2010, but when I run this on vanilla ACAD2010 it bombs. It fails on the HATCH part of the code.

Code: [Select]

(defun C:HPP ( / ss n ssss)
(vl-load-com)
(command "_undo" "_g")
  (setq ss (ssget "X" '((0 . "LWPOLYLINE")(8 . "0")(70 . 1))));0=Type , 8=Layer Name , 70=lypolylines closed only
(if (= ss nil)
(alert "LwPolylines are not on the Correct LAYER!")
)
(if ss
  (repeat (setq n (sslength ss))
    (setq n (1- n))
    (command "_.hatch" "HONEY" "140" "" (ssname ss n) "")  )
)
(setq ssss (ssget "X" '((0 . "HATCH"))))
      (command ".chprop" ssss "" "c" "yellow" "")
   (command "._undo" "_end")
  (princ)
)


So I tried to change it to the following and I get nothing.

Code: [Select]

(command ".-hatch" "p" "HONEY" "140" "s" (ssname ss n) "")

Could one of you guys test this out and let me know where I am going wrong?

Thanks,

[nivuahc]

FWIW your codes works just fine in MEP 2011

It also works with

.hatch
_hatch
._hatch
hatch
bhatch

I don't have 'nilla CAD to test it on

[alanjt]

Works on my end unless the boundary is too small for the hatch pattern scale.

For fun, here's a much faster/safer way...

Code: [Select]

(defun c:HPP (/ *error* space ss i hatch)

  (vl-load-com)

  (defun *error* (msg)
    (and *AcadDoc* (vla-endundomark *AcadDoc*))
    (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
      (princ (strcat "\nError: " msg))
    )
  )

  (vla-startundomark
    (cond (*AcadDoc*)
          ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
    )
  )

  (if (setq space (vlax-get *AcadDoc*
                            (if (eq (getvar 'CVPORT) 1)
                              'paperspace
                              'modelspace
                            )
                  )
            ss    (ssget "_X" '((0 . "LWPOLYLINE") (8 . "0") (-4 . "&=") (70 . 1)))
      )
    (repeat (setq i (sslength ss))
      (vl-catch-all-apply
        '(lambda (/)
           (setq hatch (vla-AddHatch space acHatchPatternTypePredefined "HONEY" :vlax-true))
           (vlax-invoke
             hatch
             'AppendOuterLoop
             (list (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
           )
           (vlax-invoke hatch 'Evaluate)
           (vla-put-patternscale hatch 140.)
           (vla-put-color hatch 2)
         )
      )
    )
  )
  (*error* nil)

  (princ)
)

[alanjt]

Actually, this would be better (ignores locked layers and only selects objects in the active view):

Code: [Select]

(defun c:HPP (/ *error* space ss i hatch)

  (vl-load-com)

  (defun *error* (msg)
    (and *AcadDoc* (vla-endundomark *AcadDoc*))
    (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
      (princ (strcat "\nError: " msg))
    )
  )

  (vla-startundomark
    (cond (*AcadDoc*)
          ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
    )
  )

  (if (setq space (vlax-get *AcadDoc*
                            (if (eq (getvar 'CVPORT) 1)
                              'paperspace
                              'modelspace
                            )
                  )
            ss    (ssget "_A"
                         (list '(0 . "LWPOLYLINE")
                               '(8 . "0")
                               '(-4 . "&=")
                               '(70 . 1)
                               (if (eq (getvar 'CVPORT) 1)
                                 (cons 410 (getvar 'CTAB))
                                 '(410 . "Model")
                               )
                         )
                  )
      )
    (repeat (setq i (sslength ss))
      (vl-catch-all-apply
        '(lambda (/)
           (setq hatch (vla-AddHatch space acHatchPatternTypePredefined "HONEY" :vlax-true))
           (vlax-invoke
             hatch
             'AppendOuterLoop
             (list (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
           )
           (vlax-invoke hatch 'Evaluate)
           (vla-put-patternscale hatch 140.)
           (vla-put-color hatch 2)
         )
      )
    )
  )
  (*error* nil)

  (princ)
)

[V-Man]

Great. Many thanks. I will give your code a whirl.

Thanks again.

[alanjt]

Great. Many thanks. I will give your code a whirl.

Thanks again.

Any time.