Explode lines to segment

[samifox]

Hi

 

my final end is to produce a routine to explode lines to segments defined by their intersection points. (see jpg attachment)

 

my needs :

 

1. filling the gaps between perpendicular lines which don't meet(i found only the pedit to do this)
   
2. run a scan to verify perpendicular lines which still don't meet (i explode the polyline again because (inters) work with lines only)
   
3. run (break) on each intersection point)(feature)
   
4. run a function that collect all lines that thier length is less than x , and delete them(feature)
   
5. (still need to think about a way to protect some lines from the function above)(feature)
   

 

 

right now, i got the selection set, i joining the lines into a polyline , now in order to use the 9inters) function i need the gaps free polyline to be converted back to lines

 

but when using :

(command "_.explode" entlast "")

 

i get error

 

what im doing wrong?

 

(defun C:TEST (/ st cen my mx z i)

 
 (setq ope (getvar "PEDITACCEPT")) 
 (if (setq st (ssget '((0 . "LINE"))));_ get a selectio set
   (progn
     (setvar "PEDITACCEPT" 1)
     (command "_.pedit" "_M" st "" "_J" "20" "" );_join and fill the gaps
     (setvar "PEDITACCEPT" ope)
   )
 )
 ;_
 (setq q (getvar 'qaflags))
           (setvar 'qaflags 1)
           (command "_.explode" entlast "");_explode the converted polyline
           (setvar 'qaflags q)



 (setq	i 0
z 0
 )

 ;_find intesection and mark them
 (while (< i (- (sslength st) 1))
   (while (< z (- (sslength st) 1))

     (setq mx (ssname st i))
     (setq my (ssname st (+ z 1)))

     (if (setq cen (findInters mx my))
(progn
  (command "Circle" cen 8 "")

)
     )
     (setq z (1+ z))
   ) ;_while
   (setq i (1+ i))
   (setq z 0)
 )
)




(defun findInters (entA entB)

 (setq 1a (cdr (assoc 10 (entget entA))))
 (setq 1b (cdr (assoc 11 (entget entA))))
 (setq 2a (cdr (assoc 10 (entget entB))))
 (setq 2b (cdr (assoc 11 (entget entB))))

 (setq in (inters 1a 1b 2a 2b))

)


(defun c:jp (/ ope ss)
 (setq ope (getvar "PEDITACCEPT"))
 (if (setq ss (ssget '((0 . "ARC,*POLYLINE,LINE"))))
   (progn
     (setvar "PEDITACCEPT" 1)
     (command "_.pedit" "_M" ss "" "_J" "" "")
   )
 )
 (setvar "PEDITACCEPT" ope)
 (princ)
)

 

Thanks

Shay

[Tharwat]

At least you should have thanked the gentlemen whom trying to help you in the same issue in THIS THREAD

[MSasu]

Samifox, please pay attention to how you called ENTLAST (is a function):

(command "_.explode" [color=red]([/color]entlast[color=red])[/color] "")

[pBe]

Does my eyes deceive me, or the "exploded" lines are not aligned on your posted pix? is that really your intent?

[marko_ribar]

Shay, if I understood correctly this is what you need...

 

(defun plintav ( / intersobj1obj2 LM:Unique AT:GetVertices _reml member-fuzz add_vtx
                  ss sslpl sshpl i ent n ent1 ss-ent1 k ent2 intpts intptsall pl plpts restintpts par )

 (vl-load-com)

 (defun intersobj1obj2 ( obj1 obj2 / coords pt ptlst )
   (if (eq (type obj1) 'ENAME) (setq obj1 (vlax-ename->vla-object obj1)))
   (if (eq (type obj2) 'ENAME) (setq obj2 (vlax-ename->vla-object obj2)))
   (setq coords (vl-catch-all-apply 'vlax-safearray->list (list (vl-catch-all-apply 'vlax-variant-value (list (vla-intersectwith obj1 obj2 AcExtendNone))))))
   (if (vl-catch-all-error-p coords)
     (setq ptlst nil)
     (repeat (/ (length coords) 3)
       (setq pt (list (car coords) (cadr coords) (caddr coords)))
       (setq ptlst (cons pt ptlst))
       (setq coords (cdddr coords))
     )
   )
   ptlst
 )  

 (defun LM:Unique ( lst )
   (if lst (cons (car lst) (LM:Unique (vl-remove (car lst) (cdr lst)))))
 )

 (defun AT:GetVertices ( e / p l )
   (LM:Unique
     (if e
       (if (eq (setq p (vlax-curve-getEndParam e)) (fix p))
         (repeat (setq p (1+ (fix p)))
           (setq l (cons (vlax-curve-getPointAtParam e (setq p (1- p))) l))
         )
         (list (vlax-curve-getStartPoint e) (vlax-curve-getEndPoint e))
       )
     )
   )
 )

 (defun _reml ( l1 l2 / a n ls )
   (while 
     (setq n nil 
           a (car l2)
     )
     (while (and l1 (null n))
       (if (equal a (car l1) 1e-
         (setq l1 (cdr l1) 
               n t
         )
         (setq ls (append ls (list (car l1)))
               l1 (cdr l1)
         )
       )
     )
     (setq l2 (cdr l2))
   )
   (append ls l1)
 )

 (defun member-fuzz ( expr lst fuzz )
   (while (and lst (not (equal (car lst) expr fuzz)))
     (setq lst (cdr lst))
   )
   lst
 )

 (defun add_vtx ( obj add_pt ent_name / bulg )
     (vla-addVertex
         obj
         (1+ (fix add_pt))
         (vlax-make-variant
             (vlax-safearray-fill
                 (vlax-make-safearray vlax-vbdouble (cons 0 1))
                     (list
                         (car (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name))
                         (cadr (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name))
                     )
             )
         )
     )
     (setq bulg (vla-GetBulge obj (fix add_pt)))
     (vla-SetBulge obj
         (fix add_pt)
         (/
             (sin (/ (* 4 (atan bulg) (- add_pt (fix add_pt))) 4))
             (cos (/ (* 4 (atan bulg) (- add_pt (fix add_pt))) 4))
         )
     )
     (vla-SetBulge obj
         (1+ (fix add_pt))
         (/
             (sin (/ (* 4 (atan bulg) (- (1+ (fix add_pt)) add_pt)) 4))
             (cos (/ (* 4 (atan bulg) (- (1+ (fix add_pt)) add_pt)) 4))
         )
     )
     (vla-update obj)
 )

 (setq ss (ssget "_I" '((0 . "*POLYLINE") (-4 . "<and") (-4 . "<not") (-4 . "&=") (70 .  (-4 . "not>") (-4 . "<") (70 . 130) (-4 . "and>"))))
 (setq sslpl (ssadd) sshpl (ssadd))
 (setq i -1)
 (while (setq ent (ssname ss (setq i (1+ i))))
   (if (eq (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
     (progn
       (entupd ent)
       (vla-update (vlax-ename->vla-object ent))
       (ssadd ent sslpl)
     )
   )
   (if (eq (cdr (assoc 0 (entget ent))) "POLYLINE")
     (ssadd ent sshpl)
   )
 )
 (setq i -1)
 (while (setq ent (ssname sshpl (setq i (1+ i))))
   (command "_.convertpoly" "l" ent "")
   (entupd ent)
   (vla-update (vlax-ename->vla-object ent))
   (ssadd ent sslpl)
 )
 (repeat (setq n (sslength ss))
   (setq ent1 (ssname ss (setq n (1- n))))
   (setq ss-ent1 (ssdel ent1 ss))
   (repeat (setq k (sslength ss-ent1))
     (setq ent2 (ssname ss-ent1 (setq k (1- k))))
     (setq intpts (intersobj1obj2 ent1 ent2))
     (setq intptsall (append intpts intptsall))
   )
 )
 (setq i -1)
 (while (setq pl (ssname sslpl (setq i (1+ i))))
   (setq plpts (AT:GetVertices pl))
   (setq restintpts (_reml intptsall plpts))
   (foreach pt restintpts
     (if 
       (and
         (not (member-fuzz pt plpts 1e-6))
         (setq par (vlax-curve-getparamatpoint pl pt))
       )
       (add_vtx (vlax-ename->vla-object pl) par pl)        
     )
   )
 )
 (setq i -1)
 (while (setq ent (ssname sshpl (setq i (1+ i))))
   (command "_.convertpoly" "h" ent "")
 )
 (princ)
)

(defun c:test (/ pea qaf ss sspl ssli i ent)
 (setq pea (getvar "PEDITACCEPT"))
 (setq qaf (getvar "QAFLAGS"))
 (if (setq ss (ssget '((0 . "ARC,*POLYLINE,LINE"))))
   (progn
     (setq sspl (ssadd))
     (setq ssli (ssadd))
     (setq i -1)
     (while (setq ent (ssname ss (setq i (1+ i))))
       (if (wcmatch (cdr (assoc 0 (entget ent))) "*POLYLINE")
         (ssadd ent sspl)
         (progn
           (setvar "PEDITACCEPT" 1)
           (command "_.pedit" ent "")
           (ssadd (entlast) ssli)
         )
       )
     )
   )
 )
 (sssetfirst nil (acet-ss-union (list ssli sspl)))
 (plintav)
 (setvar "QAFLAGS" 1)
 (command "_.explode")
 (setvar "QAFLAGS" qaf)
 (setvar "PEDITACCEPT" pea)
 (princ)
)

M.R.

Edited November 21, 2013 by marko_ribar

[pBe]

@ Marko_ribar

"PEDITACCEPT"

[marko_ribar]

@ Marko_ribar

"PEDITACCEPT"

 

No need for "PEDITACCEPT" when in my code I am converting each LINE, ARC entity to LWPOLYLINE with PEDIT individually - I am not joining them...

[pBe]

"PEDITACCEPT" for the code to work on lines as well, i'm just saying.

 

BTW: Suppresses display of the Object Selected Is Not a Polyline prompt in PEDIT

 

@samifox

What is the intent of the program again?

[samifox]

At least you should have thanked the gentlemen whom trying to help you in the same issue in THIS THREAD

 

yes...i totaly forgot

 

and its not the same issue , its look like the same images

[marko_ribar]

"PEDITACCEPT" for the code to work on lines as well, i'm just saying.

 

BTW: Suppresses display of the Object Selected Is Not a Polyline prompt in PEDIT

 

@samifox

What is the intent of the program again?

 

Yes, pBe you're correct... I've used setting of 1 and didn't saw it won't work... Code updated...

 

Thanks, pBe...

[samifox]

Shay, if I understood correctly this is what you need...

 

Thanks for your effort Mark

 

the code is failld at some point for some reason

 

im using 2010

 

Does my eyes deceive me, or the "exploded" lines are not aligned on your posted pix? is that really your intent?

 

yes..on the left is before, and on the right is the desired result (the offset is only to clear the point, they should share the same points)

[marko_ribar]

Shay, I've tested my code both on A2009 and on A2014... I don't see why it wouldn't work on A2010... Maybe you haven't used my corrected updated version (I've added PEDITACCEPT into the code like pBe suggested and it worked fine...)

 

M.R.

[samifox]

Shay, I've tested my code both on A2009 and on A2014... I don't see why it wouldn't work on A2010... Maybe you haven't used my corrected updated version (I've added PEDITACCEPT into the code like pBe suggested and it worked fine...)

 

M.R.

 

Sorry Marko

 

i mis copy-paste it

 

its exactly what i needed

 

thanks dude!

[pBe]

its exactly what i needed

 

Glad you had it sorted. IMO what you require can be done with less coding as long as you properly set the conditions.

 

Happy coding Samifox

[samifox]

Hay Marko , and everybody,

i start to learn your code line by line until i got the line of the express function (acet-ss-union)

where can i find the documentation for those functions?

 

Thanks

Shay

[marko_ribar]

This is where I found them :

 

http://www.afralisp.net/archive/lisp/acet-utils.htm

 

But it's only base for learning... Search on www.google.com if you get to some you don't know, I am sure they are explained...

 

All acet-utils functions you may find in this xls file...

 

M.R.

2010311112734_ACET-FUNCTIONS.xls

[samifox]

This is where I found them :

 

http://www.afralisp.net/archive/lisp/acet-utils.htm

 

But it's only base for learning... Search on www.google.com if you get to some you don't know, I am sure they are explained...

 

All acet-utils functions you may find in this xls file...

 

M.R.

 

i google it a bit , lots of experienced programmers dont like to use those functions and advice not to use them, what you guys think?

 

Shay

[marko_ribar]

i google it a bit , lots of experienced programmers dont like to use those functions and advice not to use them, what you guys think?

 

Shay

 

If you have ALISP alternative that is fast enough than use ALISP, else use ACET-... (my opinion)...

[MSasu]

This library is included in Express pack; for a while this was distributed separately from AutoCAD installer, now its installation is optional. For this reason, if you distribute your routines, it may happen that some users will not be able to run them since the functions from aforementioned library aren't available on their workstations.

[samifox]

(command "_.convertpoly" "l" ent "")

 

what is it?

 

Thanks

Shay