TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: V-Man on November 16, 2011, 02:52:33 PM
-
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.
(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.
(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,
-
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
-
Works on my end unless the boundary is too small for the hatch pattern scale.
For fun, here's a much faster/safer way...
(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)
)
-
Actually, this would be better (ignores locked layers and only selects objects in the active view):
(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)
)
-
Great. Many thanks. I will give your code a whirl.
Thanks again.
-
Great. Many thanks. I will give your code a whirl.
Thanks again.
Any time.