[编程交流] 图案填充以遵循曲线路径

(vl-load-com)
(defun c:hatchbetween2curves ( / msp clay hpn hps ss1 ss2 c1 c2 n stpar enpar ln lnstr k par parr p1 p2 p11 p22 phor anh hdata lin ch z ssz )
 (setq msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
 (setq clay (getvar 'clayer))
 (prompt (strcat "\nType HPNAME variable <" (getvar 'hpname) "> : "))
 (setq hpn (getstring))
 (if (not (eq hpn "")) (setvar 'hpname hpn))
 (prompt (strcat "\nType HPSCALE variable <" (rtos (getvar 'hpscale)) "> : "))
 (initget 6)
 (setq hps (getreal))
 (if (not (null hps)) (setvar 'hpscale hps))
 (prompt "\nPick first curve")
 (while (not ss1)
   (setq ss1 (ssget "_+.:E:S:L" '((0 . "*LINE,RAY,XLINE,CIRCLE,ELLIPSE,ARC"))))
 )
 (prompt "\nPick second curve")
 (while (not ss2)
   (setq ss2 (ssget "_+.:E:S:L" '((0 . "*LINE,RAY,XLINE,CIRCLE,ELLIPSE,ARC"))))
 )
 (setq c1 (ssname ss1 0))
 (setq c2 (ssname ss2 0))
 (initget 6)
 (setq n (cond ((getint "\nType number of spaces-segments between 2 curves <25> : "))
               ( 25 )
         )
 )
 (setq stpar (vlax-curve-getstartparam c1))
 (setq enpar (vlax-curve-getendparam c1))
 (setq ln -1)
 (while (tblsearch "LAYER" (setq lnstr (itoa (setq ln (1+ ln))))))
 (setq lnstr (itoa ln))
 (vl-cmdf "_.-layer" "m" lnstr "")
 (setvar 'clayer clay)
 (setq k -1)
 (repeat (+ n 1)
   (setq par (+ stpar (* (/ (- enpar stpar) (float n)) (float (setq k (1+ k))))))
   (setq p1 (vlax-curve-getpointatparam c1 par))
   (setq p2 (vlax-curve-getclosestpointto c2 p1))
   (if (/= k n)
     (progn
       (setq parr (+ stpar (* (/ (- enpar stpar) (float n)) (float (+ k 0.5)))))
       (setq p11 (vlax-curve-getpointatparam c1 parr))
       (setq p22 (vlax-curve-getclosestpointto c2 p11))
       (setq phor (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p11 p22))
       (setq anh (cvunit (angle p11 p22) "radians" "degrees"))
       (setq hdata (cons (cons anh phor) hdata))
     )
   )
   (setq lin (vla-addline msp (vlax-3d-point p1) (vlax-3d-point p2)))
   (vla-put-layer lin lnstr)
 )
 (foreach h hdata
   (vl-cmdf "_.-hatch" "p" "" "" (car h) "o" "s" (cdr h) "" (cdr h) "")
 )
 (prompt (strcat "\nDo you want to <E>rase or <L>eave lines on new layer "" lnstr "" : "))
 (initget 1 "Erase Leave")
 (setq ch (getkword))
 (if (eq ch "Erase") 
   (repeat (setq z (sslength (setq ssz (ssget "_X" (list '(0 . "LINE") (cons 8 lnstr))))))
     (entdel (ssname ssz (setq z (1- z))))
   )
 )
 (vl-cmdf "_.-purge" "LA" "" "n")
 (princ)
)
(defun c:hb2c nil (c:hatchbetween2curves))
(prompt "\nShortcut for c:hatchbetween2curves is c:hb2c")
(princ)

Select face of solid:
Error while acquiring Face!