autocad计算带岛图形的面积

;;;岛的判断
(defun getisland (/     en    mplaer ss     ss_len ii        en
          key     obj    area   ptext  een    area0  pt0
         )
  (vl-load-com)
  (setq en (car (entsel)))
  (setq layer (assoc 8 (entget en)))
  (setq key (emt_eedvalue en "landuse" "id3"))
  (setq obj (vlax-ename->vla-object en))
  (setq area (vla-get-area obj))
  (setq    ss (ssget "c"
          (list (nth 0 ptext) (nth 1 ptext))
          (list (nth 2 ptext) (nth 3 ptext))
          (list (cons 0 "*polyline") (cons 8 layer))
       )
  )
  (if ss
    (setq ss (ssdel en ss))
  )
  (if ss
    (setq ss_len (sslength ss)
      ii     0
    )
    (setq ss_len 0
      ii 0
    )
  )
  (while (< ii ss_len)
    (setq een (ssname ss ii))
    (setq obj (vlax-ename->vla-object een))
    (setq area0 (vla-get-area obj))
    (setq pt0 (emt_labelpofpolygon een))
    (if    (and (emt_pointinpoly en pt0)
         (> (- area area0) 0.01)
         (= (emt_eedvalue een code id) key)
    )
      (progn
    (setq s1 (cons een s1))
      )
    )
    (setq ii (1+ ii))
  )
  s1
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun myarea (en    /     endata      layer       en_pt    ytm
           area    ptext     ptmin      ptmax       lar_s
           enext_larpoly     en1      area1       ytm1        ptext1
           ptmin1    ptmax1     lar_s1      lars1_len        en2
           area2    ytm2
          )
  (setq rearea 0)
  (setq endata (entget en))
  (setq layer (cdr (assoc 8 endata)))
  (setq en_pt (cdr (assoc 10 endata)))
  (setq ytm (emt_eedvalue en "landuse" "id3"))
  (setq area (vla-get-area (vlax-ename->vla-object en)))
  (setq rearea area)
  (setq ptext (emt_getextent en))
  (setq    ptmin (list (nth 0 ptext) (nth 1 ptext))
    ptmax (list (nth 2 ptext) (nth 3 ptext))
  )
;;;  得到该图元包含的,被包含的,相碰的多边形的选择集(不包含该图元).
  (setq    lar_s (ssget "c"
             ptmin
             ptmax
             (list (cons 8 layer) (cons 0 "*polyline"))
          )
  )
  (command "undo" "m")
  (command "erase" en "")
  (setq enext_larpoly (emt_getpoly layer en_pt))
  (command "undo" "b")
  (if (and enext_larpoly
       (not (equal enext_larpoly en))
       (emt_pointinpoly enext_larpoly (emt_labelpofpolygon en))
      )
    (progn
      (ssadd enext_larpoly lar_s)
      (setq island_to T)
    )
    (setq island_to nil)
  )
  (ssdel en lar_s)
  (if lar_s
    (setq lars_len (sslength lar_s)
      lars_i   0
    )
    (setq lars_len 0
      lars_i 0
    )
  )
  (setq island_own nil)
;;;  计算面积.
;;;  该实体为岛,面积直接为图形面积,否则计算含岛的面积.
  (while (< lars_i lars_len)
    (setq en1 (ssname lar_s lars_i))
    (setq area1 (vla-get-area (vlax-ename->vla-object en1)))
    (setq ytm1 (emt_eedvalue en1 "landuse" "id3"))
    (if    (and (< area1 area)
         (= ytm1 ytm)
         (emt_pointinpoly en (emt_labelpofpolygon en1))
    )
      (progn
    (setq rearea (- rearea area1))
    (setq island_own T)
    (setq ptext1 (emt_getextent en1))
    (setq ptmin1 (list (nth 0 ptext1) (nth 1 ptext1))
          ptmax1 (list (nth 2 ptext1) (nth 3 ptext1))
    )
    (setq lar_s1 (ssget "c"
                ptmin1
                ptmax1
                (list (cons 8 layer) (cons 0 "*polyline"))
             )
    )
    (ssdel en1 lar_s1)
    (if lar_s1
      (setq    lars1_len (sslength lar_s1)
        lars_i1      0
      )
      (setq    lars1_len 0
        lars_i1    0
      )
    )
    (while (< lars_i1 lars1_len)
      (setq en2 (ssname lar_s1 lars_i1))
      (setq area2 (vla-get-area (vlax-ename->vla-object en2)))
      (setq ytm2 (emt_eedvalue en2 "landuse" "id3"))
      (if (and (< area2 area1)
           (= ytm2 ytm1)
           (emt_pointinpoly en1 (emt_labelpofpolygon en2))
          )
        (progn
          (setq rearea (+ rearea area2))
        )
      )
      (setq lars_i1 (1+ lars_i1))
    )
      )
    )
    (setq lars_i (1+ lars_i))
  )
  rearea
  island_to
  island_own
)