[编程交流] Lisp修改

;; el primer bloque debe estar ya colocado en el punto medio del eje
(defun c:pagbloc2 (/ _padzeros _insblock b dn se d n lnum inc bn xyz d1)
(defun _padzeros ( s l)
        (if (< (strlen s) l) (_padzeros (strcat "0" s) l) s)
    )
(defun _insblock (e ds bnm data i il  / pt p_ang)
        (setq pt (vlax-curve-getpointatdist e ds))
        (setq p_ang (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv se (vlax-curve-getparamatpoint e pt))))
        (setq part (vlax-invoke
                           (vlax-get
                                 (vla-get-ActiveLayout
                                       (vla-get-activedocument
                                             (vlax-get-acad-object)))
                                 'Block)
                           'InsertBlock pt bnm
                           (car data)(cadr data)(caddr data)
                    p_ang))
          (foreach att (vlax-invoke part 'getattributes) (vla-put-textstring att 
        (_padzeros (itoa i) il)))
  )
  (if (and                
        (setq b (car (entsel "\nSelect block")))
        (setq dn (getreal "\n Enter distance :"))
        (setq se (car (entsel "\nSelect path")))
      )
        (progn
          (setq d  (vlax-curve-getdistatparam se (vlax-curve-getendparam se)))
          (setq n  (fix (/ d dn)))
          (setq lnum (strlen (itoa n)) num 1) 
          (setq inc dn)
          (setq bn (cdr (assoc 2 (setq bdata (entget b)))))
          (setq xyz (mapcar '(lambda (s)
                               (cdr (assoc s bdata))) '( 41 42 43 8 10)))
          (setvar 'clayer (cadddr xyz))
          (setq d1 (vlax-curve-getdistatpoint se (vlax-curve-getclosestpointto  se (last xyz))))
          
         (_insblock se (Setq inc (+ inc d1)) bn xyz (setq num (1+ num)) 2)
         
        (repeat (1- n)
          (_insblock se (Setq inc (+ inc dn)) bn xyz (setq num (1+ num)) 2)
          
        )
      )      
    )
  (princ)
)