Keep the blocks on the polyline and delete other blocks within the tolerance on both sides of the line
issue:
https://www.cadtutor.net/forum/topic/78798-selection-of-blocks-that-have-their-point-of-origin-in-a-polygon-avoiding-other-blocks-with-the-same-name-but-that-still-overlap-a-little-in-the-polygon/#comment-625827Colleagues, best regards. Today I come to ask for help. I have developed a routine that splits a polygon based on the location of the origin of the blocks above it; However, the selection takes into account other blocks that overlap only slightly in the polygon, allowing me to run the routine anyway but with an undesired result.
I can remove the blocks manually, but when there are too many it becomes very tedious and time-consuming. I want to know if there is a way to avoid these external blocks that alter the results of my routine.
In the attached dwg I present 2 cases, in the one on the right the routine works without problems, however in the one on the left the complication occurs with the blocks external to the polygon but that still overlap a little.
Another complication that arises is when the polygon presents an arc.
=============================================
(defun c:xdtb_pl_tolerase (/ E typ blkname ss fence-box plane)
(xd::doc:getdouble
(xdrx-string-multilanguage
"\n搜索范围"
"\nSearch range tolerance"
)
"#xd-var-global-search-tol"
(xd::doc:getpickboxheight)
)
(xd::doc:getdouble
(xdrx-string-multilanguage
"\n点线容差精度"
"Point and line tolerance"
)
"#xd-var-global-tol-dist"
(xdrx-getvar "equalpoint")
)
(if (and (setq e (car (xdrx-entsel
(xdrx-string-multilanguage
"\n拾取特征图元类型<退出>:"
"\nPick feature entity type<Exit>:"
)
)
)
)
(setq typ (assoc 0 (entget e))
blkname (xdrx-getpropertyvalue e "name")
)
(setq ss (xdrx-ssget
(xdrx-string-multilanguage
"\n选择多段线<退出>:"
"\nSelect Polyline<Exit>:"
)
'((0 . "*polyline"))
)
)
)
(progn
(xdrx-begin)
(mapcar
'(lambda (x)
(if (and (setq fence-box (xdrx-getpropertyvalue
x
"tofence"
#xd-var-global-search-tol
1
)
)
(setq fence-box (xdrx-getsamplept fence-box))
(setq
ss1 (ssget "cp"
fence-box
(list typ)
)
ss2 (ssget "f" (xdrx-getsamplept x) (list typ))
)
)
(progn
(setq nums 0
plane (xdrx-getpropertyvalue x "plane" t)
)
(mapcar '(lambda (y)
(setq position (xdrx-getpropertyvalue
y
"position"
)
closest (xdrx-getpropertyvalue
x
"getclosestpointto"
position
)
position (xdrx-point-orthoproject position plane)
closest (xdrx-point-orthoproject closest plane)
)
(if (not (equal closest position #xd-var-global-tol-dist))
(progn
(setq nums (1+ nums))
(xdrx-entity-delete y)
)
)
)
(xdrx-ss->ents ss1)
)
(xdrx-prompt
(xdrx-string-formatex
(xdrx-string-multilanguage
"\n共删除了 %d 个容差范围内的不在多段线线上的图块."
"\nA total of %d tiles matching the feature criteria were deleted."
)
nums
)
)
)
)
)
(xdrx-ss->ents ss)
)
(xdrx-end)
)
)
(princ)
)
Recent Posts
