Topic: [XDrX-PlugIn(145)] Fixed Hatch with area 0

[xdcad]

https://www.cadtutor.net/forum/topic/77056-i-can-not-calculate-the-area-of-this-hatch

Code: [Select]

(defun c:xdtb_hafix0 (/ ha ha1 ha-new has loop loops mp old-boundary progress re ss x)
  (defun _delete-old-boundary (loops)
    (mapcar
      '(lambda (loop)
(if (and
       (setq ss (ssget "f" (xdrx-getpropertyvalue loop "vertices") '((0 . "*line,arc,ellipse,circle"))))
       (ssdel loop ss)
       (> (sslength ss) 0)
     )
   (progn
     (mapcar
       '(lambda (x)
  (setq re (xdrx-geom-relation loop x t))
  (if (or
(= re XD:kTangent)
(= re XD:kBoundary)
(= re XD:kCoincident)
      )
    (xdrx-entity-delete x)
  )
)
       (xdrx-ss->ents ss)
     )
   )
)
       )
      loops
    )
  )
  (if (and
(setq ha (xdrx-ssget (xdrx-string-multilanguage "\n选择填充对象<退出>:" "\nSelect Hatch<Exit>:") '
     ((0 . "hatch"))
)
)
(setq has (xdrx_hatch_get0area ha))
      )
    (progn
      (xdrx-begin)
      (xdrx-sysvar-push '("fitarc" 0))
      (xdrx-document-safezoom ha)
      (xdrx_statusbar_begin (xdrx-string-multilanguage "处理中..." "Procesing...") (length has))
      (setq progress 0)
      (mapcar
'(lambda (x)
   (xdrx_statusbar_setpos (setq progress (1+ progress)))
   (if (setq mp (xdrx-hatch->mpolygon x))
     (progn
       (setq ha1 (xdrx-mpolygon->hatch mp))
       (xdrx-entity-matchprop x ha1)
       (setq ha x
     ha-new (car (xdrx-ss-getsub ha1 '((0 . "hatch"))))
     loops (xdrx-getpropertyvalue ha-new "assocobjids")
       )
       (if (setq old-boundary (xdrx-getpropertyvalue x "assocobjids"))
(progn
   (xdrx-entity-delete old-boundary)
)
(progn
   (_delete-old-boundary loops)
)
       )
       (xdrx-object-swapid ha ha-new)
       (xdrx-entity-delete ha-new)
     )
   )
)
has
      )
      (xdrx_statusbar_end)
      (xdrx-prompt (xdrx-string-formatex (xdrx-string-multilanguage "\n修复了 %d 个面积为0的填充."
    "\nFixed %d Hatchs with area 0."
) (length has)
   )
      )
      (xdrx-sysvar-pop)
      (xdrx-end)
    )
  )
  (princ)
)