TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => XDRX-API => Topic started by: xdcad on April 16, 2024, 09:23:18 AM
-
https://www.cadtutor.net/forum/topic/77056-i-can-not-calculate-the-area-of-this-hatch
(http://www.theswamp.org/index.php?action=dlattach;topic=59461.0;attach=42764;image)
(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)
)