is there lisp for fill polygone/polyline with block like adarray lisp. adarray lisp cannot use in my cad

[dania]

;;;Cadalyst AutoLISP Solutions	July 2007	ALSPSOL0707.ZIP / ADARRAY.LSP 	(c) Tony Hotchkiss
;;; 
(defun err (s)
  (if (= s "Function cancelled")
    (princ "\nADARRAY - cancelled: ")
    (progn (princ "\nADARRAY - Error: ")
	   (princ s)
	   (terpri)
    ) ;_ progn
  ) ;_ end of if
  (resetting)
  (princ "SYSTEM VARIABLES have been reset\n")
  (princ)
) ;_ end of err
(defun setv (systvar newval)
  (setq x (read (strcat systvar "1")))
  (set x (getvar systvar))
  (setvar systvar newval)
) ;_ end of setv
(defun setting ()
  (setq oerr *error*)
  (setq *error* err)
  (setv "CMDECHO" 0)
  (setv "BLIPMODE" 0)
  (setv "OSMODE" 0)
  (setv "CLAYER" (getvar "CLAYER"))
) ;_ end of setting
(defun rsetv (systvar)
  (setq x (read (strcat systvar "1")))
  (setvar systvar (eval x))
) ;_ end of rsetv
(defun resetting ()
  (rsetv "CMDECHO")
  (rsetv "BLIPMODE")
  (rsetv "OSMODE")
  (rsetv "CLAYER")
  (setq *error* oerr)
) ;_ end of resetting

(defun adarray ()
  (vl-load-com)
  (setq	*thisdrawing* (vla-get-activedocument
			(vlax-get-acad-object)
		      ) ;_ end of vla-get-activedocument
	*modelspace*  (vla-get-ModelSpace *thisdrawing*)
  ) ;_ end of setq
  (setq	bnameindex nil)
  (setq doit 4)
  (setq ad_id (load_dialog "adarray.dcl"))
  (while (>= doit 2)
    (if	(not (new_dialog "adarray" ad_id))
      (exit)
    ) ;_ end of if
    (init-array)
    (action_tile "bname" "(setq bnameindex (atoi $value))")
    (action_tile "row" "(setq *rowdist* (atof $value))")
    (action_tile "col" "(setq *coldist* (atof $value))")
    (action_tile "pick" "(done_dialog 3)")
    (action_tile
      "accept"
      "(get-adarray-data) (done_dialog 1)"
    ) ;_ end of action_tile
    (setq doit (start_dialog))
    (cond
      ((= doit 1)
       (do-array)
      )
      ((= doit 3)
       (setq *point0* (getpoint "\nPick a point: "))
      )
    ) ;_ end of cond
  ) ;_ end of while
  (unload_dialog ad_id)
) ;_ end-of adarray

(defun init-array ()
  (setq	blks (vla-get-blocks *thisdrawing*)
	num  (vla-get-Count blks)
	*blknames* nil
	i 1
  ) ;_ end of setq
  (repeat (- num 2)
    (setq blk	   (vla-item blks (setq i (1+ i)))
	  bname	   (vla-get-Name blk)
	  *blknames* (append *blknames* (list bname))
    ) ;_ end of setq
  ) ;_ end of repeat
  (if *blknames*
    (progn
      (start_list "bname")
      (mapcar 'add_list *blknames*)
      (end_list)
    ) ;_ end of progn
  ) ;_ end of if
  (if bnameindex
    (set_tile "bname" (itoa bnameindex))
  ) ;_ end of if
  (if *rowdist*
    (set_tile "row" (rtos *rowdist*))
    (set_tile "row" "2")
  ) ;_ end of if
  (if *coldist*
    (set_tile "col" (rtos *coldist*))
    (set_tile "col" "2")
  ) ;_ end of if
) ;_ end of init-array

(defun get-adarray-data ()
  (setq bnameindex (atoi (get_tile "bname")))
  (setq *bname* (nth bnameindex *blknames*)) 
  (setq *rowdist* (atoi (get_tile "row")))
  (setq *coldist* (atoi (get_tile "col")))
) ;_ end-of get-tool-data

(defun do-array ()
  (setq lyr "arr-hatch")
  (vl-cmdf "Layer" "M" lyr "C" "green" "" "")
  (vl-cmdf "-Hatch" *point0* "P" "U" "0.0" *rowdist* "N" "")
  (vl-cmdf "Explode" (entlast))
  (setq	ss     (ssget "X"
		      (list '(0 . "LINE")
			    (cons 8 lyr)
		      ) ;_ end of list
	       ) ;_ end of ssget
	num    (sslength ss)
	i      -1
  ) ;_ end of setq
  (rsetv "CLAYER")
  (repeat num
    (setq en (ssname ss (setq i (1+ i))))
    (vl-cmdf "Measure" en "B" *bname* "Y" *coldist*)
    (entdel en)
  ) ;_ end of repeat
) ;_ end of do-array

(defun c:ad ()
  (setting)
  (adarray)
  (resetting)
  (princ)
) ;_ end of c:ad

(prompt "\nCopyright (c) 2007, Tony Hotchkiss")
(prompt "\nEnter AD to start")

adarray cant use in my cad. it show

adarray.LSP adarray.DCL

[exceed]

make point with this

then use point to block lisp routine.

like this

(defun c:pt2blk (/ ss i pt ptlist blk blkent delss dellist ) 
  (princ "\n select points : ")
  (setq ss (ssget '((0 . "point"))))
  (princ "\n select a block : ")
  (setq blk (car (entsel)))
  (repeat (setq i (sslength ss)) 
    (setq pt (list (cdr (assoc 10 (entget (ssname ss (setq i (1- i))))))))
    (setq ptlist (append ptlist pt))
  )
  (while (/= "INSERT" (cdr (assoc 0 (entget blk)))) 
    (prompt "\n this is not a block. retry.")
    (setq blk (car (entsel "\n select a block : ")))
  )
  (setq blkent (entget blk))
  (foreach x ptlist 
    (entmake (subst (cons 10 x) (assoc 10 blkent) blkent))
  )
  (entdel blk)
  (repeat (setq n (sslength ss)) 
    (setq delss (list (ssname ss (setq n (1- n)))))
    (setq dellist (append dellist delss))
  )
  (foreach x dellist 
    (entdel x)
  )
  (princ)
)