(vl-load-com)
(defun yhzdy-getshzm
       (/ ha-col1 ha-col2 outcir-col1 inner-line re a b c d)
					;色环祖玛函数 (yhzdy-getshzm)
  (progn
    (setq outcir-col1			;外面的线条(通常最外面是圆形的线条)
	   '(
	     (0 . "CIRCLE")
	     (100 . "AcDbEntity")
	     (67 . 0)
	     (410 . "Model")
	     (8 . "0")
             (62 . 1)
	     (100 . "AcDbCircle")
	     (10 0.0 0.0 0.0)
	     (40 . 2.0)
	     (210 0.0 0.0 1.0)
	    )
    )
    (setq inner-line			;里面的线条(通常是矩形框)
	   '(
	     (0 . "CIRCLE")
	     (100 . "AcDbEntity")
	     (67 . 0)
	     (410 . "Model")
	     (8 . "0")
             (62 . 5)
	     (100 . "AcDbCircle")
	     (10 0.0 0.0 0.0)
	     (40 . 1.0)
	     (210 0.0 0.0 1.0)
	    )
    )
  )
  (setq outcir-col1 (entmakex outcir-col1))
  (setq inner-line (entmakex inner-line))
  (setq	ha-col2	(vla-AddHatch
		  (vlax-get-property
		    (vla-get-activedocument (vlax-get-acad-object))
		    (if	(= 1 (getvar 'CVPORT))
		      'Paperspace
		      'Modelspace
		    )
		  )
		  0
		  "SOLID"
		  1
		)
  )
  (vla-AppendOuterLoop
    ha-col2
    (vlax-make-variant
      (vlax-safearray-fill
	(vlax-make-safearray
	  vlax-vbObject
	  (cons 0 0)
	)
	(list (vlax-ename->vla-object inner-line))
      )
    )
  )
  (vla-put-color ha-col2 5)
  (vla-Evaluate ha-col2)
  (setq	ha-col1	(vla-AddHatch
		  (vlax-get-property
		    (vla-get-activedocument (vlax-get-acad-object))
		    (if	(= 1 (getvar 'CVPORT))
		      'Paperspace
		      'Modelspace
		    )
		  )
		  0
		  "SOLID"
		  1
		)
  )
  (vla-AppendOuterLoop
    ha-col1
    (vlax-make-variant
      (vlax-safearray-fill
	(vlax-make-safearray
	  vlax-vbObject
	  (cons 0 0)
	)
	(list (vlax-ename->vla-object outcir-col1)

	)
      )
    )
  )
  (vla-AppendOuterLoop
    ha-col1
    (vlax-make-variant
      (vlax-safearray-fill
	(vlax-make-safearray
	  vlax-vbObject
	  (cons 0 0)
	)
	(list
	  (vlax-ename->vla-object inner-line)
	)
      )
    )
  )
  (vla-put-color ha-col1 1)
  (vla-Evaluate ha-col1)
  (setq	re
	 (list (cons "ha-col1"
		     (entget (setq a (vlax-vla-object->ename ha-col1)))
	       )
	       (cons "ha-col2"
		     (entget (setq b (vlax-vla-object->ename ha-col2)))
	       )
	       (cons "outcir-col1" (entget outcir-col1))
	       (cons "inner-line" (entget inner-line))
	 )
  )
  (mapcar 'entdel (list a b outcir-col1 inner-line))
  re
)