LISP - Break line and match line segment color and layer with hatch region

[cool.stuff]

Hello 🙂

I would like to know if it is possible to break a line in multiple segments according to its location on each hatch area that it crosses. It may not not completely cross one hatch area. Also, if there is no hatch, it should keep its properties (no match properties).

Can someone give me a hand please?

I have to measure on multiple areas of hatches the length of each line segment and create a summary. This way, I would use this lisp and other that creates line (or polyline, whatever is simpler) summary line length by layer 🙂

I have a sample dwg attached.

Many thanks in advance.

[Moshe-A]

@cool.stuff  hi,

please explain, what is the engineering \ design purpose here?

Moshe

[cool.stuff]

Thanks for your reply @Moshe-A 🙂

I have identified exceptions on beams given some spaces, which are marked with hatches. Given the hatches, I was able to get their lengths and catalogue those exceptions.

Do you think it is possible please?

[Moshe-A · Accepted solution]

@cool.stuff ,

Check BRK command. it works for all cases except for the lines that are extend out of the hatch, is it must?

i think the effort to solve the later is not worth it.

enjoy

moshe

(vl-load-com); load activex support

;; Intersections  -  Lee Mac
;; Returns a list of all points of intersection between two objects
;; for the given intersection mode.
;; ob1,ob2 - [vla] VLA-Objects
;;     mod - [int] acextendoption enum of intersectwith method

(defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
             (vlax-method-applicable-p ob2 'intersectwith)
             (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
        )
        (repeat (/ (length lst) 3)
            (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
                  lst (cdddr lst)
            )
        )
    )
    (reverse rtn)
)



(defun c:brk (/ _pairs draw_line ; local functions
	        ss0 ename0 elist0 lst1 lst2 lst3 ename3 AcDbLine3 AcDbHatch1 AcCmColor1 AcCmColor1 AcDbPline2 cr^ pt p0 p1 p2)

 (defun _pairs (l1 l2)
  (vl-remove-if
   'not
   (mapcar
    (function
     (lambda (ent1)
       (setq area1 (vla-get-area (vlax-ename->vla-object ent1)))
       (vl-some
	 (function
           (lambda (ent2)
            (setq area2 (vla-get-area (vlax-ename->vla-object ent2)))
            (if (equal area1 area2 1e-3)
             (list ent1 ent2)
            )
	   ); lambda
	 ); function
	l2
       ); vl-some
     ); lambda
   ); function
   l1
   ); mapcar
  ); vl-remove-if
 ); _pairs

 (defun draw_line (t0 t1 clr)
  (entmake
    (list
     '(0 . "line")
     '(100 . "AcDbLine")
      (cons '62 clr)
      (cons '10 t0)
      (cons '11 t1)
    ); list
  ); entmake
 ); draw_line
 
  
 ; here start c:brk
 (if (setq ss0 (ssget '((-4 . "<or")
		          (0 . "hatch,line")
                          (-4 . "<and") (0 . "lwpolyline") (70 . 1) (-4 . "and>")
                       (-4 . "or>")
		      )
	      )
     )
  (progn
   (foreach ename0 (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss0)))
    (setq elist0 (entget ename0))

    (cond
     ((eq (cdr (assoc '0 elist0)) "HATCH")
      (setq lst1 (cons ename0 lst1))
     ); case
     ((eq (cdr (assoc '0 elist0)) "LWPOLYLINE")
      (setq lst2 (cons ename0 lst2))
     ); case
     ((eq (cdr (assoc '0 elist0)) "LINE")
      (setq lst3 (cons ename0 lst3))
     ); case
    ); cond
   ); foreach

   (if (/= (vl-list-length lst1) (vl-list-length lst2))
    (progn
     (vlr-beep-reaction)
     (prompt "\nNumber of hatch object(s) is not sync with number of pline(s).")
    ); progn
    (progn
     (foreach ename3 lst3
      (setq AcDbLine3 (vlax-ename->vla-object ename3))
      (setq p1 (vlax-safearray->list (vlax-variant-value (vla-get-startPoint AcDbLine3))))
      (setq p2 (vlax-safearray->list (vlax-variant-value (vla-get-endPoint AcDbLine3))))

      (foreach pair (_pairs lst1 lst2)
       (setq AcDbHatch1 (vlax-ename->vla-object (car pair)))
       (setq AcCmColor1 (vla-get-trueColor AcDbHatch1))
       (setq clr (vla-get-entityColor AcCmColor1))

       (setq AcDbPline2 (vlax-ename->vla-object (cadr pair)))
       (vla-put-trueColor AcDbPline2 AcCmColor1)
	
       (if (setq cr^ (LM:intersections AcDbLine3 AcDbPline2 acExtendNone))
        (foreach pt cr^
         (setq pts^ (cons pt pts^))
        ); foreach
       ); if
	
       (cond
        ((= (vl-list-length cr^) 2)
         (draw_line (car cr^) (cadr cr^) clr)
        ); case
        ((= (vl-list-length cr^) 1)
         (setq p0 (car cr^))
 
         (cond
	  ((< (distance p0 p1) (distance p0 p2))
           (draw_line p0 p1 clr)
	  ); case
	  ( t
           (draw_line p0 p2 clr)
	  ); case
         ); cond
	 
        ); case
       ); cond

       (vlax-release-object AcDbPline2)
       (vlax-release-object AcCmColor1)
       (vlax-release-object AcDbHatch1)
      ); foreach

      (vlax-release-object AcDbLine3)
     ); foreach

     (foreach ename3 lst3
      (entdel ename3)
     )
    ); progn
   ); if
   
  ); progn
 ); if

 (princ)
); c:brk

@ 

[cool.stuff]

It is perfect!!!!!! Just awesome!!!! 🙂 🙂

Many many many thanks @Moshe-A 🙂 🙂

Works like a charm!!! 🙂

Many many many thanks again!!! 

Cheers

[cool.stuff]

@Moshe-Aputting the new "generated" line in the same layer as the hatch is very complex/hard? Like do a "match properties"?

I do not want to push your good will.

Many thanks again for all the saved hours!!! 🙂

[Moshe-A]

@cool.stuff ,

Happy to see it this morning, thank you very much , glad i could help

thought about the extended line over sleep night and i think i have a solution (as matter fact i did give it a try and it is already in the code but not finished) so expect for fix 😀

Moshe

[cool.stuff]

@Moshe-Athank you 🙂

It works perfectly 🙂

If you think you could solve the lines outside hatch, it would be even better 🙂

As I said before, not to push your good will, do you think it is possible to match the broken lines with the same properties as the layer?

Many thanks again for your help 🙂

[cool.stuff]

@Moshe-AI have assigned layers to hatch and respective boundaries. When I run the lisp, it does not break the lines... Is this because of the assigned layers?

Many thanks again 🙂

[Moshe-A]

@cool.stuff ,

i tried and it did work for the first line but creates duplicates lines for all other that start\end inside polyline.

the reason for this is the program step on each line (against each polyline\hatch) but does not aware about the other

the lines where they where start or cross the polylines\hatch.  so i think does not worth it better fix it manually.

Moshe

[cool.stuff]

@Moshe-A, many many thanks for your time and patience 🙂 really!!!

[cool.stuff]

@Moshe-AI have been thinking about this: is it possible to assign layers to broken lines based on color?

For instance, could you include in lisp a list of color and respective layer to which that line should belong?

acRed = layer "l1"

acCyan = layer "l2"

and so on

I would edit that list based on colors hatches and then the lisp would assign, based on color, a layer to the broken lines?

Do you think this is simple to implement?

Many thanks again for your patience and help 🙂