help fix lisp for create hatch

[yakird6JKSJ]

I am attaching a file that produces closed polylines that help produce accelerators, the problem is that the file does not always work well, or does not perform the operation properly, I would appreciate help in improving it and perhaps allowing it to perform accelerators in addition to closing a polyline

[Sea-Haven]

You need to explain more what it is your doing not just post code. Maybe a dwg before & after. Or an image at least.

[yakird6JKSJ]

i design road as transportaion eng/

i need make hatch of lanes or difreent type of road elements , i add now picture as example

[Moshe-A]

Yakir Shalom,

i opened a new drawing, draw 3 rectangles and invoke BB command and the lisp work very hard (took some time) to draw on top 3 green rectangles on layer bound. given your picture i do not see how BB can help you. BPOLY (or BOUNDARY) command can add a close pline inside a close area but you have to make sure the area is close by lines,plines (or other curves objects). BPOLY will run quickly only if you narrow the amount of objects it process (e.g Boundary set)

Moshe

[yakird6JKSJ]

so do you have solutoion?

how can i create a betterl lisp that make bound polyline so it allow create hatch' ?

like the example i sent for road design , i want to create hatc for every elements ' like road/ bus lane/and more

[Moshe-A]

@yakird6JKSJ ,

Well, it would be easy if you make sure the area you want to hatch is well built with no gaps or if there are some small gaps, you have know what they are and set it in the allowed tolerance gaps (BHATCH command). giving that, if you know patterns you want, scale and rotation, lisp can apply this to layers but if you are looking for lisp that knows how apply hatch to un well closed area? Huston we have a problem! 😀

Moshe

[Kent1Cooper]

Not enough information.  When it doesn't work right, what does it do that it should not?  What does it not do that it should?  Does it do part of what it should but not all?  How far does it get?  Are there any messages?  Etc., etc.

[yakird6JKSJ]

the lisp suppose to close open polyline and create obejcts of close elements,

i want to have close polyline so i can create hatch for all lane road deisgn

see in picture - i want for example the shoulders on lane be close so i can create hatch /lane be close so i can create hatch//

that the main purpose i want the lisp

[Sea-Haven]

As mentioned by others you need a closed area for the hatch, you can use this to add a closing end to 2 lines or plines.

; Join end of 2 multiple lines convert to pline
; By Alan H March  2021


(defun  c:joinends ( / pt1 pt2 start end  swapends)

(defun ah:swapends (pt / temp d1 d2 ent)
(setq ent (entget (ssname (ssget pt)0 )))
(setq lay (cdr (assoc 8 ent)))
(setq end (cdr (assoc 11 ent)))
(setq start (cdr (assoc 10 ent)))
(setq d1 (distance pt end))
(setq d2 (distance pt start))
(if (< d1 d2)
    (progn
       (setq temp end)
       (setq end start)
       (setq start temp)
    )
)
(command "erase" (cdr (assoc -1 ent)) "")
(princ)
)

(setq oldsnap (getvar 'osmode))

(setq pt1 (getpoint "\Pick 1st point "))
(setq pt2 (getpoint pt1 "\Pick 2nd  point "))

(setq lst (list pt1 pt2))
(setq ss (ssget "F" lst (list (cons 0 "*line"))))
(setq lay (cdr (assoc 8 (entget (ssname ss 0)))))

(setq lst2 '())
(repeat (setq x (sslength ss))
(setq ent (ssname ss (setq x (- x 1))))
(setq obj (vlax-ename->vla-object ent))
(setq pt3 (vlax-curve-getclosestpointto obj pt1))
(setq dist (distance pt1 pt3))
(setq lst2 (cons (list dist pt3) lst2))
)
(setq lst2 (vl-sort lst2 '(lambda (x y) (< (car x)(car y)))))

(setq lst '())
(setq x 0)
(setvar 'osmode 0)
(repeat (/ (sslength ss) 2)
(setq lst '())
(setq pt3 (nth 1 (nth x lst2)))
(ah:swapends pt3)

(setq lst (cons (list (car start) (cadr start))lst))
(setq lst (cons (list (car end)(cadr end)) lst))

(setq pt4 (nth 1 (nth (+ x 1) lst2)))
(ah:swapends pt4)

(setq lst (cons (list (car end)(cadr end)) lst))
(setq lst (cons (list (car start) (cadr start))lst))

(setq x (+ x 2))

(entmakex (append (list (cons 0 "LWPOLYLINE")
          (cons 100 "AcDbEntity")
          (cons 100 "AcDbPolyline")
          (cons 8 lay)
          (cons 90 (length lst))
          (cons 70 1))
          (mapcar (function (lambda (p) (cons 10 p))) lst)
           )
)

)

(setvar 'osmode oldsnap)

(princ)
)