Topic: block bottom WIPEOUT (or solid hatch)

[domenicomaria]

I need to add a wipeout or a solid hatch to the bottom of a block.

And I want to automate this process.

And it's not difficult.

But the problem is that frequenly some errors happen.

Many times it does not work, because the entities that define the boundaries of the block, many times do not touch each other precisely. . . there are holes. . .

Any ideas to solve this problem?


ciao

[ronjonp]

Create the boundary in step 2 using hatch with internal point then (HATCHGENERATEBOUNDARY).

[domenicomaria]

I did not know the existence of the "HATCH GENERATE BOUNDARY" command
which is very useful.

I have tried using it and it seems to solve a lot of problems.
Thanks a lot for your reply.

d2010, as you can see, it is possible to give intelligent and useful answers and share one's knowledge and experiences.

[BIGAL]

Like Ronjonp another way is draw a rough pline around block, then do bpoly pick inside it will make inner and outer plines, erase outer.

[domenicomaria]

But the problem is that frequenly some errors happen.

Many times it does not work, because the entities that define the boundaries of the block,
(which is not the little man you drew)
do not touch each other precisely. . . because there are little holes. . .
. . .
however if I use HATCHGENERATEBOUNDARY I get better results
. . .

what would be needed is a command that
closes all the holes in the boundary of a block . . .
. . . and it is not easy even to imagine. . .

[roy_043]

Maybe experiment with the HPGAPTOL setting?

