;;;;(ljx-hatch pt name jd sca) ,绘制边界填充函数
;;;;适用于"Line" "LWPOLYLINE" "CIRCLE" "SPLINE" "REGION" "ELLIPSE" 围成的填充边界
;;;;pt----填充范围内一点,用getpoint函数取得比较方便
;;;;name--填充图案名称如"ANSI31"
;;;;jd----填充图案旋转角度,以度计
;;;;sca---填充图案的比例,实数
;;;;示例:(ljx-hatch (getpoint "\n边界内选一点") "ANSI31" 90 5)
;;;;函数作者: jixiangluo
;;;;最后修改日期2019.11.09
(defun ljx-hatch (pt name jd sca / mspace e hatchobj outlst objlst )
(vl-load-com)
(setq mspace (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
(setq e (bpoly pt))
(vl-cmdf)
(if (not (vlax-ename->vla-object e))
(progn
(bpoly pt)
(vl-cmdf "")
(setq e (entlast))
)
)
(setq objlst (list (vlax-ename->vla-object e))
hatchobj (vla-AddHatch mspace 0 name :vlax-true)
outlst (vlax-make-safearray vlax-vbobject (cons 0 (1- (length objlst))))
)
(vlax-safearray-fill outlst objlst)
(vla-appendouterloop hatchobj outlst)
(vla-evaluate hatchobj)
(vla-put-PatternScale hatchobj sca);;图案比例
(vla-put-PatternAngle hatchobj (* jd (/ pi 180.0)));;图案旋转角度
(vla-delete (vlax-ename->vla-object e))
)