[编程交流] Autocad lisp需要帮助！

;; Polygonal Wipeout  -  Lee Mac                                              ;
;; Creates an n-sided Polygonal Wipeout with the given center (UCS) & radius  ;
;;                                                                            ;
;; Modified by ymg                                                            ;
(defun pwipeout ( cen rad n / ang inc lst )
   (setq inc (/ pi n 0.5)
         ang (* (/ pi 2) -1)
   )
   (repeat n
       (setq lst (cons (list 14 (* 0.5 (cos ang)) (* 0.5 (sin ang))) lst)
             ang (+ ang inc)
       )
   )
   (entmakex
       (append
           (list
               (cons 0 "WIPEOUT")
               (cons 100 "AcDbEntity")
               (cons 100 "AcDbWipeout")
               (cons 10 (trans (mapcar '- cen (list rad rad)) 1 0))
               (cons 11 (trans (list (+ rad rad) 0.0) 1 0 t))
               (cons 12 (trans (list 0.0 (+ rad rad)) 1 0 t))
               (cons 280 1)
               (cons 71 2)
        (cons 91 (1+ (length lst)))
           )
           (cons (last lst) lst)
       )
   )
)
;;; listpol (gile)                                                            ;
;;; Returns the vertices list of any type of polyline (WCS coordinates)       ;
;;;                                                                           ;
;;; Argument                                                                  ;
;;; pl : a polyline (ename or vla-object)                                     ;
(defun listpol        (pl / pa pt lst)
 (vl-load-com)
 (setq        pa (if (vlax-curve-IsClosed pl)
      (vlax-curve-getEndParam pl)
      (1+ (vlax-curve-getEndParam pl))
   )
 )
 (while (setq pt (vlax-curve-getPointAtParam pl (setq pa (1- pa))))
   (setq lst (cons (trans pt 0 1 ) lst))
 )
)
;; By Jason Piercey                                              ;
;; Returns t if wipeouts frames are turned off                   ;
(defun frameOff? ()
  (and
     (setq Data (dictsearch (namedobjdict) "ACAD_WIPEOUT_VARS"))
     (zerop (cdr (assoc 70 Data)))
  )
)
(defun c:test ()
    ; Initializing wipeouts                     ;
    (vl-cmdf "_WIPEOUT" '(0 0) '(5 5) '(8  "")
    (if (not (frameoff?)) (c:tframes))
    (entdel (entlast))
      
    (princ "\nSelect a Polyline: ")
    (setq en (entsel))
    (while  (not (wcmatch (cdr (assoc 0 (entget (car en)))) "*POLYLINE"))
  (princ "\nThe entity selected must be a POLYLINE ...")
  (setq en (entsel))
    )
    (setq ent (car en)
    pl (listpol ent)
    )
    (foreach p pl
       (pwipeout p 0.5 30)
       (vl-cmdf "_POINT" p)
    )
)