[编程交流] 帮助：Lisp填充多个c

(defun c:mhatch (/ ang do-it doc hatch oname pname scl space ss)
(if (setq ss (ssget '((0 . "LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
(progn
(setq scl (getvar "hpscale")
ang (getvar "hpang")
pname (getvar "hpname")
hpassoc (if (= (getvar "hpassoc") 1)
:vlax-true
:vlax-false)
doc (vla-get-activedocument
(vlax-get-acad-object))
space (if (= (getvar "cvport") 1)
(vla-get-paperspace doc)
(vla-get-modelspace doc)
)
)
(vlax-for ent (vla-get-activeselectionset doc)
(setq do-it nil
oname (strcase (vla-get-objectname ent)))
(cond ((vl-string-search "CIRCLE" oname)
(setq do-it t)
)
((and (vl-string-search "LINE" oname)
(eq (vla-get-closed ent) :vlax-true)
)
(setq do-it t)
)
((equal (vlax-curve-getstartpoint ent)
(vlax-curve-getendpoint ent)
1e-6)
(setq do-it t)
)
)
(if do-it
(progn
(setq hatch (vlax-invoke space 'addhatch acHatchObject pname hpassoc))
(vlax-invoke hatch 'appendouterloop (list ent))
(vlax-put hatch 'patternangle ang)
(vlax-put hatch 'patternscale scl)
(vla-evaluate hatch)
)
)
)
)
)
(princ)
)

(defun c:Test  (/ h _doc ss)
;;;        Tharwat 20.01.2014        ;;
 (princ "\n Select closed objects to hatch as per current hatch settings ")
 (if (setq _doc (vla-get-activedocument (vlax-get-acad-object))
           ss   (ssget '((-4 . "<OR")
                         (0 . "CIRCLE,ELLIPSE")
                         (-4 . "<AND")
                         (0 . "LWPOLYLINE")
                         (-4 . "&=")
                         (70 . 1)
                         (-4 . "AND>")
                         (-4 . "OR>"))))
   (vlax-for o  (vla-get-activeselectionset _doc)
     (setq h (vlax-invoke
               (vla-get-block (vla-get-activelayout _doc))
               'addhatch
               acHatchObject
               (getvar "hpname")
               (if (= (getvar "hpassoc") 1)
                 :vlax-true
                 :vlax-false)))
     (vlax-invoke h 'appendouterloop (list o))
     (vlax-put h 'patternangle (getvar "hpang"))
     (vlax-put h 'patternscale (getvar "hpscale"))
     (vla-evaluate h)
     )
   )
 (princ)
 )(vl-load-com)

(defun c:Test  (/ soc h _doc ss)
;;;        Tharwat 20.01.2014        ;;
 (princ
   "\n Select closed objects to hatch as per current hatch settings ")
 (if (setq _doc (vla-get-activedocument (vlax-get-acad-object))
           soc (if (= (getvar "hpassoc") 1)
                 :vlax-true
                 :vlax-false)
           ss   (ssget '((-4 . "<OR")
                         (0 . "CIRCLE,ELLIPSE")
                         (-4 . "<AND")
                         (0 . "LWPOLYLINE")
                         (-4 . "&=")
                         (70 . 1)
                         (-4 . "AND>")
                         (-4 . "OR>"))))
   (vlax-for o  (vla-get-activeselectionset _doc)
     (setq h (vlax-invoke
               (vla-get-block (vla-get-activelayout _doc))
               'addhatch
               acHatchObject
               (getvar "hpname")
               soc))
     (vlax-invoke h 'appendouterloop (list o))
     (vla-put-AssociativeHatch h soc)
     (vlax-put h 'patternangle (getvar 'hpang))
     (vlax-put h 'patternscale (getvar 'hpscale))
     (vla-evaluate h)
     )
   )
 (princ)
 ) (vl-load-com)

(setq ss (ssget '((0 . "LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))

(setq _doc (vla-get-activedocument (vlax-get-acad-object))
           soc (if (= (getvar "hpassoc") 1)
                 :vlax-true
                 :vlax-false)
[color="red"]            ss   (ssget '((-4 . "<OR")
                         (0 . "CIRCLE,ELLIPSE")
                         (-4 . "<AND")
                         (0 . "LWPOLYLINE")
                         (-4 . "&=")
                         (70 . 1)
                         (-4 . "AND>")
                         (-4 . "OR>")))[/color]
)

; error: malformed list on input

(defun c:Test  (/ soc h _doc ss)
;;;    Tharwat 20.01.2014    ;;
 (princ
   "\n Select closed objects to hatch as per current hatch settings ")
 (if (setq _doc (vla-get-activedocument (vlax-get-acad-object))
           soc (if (= (getvar "hpassoc") 1)
                 :vlax-true
                 :vlax-false)
           (setq ss (ssget '((0 . "LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
)
   (vlax-for o  (vla-get-activeselectionset _doc)
     (setq h (vlax-invoke
               (vla-get-block (vla-get-activelayout _doc))
               'addhatch
               acHatchObject
               (getvar "hpname")
               soc))
     (vlax-invoke h 'appendouterloop (list o))
     (vla-put-AssociativeHatch h soc)
     (vlax-put h 'patternangle (getvar 'hpang))
     (vlax-put h 'patternscale (getvar 'hpscale))
     (vla-evaluate h)
     )
   )
 (princ)
 ) (vl-load-com)

(defun c:Test  (/ soc h _doc ss)
;;;    Tharwat 20.01.2014    ;;
 (princ
   "\n Select closed objects to hatch as per current hatch settings ")
 (if (setq _doc (vla-get-activedocument (vlax-get-acad-object))
           soc  (if (= (getvar "hpassoc") 1)
                  :vlax-true
                  :vlax-false)
           ss   (ssget '((0 . "LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")))
           )
   (vlax-for o  (vla-get-activeselectionset _doc)
     (setq h (vlax-invoke
               (vla-get-block (vla-get-activelayout _doc))
               'addhatch
               acHatchObject
               (getvar "hpname")
               soc))
     (vlax-invoke h 'appendouterloop (list o))
     (vla-put-AssociativeHatch h soc)
     (vlax-put h 'patternangle (getvar 'hpang))
     (vlax-put h 'patternscale (getvar 'hpscale))
     (vla-evaluate h)
     )
   )
 (princ)
 )(vl-load-com)