AutoLisp : Program pichetare drum cu blocuri la distante picheti

(defun pp_enblock_bsps(/ os ce bm blk ent obj ppt dst ept ref len ipt par slp ang loopw nop mov rol ror)   (command "_.undo" "_be") (setq     os (getvar "osmode")     ce (getvar "cmdecho")     bm (getvar "blipmode")     blk "") (setvar "osmode" 0) (setvar "cmdecho" 0) (setvar "blipmode" 0) (progn (setq
     ent nil) (while (=  ent nil) (setq     ent (entsel "\nSelect polyline near reference end:")))) (progn (setq
     loopW 1) (while (<  loopW 100) (setq     mov (entsel "\nSelect BlockN:")     rol (if (/= mov nil) (assoc 2 (entget (car mov))) nil)
     ror (if rol (cdr rol) nil)     blk (if (and (=  (type ror) (quote STR)) (>  ror "")) ror (getstring T "\nBlock name:(enter.loopw) "))     loopw (if (and (>  blk "") (tblsearch "block" blk)) 100 32)))) (progn (setq
     loopW 1) (while (>  loopw 0) (progn (setq     obj (car ent)
     ppt (if obj (osnap (cadr ent) "NEA") nil)
     dst (if ppt (getdist "\nDistance to Block Insertion:") nil)
     ept (if dst (vlax-curve-getendpoint obj) nil)
     ref (if ept (vlax-curve-getdistatpoint obj ppt) nil)
     len (if ref (vlax-curve-getdistatpoint obj ept) (- 3))
     dst (if (and  (>  len 0) (>  ref (/ len 2.0))) (- len dst) dst)
     ipt (if (>  len 0) (vlax-curve-getpointatdist obj dst) nil)
     par (if (>  len 0) (vlax-curve-getparamatpoint obj ipt) nil)
     slp (if par (vlax-curve-getfirstderiv obj par) nil)
     ang (if par (atan (/ (cadr slp) (car slp))) nil)) (if ang (entmake (list (cons 0 "INSERT") (cons 2 blk) (cons 10 ipt) (cons 50 ang)))) (terpri) (setq
     loopw (if (and obj dst ept ipt) 3 (- 5010)))))) $rr)