[Marc'Antonio Alessi]

Code: [Select]

;;-----------------------=={ Outline Objects  }==-----------------------;;
;;                                                                      ;;
;;  This program enables the user to generate one or more closed        ;;
;;  polylines or regions outlining all objects in a selection.          ;;
;;                                                                      ;;
;;  Following a valid selection, the program calculates the overall     ;;
;;  rectangular extents of all selected objects and constructs a        ;;
;;  temporary rectangular polyline offset outside of such extents.      ;;
;;                                                                      ;;
;;  Using a point located within the offset margin between the extents  ;;
;;  of the selection and temporary rectangular frame, the program then  ;;
;;  leverages the standard AutoCAD BOUNDARY command to construct        ;;
;;  polylines and/or regions surrounding all 'islands' within the       ;;
;;  temporary bounding frame.                                           ;;
;;                                                                      ;;
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright © 2014  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.0    -    2014-11-30                                      ;;
;;                                                                      ;;
;;  - First release.                                                    ;;
;;----------------------------------------------------------------------;;
;;  Version 1.1    -    2016-01-23                                      ;;
;;                                                                      ;;
;;  - Added option to erase original objects.                           ;;
;;----------------------------------------------------------------------;;

[domenicomaria]

Code: [Select]

;;-----------------------=={ Outline Objects  }==-----------------------;;
;;                                                                      ;;
;;  This program enables the user to generate one or more closed        ;;
;;  polylines or regions outlining all objects in a selection.          ;;
;;                                                                      ;;
;;  Following a valid selection, the program calculates the overall     ;;
;;  rectangular extents of all selected objects and constructs a        ;;
;;  temporary rectangular polyline offset outside of such extents.      ;;
;;                                                                      ;;
;;  Using a point located within the offset margin between the extents  ;;
;;  of the selection and temporary rectangular frame, the program then  ;;
;;  leverages the standard AutoCAD BOUNDARY command to construct        ;;
;;  polylines and/or regions surrounding all 'islands' within the       ;;
;;  temporary bounding frame.                                           ;;
;;                                                                      ;;
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright © 2014  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.0    -    2014-11-30                                      ;;
;;                                                                      ;;
;;  - First release.                                                    ;;
;;----------------------------------------------------------------------;;
;;  Version 1.1    -    2016-01-23                                      ;;
;;                                                                      ;;
;;  - Added option to erase original objects.                           ;;
;;----------------------------------------------------------------------;;

Marco,
the LEE MAC code is useful and interesting (as always)
but the problem is much more complex. . .
. . .
think also to the blocks that have
empty areas, holes inside them . . .
. . .
I am not sure,
but maybe, the code of Lee Mac,
reduces the problem of the external holes
on the contour of the objects
. . .
when entities that define the boundaries of the block,
do not touch each other precisely . . .
. . .

however, everything you are telling me
helps.

ciao

[Marc'Antonio Alessi]

<clip>. . .
when entities that define the boundaries of the block,
do not touch each other precisely . . .
. . .
<clip>

For this problem I do not see other solution than to adjust the outline, see:
>>> The progam is configured to use the JOIN option of the PEDIT command with a zero fuzz distance, however, this may be easily altered if necessary.

Code: [Select]

;; Polyline Join  -  Lee Mac
;; Attempts to join all lines, arcs and polylines in a selection.
edit: 20210324 Lee code removed - see http://www.lee-mac.com/ for the code (sorry)



[domenicomaria]

For this problem I do not see other solution than to adjust the outline, see:
The progam is configured to use the JOIN option of the PEDIT command
with a zero fuzz distance, however,
this may be easily altered if necessary.

Marco,
I already know this Lee Mac routine. . .

And it might help. . .

Thank you

[domenicomaria]

Create the boundary in step 2 using hatch with internal point then (HATCHGENERATEBOUNDARY).

Maybe experiment with the HPGAPTOL setting?

I have taken into account the suggestions you have given me
and for now the result is this.

HATCHGENERATEBOUNDARY
and HPGAPTOL
are very USEFUL !

[Marc'Antonio Alessi]

Please post a piece of code... and HPGAPTOL settings… thanks.

[domenicomaria]

Please post a piece of code... and HPGAPTOL settings… thanks.

I am still making everything manually . . .

But however, with your suggestion,
every thing is more easy,
and works better !

I will try to write the code
and I will post it completely.

[ronjonp]

Why do you create a quad of boundaries? This took me a minute to hatch using a single rectangle around the car.

[domenicomaria]

Why do you create a quad of boundaries? This took me a minute to hatch using a single rectangle around the car.

I did this, because I noticed that sometimes,
the "bhatch" command works better if the area to be filled
is divided into several parts.
(. . . maybe because it is more easy to calculate the boundary . . .)

If you have a perfect shape, there is no problem.

While, if there are points where the lines, the polylines, the arcs, the splines . . . of the contour
do not touch each other, perfectly,
then the pattern enters the shape . . .

[domenicomaria]

Why do you create a quad of boundaries? This took me a minute to hatch using a single rectangle around the car.

look at the attachments

[domenicomaria]

another thing that might be useful is
to zoom in,
on the outer rectangle,
before to pick bhatch points

[danAllen]

I typically use BPOLY instead of bhatch to do this

[ronjonp]

I typically use BPOLY instead of bhatch to do this

One advantage of hatch is you can up the HPGAPTOL number to fill in any imperfections which the OP was having issues with.

[domenicomaria]

https://drive.google.com/file/d/177urbYaXsFQL_zSuELpzA3p5lnlkbXlv/view?usp=sharing

Code - Auto/Visual Lisp: [Select]

1. (defun MID ( a b )      (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) a b)        )       ;       Lee Mac
2.  
3. (defun :ENTER_TO_CONTINUE () (getstring "\nenter to continue :"))
4.  
5. ;; Entnext to End  -  Lee Mac
6. ;; Returns a list of all primary entities after a given entity in the drawing database
7. (defun LM:ENTNEXTTOEND ( ent / tmp )
8.    (if (setq tmp (entnext ent))
9.        (if (member (cdr (assoc 0 (entget ent))) '("ATTRIB" "VERTEX" "SEQEND"))
10.            (LM:entnexttoend tmp)
11.            (cons tmp (LM:entnexttoend tmp))
12.        )
13.    )
14. )
15.  
16. ;; Entlast  -  Lee Mac
17. ;; Returns the last entity in the drawing database after a given entity
18. (defun LM:ENTLAST ( ent / tmp )
19.    (if (setq tmp (entnext ent)) (LM:entlast tmp) ent)
20. )
21.  
22.  
23.  
24. (defun LM:ssget ( msg arg / sel )
25.     (princ msg)
26.     (setvar 'nomutt 1)
27.     (setq sel (vl-catch-all-apply 'ssget arg))
28.     (setvar 'nomutt 0)
29.     (if (not (vl-catch-all-error-p sel)) sel)
30. )
31.  
32. ;; Block Reference Bounding Box  -  Lee Mac
33. ;; Returns a WCS point list describing a rectangular frame bounding all geometry of a supplied block reference.
34. ;; Excludes Text, MText & Attribute Definitions.
35. ;; ref - [vla] Block Reference Object
36.  
37. (defun LM:blockreferenceboundingbox     (ref)
38.         (
39.          (lambda        (lst)
40.                  (apply
41.                          (function
42.                                  (lambda        (m v)
43.                                          (mapcar (function (lambda (p) (mapcar '+ (mxv m p) v))) lst)
44.                                  )
45.                          )
46.                          (refgeom (vlax-vla-object->ename ref))
47.                  )
48.          )
49.                 (LM:blockdefinitionboundingbox
50.                         (vla-item
51.                                 (vla-get-blocks (vla-get-document ref))
52.                                 (vla-get-name ref)
53.                         )
54.                 )
55.         )
56. )
57.  
58. ;; Block Definition Bounding Box  -  Lee Mac
59. ;; Returns a WCS point list describing a rectangular frame bounding all geometry of a supplied block definition.
60. ;; Excludes Text, MText & Attribute Definitions.
61. ;; def - [vla] Block Definition Object
62.  
63. (defun LM:blockdefinitionboundingbox (def / llp lst urp)
64.         (vlax-for obj def
65.                 (cond
66.                         ((= :vlax-false (vla-get-visible obj)))
67.                         ((= "AcDbBlockReference" (vla-get-objectname obj))
68.                          (setq lst (append lst (LM:blockreferenceboundingbox obj)))
69.                         )
70.                         ((and   (not (wcmatch (vla-get-objectname obj)
71.                                                                           "AcDbAttributeDefinition,AcDb*Text"
72.                                                   )
73.                                         )
74.                                         (vlax-method-applicable-p obj 'getboundingbox)
75.                                         (not (vl-catch-all-error-p
76.                                                           (vl-catch-all-apply
77.                                                                   'vla-getboundingbox
78.                                                                   (list obj 'llp 'urp)
79.                                                           )
80.                                                   )
81.                                         )
82.                          )
83.                          (setq lst (vl-list*    (vlax-safearray->list llp)
84.                                                                                 (vlax-safearray->list urp)
85.                                                                                 lst
86.                                                   )
87.                          )
88.                         )
89.                 )
90.         )
91.         (LM:points->boundingbox lst)
92. )
93.  
94. ;; Point to Bounding Box  -  Lee Mac
95. ;; Returns the rectangular extents of a supplied point list
96.  
97. (defun LM:points->boundingbox   (lst)
98.         ((lambda        (l)
99.                  (mapcar        '(lambda (a) (mapcar '(lambda (b) ((eval b) l)) a))
100.                                         '(
101.                                           (caar cadar)
102.                                           (caadr cadar)
103.                                           (caadr cadadr)
104.                                           (caar cadadr)
105.                                          )
106.                  )
107.          )
108.                 (mapcar '(lambda (f) (apply 'mapcar (cons f lst)))
109.                                   '(min max)
110.                 )
111.         )
112. )
113.  
114. ;; RefGeom (gile)
115. ;; Returns a list which first item is a 3x3 transformation matrix (rotation, scales, normal)
116. ;; and second item the object insertion point in its parent (xref, block or space)
117. ;; Argument : an ename
118.  
119. (defun refgeom  (ent / ang ang mat ocs)
120.         (setq   enx (entget ent)
121.                         ang (cdr (assoc 050 enx))
122.                         ocs (cdr (assoc 210 enx))
123.         )
124.         (list
125.                 (setq   mat
126.                                   (mxm
127.                                           (mapcar '(lambda (v) (trans v 0 ocs t))
128.                                                                  '(
129.                                                                         (1.0 0.0 0.0)
130.                                                                         (0.0 1.0 0.0)
131.                                                                         (0.0 0.0 1.0)
132.                                                                   )
133.                                           )
134.                                           (mxm
135.                                                   (list
136.                                                           (list (cos ang) (- (sin ang)) 0.0)
137.                                                           (list (sin ang) (cos ang) 0.0)
138.                                                           '(0.0 0.0 1.0)
139.                                                   )
140.                                                   (list
141.                                                           (list (cdr (assoc 41 enx)) 0.0 0.0)
142.                                                           (list 0.0 (cdr (assoc 42 enx)) 0.0)
143.                                                           (list 0.0 0.0 (cdr (assoc 43 enx)))
144.                                                   )
145.                                           )
146.                                   )
147.                 )
148.                 (mapcar '-
149.                                   (trans (cdr (assoc 10 enx)) ocs 0)
150.                                   (mxv mat
151.                                                  (cdr (assoc 10 (tblsearch "block" (cdr (assoc 2 enx)))))
152.                                   )
153.                 )
154.         )
155. )
156.  
157. ;; Matrix x Vector - Vladimir Nesterovsky
158. ;; Args: m - nxn matrix, v - vector in R^n
159.  
160. (defun mxv (m v)
161.         (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m)
162. )
163.  
164. ;; Matrix Transpose - Doug Wilson
165. ;; Args: m - nxn matrix
166.  
167. (defun trp (m)
168.         (apply 'mapcar (cons 'list m))
169. )
170.  
171. ;; Matrix x Matrix - Vladimir Nesterovsky
172. ;; Args: m,n - nxn matrices
173.  
174. (defun mxm (m n)
175.         ((lambda (a) (mapcar '(lambda (r) (mxv a r)) m)) (trp n))
176. )
177.  
178.  
179.  
180.  
181. ;       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -
182. ;       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -
183. ;       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -
184. (defun C:BOTTOM-HATCH   (       /
185.                                                                         BOUNDARY-SET BOUNDARY-SET-S BR-BB BR-EN BR-ES BR-OBJ DIAGONAL E-BASE E-DX
186.                                                                         E-DY E-HEIGHT E-LL E-LR E-PLINE-V-LIST E-UL E-UR H-EN I I-BASE I-HEIGHT I-LL
187.                                                                         I-LR I-UL I-UR IND INT-LST J LL-BASE-PP N-X-DIV N-Y-DIV NEW-EN-LST OFFSET PI/4
188.                                                                         PICK-POINT-LIST PPL PT SS-TO-ERASE X-E-LL-O X-ENTLAST X-INT-LST X-LOWER-PP-LST
189.                                                                         X-LOWER-PT-LST X-UPPER-PP-LST X-UPPER-PT-LST Y-E-LL-O Y-INT-LST Y-LEFT-PP-LST Y-LEFT-PT-LST
190.                                                                         Y-RIGHT-PP-LST Y-RIGHT-PT-LST
191.                                                                 )
192.         ;               the insert must have ROTATION ANGLE = 0.0      
193.         ;               and CANNOT CONTAIN HATCHS and SPLINES                  
194.         (if(and
195.                         (setq br-es                     (entsel "\nselect the block to fill on the bottom :") )
196.                         (setq br-en                     (car br-es) )
197.                         (setq br-obj                    (vlax-ename->vla-object br-en ) )
198.                         (setq br-bb                     (LM:BLOCKREFERENCEBOUNDINGBOX br-obj ) )
199.                         (setq i-ll                              (nth 0 br-bb)
200.                                         i-lr                            (nth 1 br-bb)
201.                                         i-ur                            (nth 2 br-bb)
202.                                         i-ul                            (nth 3 br-bb)
203.                                         i-height                        (distance i-lr i-ur)
204.                                         i-base                  (distance i-ll i-lr)
205.                                         offset                  (/ i-height 20.0)                      
206.                                         diagonal                        (* offset (sqrt 2.0) )
207.                                         pi/4                            (/ pi 4.0)
208.                                         e-ll                            (polar i-ll (* pi/4 5.0) diagonal)
209.                                         e-lr                            (polar i-lr (* pi/4 7.0) diagonal)
210.                                         e-ur                            (polar i-ur (* pi/4 1.0) diagonal)
211.                                         e-ul                            (polar i-ul (* pi/4 3.0) diagonal)
212.                                         e-height                        (distance e-lr e-ur)
213.                                         e-base                  (distance e-ll e-lr)
214.                                         int-lst                 '(20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1)
215.                                         ;       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -
216.                                         n-y-div                 6.0
217.                                         y-int-lst               (reverse (member (fix (- n-y-div 1 ) ) int-lst  ) )
218.                                         e-dy                            (/ e-height n-y-div)
219.                                         y-e-ll-o                        (polar e-ll pi offset)
220.                                         y-left-pt-lst   (mapcar '(lambda (i) (polar y-e-ll-o (* pi/4 2.0) (* e-dy (float i) ) ) ) y-int-lst )  
221.                                         y-right-pt-lst (mapcar '(lambda (i) (polar i 0.0 (+ e-base offset offset ) ) ) y-left-pt-lst )
222.  
223.                                         ;       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -
224.                                         n-x-div                 6.0
225.                                         x-int-lst               (reverse (member (fix (- n-x-div 1 ) ) int-lst  ) )
226.                                         e-dx                            (/ e-base n-x-div)
227.                                         x-e-ll-o                        (polar e-ll (* pi/4 6.0) offset)
228.                                         x-lower-pt-lst (mapcar '(lambda (i) (polar x-e-ll-o  0.0 (* e-dx (float i) ) ) ) x-int-lst )   
229.                                         x-upper-pt-lst (mapcar '(lambda (i) (polar i (* pi/4 2.0) (+ e-height offset offset ) ) ) x-lower-pt-lst )
230.  
231.                                         ;       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -
232.                                         ll-base-pp              (polar e-ll (* pi/4 6.0) (+ (/ e-dy 2.0) ) )
233.                                         ll-base-pp              (polar ll-base-pp 0.0 (* offset 0.5) )
234.                                         y-int-lst               (reverse (member (fix n-y-div ) int-lst  ) )
235.                                         y-left-pp-lst   (mapcar '(lambda (i) (polar ll-base-pp  (* pi/4 2.0) (* e-dy (float i) ) ) ) y-int-lst )
236.                                         y-right-pp-lst (mapcar '(lambda (i) (polar i 0.0 (+ i-base offset) ) ) y-left-pp-lst )
237.  
238.  
239.  
240.  
241.                                        
242.                                         ;       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -       -
243.                                         ll-base-pp              (polar e-ll pi  (+ (/ e-dx 2.0) ) )
244.                                         ll-base-pp              (polar ll-base-pp (* pi/4 2.0) (/ offset 2.0) )
245.                                         x-int-lst               (reverse (member (fix n-x-div ) int-lst  ) )
246.                                         x-lower-pp-lst  (mapcar '(lambda (i) (polar ll-base-pp  0.0 (* e-dx (float i) ) ) ) x-int-lst )
247.                                         x-upper-pp-lst (mapcar '(lambda (i) (polar i (* pi/4 2.0) (+ i-height offset) ) ) x-lower-pp-lst )
248.  
249.                                         pick-point-list (apply' append (mapcar 'cdr (list       x-lower-pp-lst  y-right-pp-lst  (reverse x-upper-pp-lst) (reverse y-left-pp-lst ) ) ) )
250.  
251.                         )
252.                 )
253.                 t
254.                 (exit)
255.         )
256.  
257.         (command "zoom" "w" e-ll e-ur)
258. (:ENTER_TO_CONTINUE)
259.         (command "zoom" "s" "0.9x")
260. (:ENTER_TO_CONTINUE)
261.        
262.         (setvar "osmode" 0)
263.  
264.         (setq *model-space* (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
265.        
266.         (setq x-entlast (LM:ENTLAST (entlast) ) )
267.  
268.         (setq e-pline-v-list (list e-ll e-lr e-ur e-ul e-ll) )
269.  
270.         (entmakex
271.                 (append
272.                         '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") (8 . "0") (90 . 5) (70 . 1))
273.         (mapcar '(lambda (pt) (cons 10 pt)) e-pline-v-list)
274.       )
275.    )
276. (:ENTER_TO_CONTINUE)   
277.         (mapcar '(lambda (i j) (vla-AddLine *model-space* (vlax-3d-point i) (vlax-3d-point j) ) ) y-left-pt-lst  y-right-pt-lst)
278. (:ENTER_TO_CONTINUE)   
279.         (mapcar '(lambda (i j) (vla-AddLine *model-space* (vlax-3d-point i) (vlax-3d-point j) ) ) x-lower-pt-lst x-upper-pt-lst)
280. (:ENTER_TO_CONTINUE)
281.         (setq new-en-lst (LM:ENTNEXTTOEND x-entlast) )
282.        
283.         (setq ind 0 boundary-set (ssadd br-en) )
284.         (repeat (length new-en-lst) (setq boundary-set (ssadd (nth ind new-en-lst) boundary-set)        ind (+ 1 ind) ) )
285.  
286.         (setq ppl pick-point-list)
287.         (vl-cmdf "_-bhatch" "_a" "_b" "_n" boundary-set "" "")
288.         (while ppl (command (car ppl)) (setq ppl (cdr ppl) )  )
289.         (command "")
290.         (setq h-en (entlast) )
291. (:ENTER_TO_CONTINUE)   
292.         (setq new-en-lst (LM:ENTNEXTTOEND x-entlast) ) 
293.         (setq ss-to-erase (ssadd) ind 0)
294.         (repeat (length new-en-lst) (setq ss-to-erase (ssadd (nth ind new-en-lst) ss-to-erase)  ind (+ 1 ind) ) )
295.         (setq ss-to-erase (ssdel (entlast) ss-to-erase) )
296.         (command "erase" ss-to-erase "")
297.  
298. (:ENTER_TO_CONTINUE)
299.         (setq x-entlast (LM:ENTLAST h-en ) )
300.         (command "HATCHGENERATEBOUNDARY" h-en "")
301.         (entdel h-en)
302.         (setq new-en-lst (LM:ENTNEXTTOEND x-entlast) ) 
303.         (setq ss-to-erase (ssadd) ind 0)
304.         (repeat (length new-en-lst) (setq ss-to-erase (ssadd (nth ind new-en-lst) ss-to-erase)  ind (+ 1 ind) ) )
305. (:ENTER_TO_CONTINUE)
306.         (vla-put-Visible br-obj :vlax-false)
307. (:ENTER_TO_CONTINUE)   
308.         (vl-cmdf "_-bhatch" "_a" "_b" "_n" ss-to-erase "" "" (mid i-ll i-ur) "")
309. (:ENTER_TO_CONTINUE)   
310.         (command "erase" ss-to-erase "")
311. (:ENTER_TO_CONTINUE)
312.         (vla-put-Visible br-obj :vlax-true)
313.         (command "draworder" (entlast) "" "back")
314.        
315. )
316.  
317.  
318.  
319. (defun c:K () (C:BOTTOM-HATCH) )
320.  

[domenicomaria]

the code needs to be improved a lot,
. . .
towards the end it is a little confusing
. . .
but it works
. . .
you can decide the number of horizontal and vertical divisions. . .
...
as soon as I have a little time,
I will improve it and make it more readable
. . .
I have not used
BHGAPTOL
. . .
but still it must be taken into consideration
. . .
however, it is not the solution, but it is probably the way

[domenicomaria]

i forgot to add
(setvar "hpname" "solid")

[danAllen]

One advantage of hatch is you can up the HPGAPTOL number to fill in any imperfections which the OP was having issues with.

At least in Bricscad v15, both BHATCH & BPOLY use HPGAPTOL

[ronjonp]

One advantage of hatch is you can up the HPGAPTOL number to fill in any imperfections which the OP was having issues with.

At least in Bricscad v15, both BHATCH & BPOLY use HPGAPTOL

You're talking about a progressive CAD platform vs. AutoCAD

Just checked in AutoCAD 2022 and it's still the same.

[Marc'Antonio Alessi]

One advantage of hatch is you can up the HPGAPTOL number to fill in any imperfections which the OP was having issues with.

At least in Bricscad v15, both BHATCH & BPOLY use HPGAPTOL

You're talking about a progressive CAD platform vs. AutoCAD

Just checked in AutoCAD 2022 and it's still the same.

V15... it is a very far progress… 

[domenicomaria]

https://drive.google.com/file/d/1gaySQZqUzguKudx-qNrcwz1fgrQZQh3n/view?usp=sharing

it is important to set the number of horizontal and vertical divisions

and HPGAPTOL too

and set "hpname" to "solid"

I want try to write a "circular" version . . . using a circle, instead of a rectangle

[domenicomaria]

https://drive.google.com/file/d/1DwcGC8efeE9XXnbKq0h8srkB8wyDf-tk/view?usp=sharing

[domenicomaria]

BOTTOM-HATCH-CIRCULAR

Often it works.
Mainly with simple shapes.

But if it doesn't work,
it depends also
from the ACAD algorithm for BATCH.

Because it is NOT PERFECT !

Code - Auto/Visual Lisp: [Select]

1. (setq *DEBUG-IS-ALIVE* T)
2.  
3.  
4. (defun :ENTER_TO_CONTINUE ()
5.    (if *DEBUG-IS-ALIVE*
6.       (getstring "\nenter to continue :")
7.       nil
8.    )
9. )
10.  
11. ;   LEE MAC MID   ... renamed ...
12. (defun MID-2P (a b)
13.    (mapcar (function (lambda (a b) (/ (+ a b) 2.0))) a b)  
14. )
15.  
16.    ;   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -
17. (defun C:BOTTOM-HATCH-CIRCULAR (/             ALL-EN-LST      BOUNDARY-SET  BR-BB
18.                                 BR-EN          BR-ES         BR-OBJ        BR-SS
19.                                 CENTER          CRCL-EN         CRCL-OBJ        GENERATED-BOUNDARY-EN-LST
20.                                 GENERATED-BOUNDARY-SS         HATCH-EN        HATCH-ENTLAST
21.                                 HPGAPTOL       I-LL            I-LR           I-UL
22.                                 I-UR          INC-ANG         IND           L-X
23.                                 L-Y             LINES-EN-LST   LINES-ENTLAST N-DIV
24.                                 OFFSET          OLD-HPGAPTOL   OLD-N-DIV     PP-LST
25.                                 R-X             RADIUS         RADIUS-E        RADIUS-EE
26.                                 RADIUS-I       START-ANG      U-Y           VLA-CENTER
27.                                 Z-LL          Z-UR
28.                                )
29.  
30.  
31.    (setvar "osmode" 0)
32.    (setvar "hpname" "solid")
33.    (setvar "dimzin" 0)
34.    (setq   *model-space*
35.            (vla-get-modelspace
36.               (vla-get-activedocument (vlax-get-acad-object))
37.            )
38.    )
39.  
40.    ;   -   -   -
41.    (setq old-n-div 5)
42.    (if (not
43.           (setq n-div (getint   (strcat "\nnumber of angular divisions < "
44.                                       (itoa old-n-div)
45.                                       " > :"
46.                               )
47.                       )
48.           )
49.        )
50.       (setq n-div old-n-div)
51.    )
52.  
53.    ;   -   -   -  
54.    (setq old-hpgaptol (getvar "hpgaptol"))
55.    (if (not
56.           (setq hpgaptol (getdist
57.                             (strcat "\nHPGAPTOL < " (rtos old-hpgaptol 2 2) " > : ")
58.                          )
59.           )
60.        )
61.       (setq hpgaptol old-hpgaptol)
62.    )
63.    (setvar "hpgaptol" hpgaptol)
64.  
65.    ;      the insert must have ROTATION ANGLE = 0.0    
66.    ;      and CANNOT CONTAIN HATCHS and SPLINES        
67.    (if (and
68.           (setq br-es (entsel "\nselect the block to FILL on the BOTTOM :"))
69.           (setq br-en (car br-es))
70.           (setq br-obj (vlax-ename->vla-object br-en))
71.           (setq br-ss (ssadd))
72.           (setq br-ss (ssadd br-en br-ss))
73.           (setq br-bb (LM:BLOCKREFERENCEBOUNDINGBOX br-obj))
74.           (setq i-ll         (nth 0 br-bb)
75.                 i-lr         (nth 1 br-bb)
76.                 i-ur         (nth 2 br-bb)
77.                 i-ul         (nth 3 br-bb)
78.                 center      (MID-2P i-ll i-ur)
79.                 vla-center   (vlax-3d-point center)
80.                 radius      (/ (distance i-ll i-ur) 2.0)
81.                 offset      (/ radius 20.0)
82.                 radius-e   (+ radius offset)
83.                 radius-ee   (+ radius (* 1.5 offset))
84.                 radius-i   (+ radius (/ offset 2.0))
85.                 l-x         (- (car center) radius-e)
86.                 r-x         (+ (car center) radius-e)
87.                 l-y         (- (cadr center) radius-e)
88.                 u-y         (+ (cadr center) radius-e)
89.                 z-ll         (list l-x l-y)
90.                 z-ur         (list r-x u-y)
91.           )
92.        )
93.       t
94.       (exit)
95.    )
96.  
97.    (command "zoom" "w" z-ll z-ur)
98.    (:ENTER_TO_CONTINUE)
99.    (command "zoom" "s" "0.9x")
100.    (:ENTER_TO_CONTINUE)
101.  
102.    (setq crcl-obj (vla-AddCircle *model-space* vla-center radius-e))
103.    (setq crcl-en (vlax-vla-object->ename crcl-obj))
104.  
105.  
106.    ;   (command "line" z-ll z-ur "")  
107.  
108.  
109.    (:ENTER_TO_CONTINUE)
110.    (setq lines-entlast (LM:ENTLAST (entlast)))
111.  
112.    (setq inc-ang (/ (* pi 2) (float n-div)))
113.    (setq ind 1)
114.    (repeat n-div
115.       (vla-addline
116.          *model-space*
117.          vla-center
118.          (vlax-3d-point (polar center (* inc-ang ind) radius-ee))
119.       )
120.       (setq ind (+ 1 ind))
121.    )
122.    (setq lines-en-lst (LM:ENTNEXTTOEND lines-entlast))
123.  
124.  
125.  
126.  
127.  
128.    (setq   ind       0
129.          start-ang (/ inc-ang 2.0)
130.    )
131.    (repeat n-div
132.       (setq   pp-lst (cons (polar center (+ start-ang (* inc-ang ind)) radius-i)
133.                          pp-lst
134.                    )
135.       )
136.       (setq ind (+ 1 ind))
137.    )
138.  
139.  
140.  
141.  
142.    (:ENTER_TO_CONTINUE)
143.    (setq   ind 0
144.          boundary-set
145.            (ssadd br-en)
146.          all-en-lst
147.            (append lines-en-lst (list crcl-en))
148.    )
149.    (repeat (length all-en-lst)
150.       (setq   boundary-set
151.               (ssadd (nth ind all-en-lst) boundary-set)
152.             ind (+ 1 ind)
153.       )
154.    )
155.  
156.  
157.    (vl-cmdf   "_-bhatch" "_a" "_b"   "_n" boundary-set   ""   "_a" "_n" "")
158.    (while pp-lst
159.       (command (car pp-lst))
160.       (setq pp-lst (cdr pp-lst))
161.    )
162.    (command "")
163.    (setq hatch-en (entlast))
164.    (:ENTER_TO_CONTINUE)
165.  
166.  
167.  
168.  
169.  
170.    (setq hatch-entlast (LM:ENTLAST hatch-en))
171.    (command "HATCHGENERATEBOUNDARY" hatch-en "")
172.    (entdel hatch-en)
173.    (setq generated-boundary-en-lst (LM:ENTNEXTTOEND hatch-entlast))
174.    (setq   generated-boundary-ss
175.            (ssadd)
176.          ind 0
177.    )
178.    (repeat (length generated-boundary-en-lst)
179.       (setq   generated-boundary-ss
180.               (ssadd   (nth ind generated-boundary-en-lst)
181.                      generated-boundary-ss
182.               )
183.             ind (+ 1 ind)
184.       )
185.    )
186.    (:ENTER_TO_CONTINUE)
187.  
188.    (vl-cmdf "erase" boundary-set hatch-en "r" br-en "")
189.  
190.    (vla-put-Visible br-obj :vlax-false)
191.    (:ENTER_TO_CONTINUE)
192.    (vl-cmdf   "_-bhatch" "_a" "_b"   "_n" generated-boundary-ss   ""   ""   center "")
193.    (:ENTER_TO_CONTINUE)
194.  
195.    (vl-cmdf "erase" generated-boundary-ss "")
196.    (:ENTER_TO_CONTINUE)
197.    (vla-put-Visible br-obj :vlax-true)
198.    (command "draworder" (entlast) "" "back")
199.  
200.  
201. )
202.  
203.  
204.  
205. (defun C:Y () (C:BOTTOM-HATCH-CIRCULAR))
206.  

[domenicomaria]

https://drive.google.com/file/d/1xVWMLSRn0OiGr1L9CiSkpcTLAIBYKYhH/view?usp=sharing

https://drive.google.com/file/d/12OWvEDsQO0mCxSjj2cK9H7oRN7dTVfpr/view?usp=sharing

[domenicomaria]

https://drive.google.com/file/d/1aav6T4n5m6LuYnED0ZrZ3NL6HY_CfP1C/view?usp=sharing

[Marc'Antonio Alessi]

https://drive.google.com/file/d/1aav6T4n5m6LuYnED0ZrZ3NL6HY_CfP1C/view?usp=sharing

Good job! Can you tell me what software do you use to make the videos? (remember to mute the microphone…  )

[domenicomaria]

what software do you use to make the videos?

Moavi screen recorder . . .
. . . Yes . . . the microphone  . . .
. . .
however the program still needs to be very refined. . .
. . .
but the true weak point is the limitations of the ACAD "boundary" command . . .
. . .
ciao

[xdcad]

what software do you use to make the videos?

Moavi screen recorder . . .
. . . Yes . . . the microphone  . . .
. . .
however the program still needs to be very refined. . .
. . .
but the true weak point is the limitations of the ACAD "boundary" command . . .
. . .
ciao

xdrx_Insert_appendWipeout
xdrx_Insert_removeWipeout

xdrx_wipeout_make
xdrx_wipeout_setFrame

xdrx_block_remove_wipeout
xdrx_block_make_wipeout

Make a mark first and add it later

[domenicomaria]

Code - Auto/Visual Lisp: [Select]

1. (type xdrx_block_make_wipeout)
2. nil
3.  

[xdcad]

Code - Auto/Visual Lisp: [Select]

1. (type xdrx_block_make_wipeout)
2. nil
3.  

很奇怪啊，明明有这个，我查下

You add WIPEOUT to INSERT, use the following, it is very concise, and directly puts the display order of WIPEOUT at the bottom of the entities inside the block, so as to cover the entities under the block without affecting the entities inside the block.

Code - Auto/Visual Lisp: [Select]

1. (xdrx-insert-appendwipeout blkref box offset)
2.  
3. blkref --- insert entity name
4. box    --- WIPEOUT rectangular box, such as (xdrx-entity-box....) generated
5. offset  --- a real number, whether the BOX is offset, positive values are outward offset, negative values are inward offset, if not given, offset = 0.0

The following is the demo program. A small problem was discovered during the debugging process. The XDRX API was re-uploaded. You may need to re-download it.

Code - Auto/Visual Lisp: [Select]

1. (defun c:tt ()
2.   (if (setq blkref (xdrx-entsel "\nPick Insert<exit>:" '((0 . "insert"))))
3.     (progn
4.       (xdrx-begin)
5.       (setq blkref (car blkref)
6.             box    (xdrx-entity-box blkref)
7.             offset (/ (distance (nth 0 box) (nth 3 box)) 10.0)
8.                                         ; offset distance 1/10 of the box height
9.       )
10.       (vl-cmdf ".wipeout" "frame" "off")
11.       ;;Turn off WIPEOUT border display
12.       (xdrx-insert-appendwipeout blkref box offset)
13.       (xdrx-draworder->top blkref)      ;Insert the entity display order to the top
14.       (xd::drag:simplemove blkref "\nInsert Point:" 5 t) ;Move drag
15.       (xdrx-end)
16.     )
17.   )
18.   (princ)
19. )