Author Topic: reconstruct polylines lines arcs cut  (Read 1458 times)

0 Members and 1 Guest are viewing this topic.

sergeluc

  • Guest
reconstruct polylines lines arcs cut
« on: February 21, 2012, 08:48:37 AM »
hello,
excuse ,my english is not perfect .
I try to rebuild same kinds of entities cut "lines *polylines or arcs" from a windows selection .The form entities (coplanar) are deleted and replaced by a single.

I enclose for example this routine ,it works by Two Entities selection.
(this lisp wasn't made ​​by me).

thank for your help
Code: [Select]
(defun REC-exct ( / ENTS1 ENTG1 EL ENTS2 ENTG2)
  (setq CL (getvar "CLAYER"))
  (setvar "CMDECHO" 0)
  (setq ENTS1 (car (entsel "\nPremiere entite")))
  (setq ENTG1 (entget ENTS1))
  (setq EL (cdr (assoc 8 ENTG1)))
  (setq ENTS2 (car (entsel "\nDeuxieme entite")))
  (setq ENTG2 (entget ENTS2))

(cond

  ((and (= (cdr (assoc 0 ENTG1)) "LINE")
           (= (cdr (assoc 0 ENTG2)) "LINE")
      ) ;_ Fin de and
    (progn
      (setq P1 (cdr (assoc 10 ENTG1))
            P2 (cdr (assoc 11 ENTG1))
            P3 (cdr (assoc 10 ENTG2))
            P4 (cdr (assoc 11 ENTG2))
      ) ;_ Fin de setq
      (command "_LAYER" "_S" EL "")
      (entdel ENTS1)
      (entdel ENTS2)
      (if (> (distance P1 P3) (distance P1 P4))
        (setq P5 P1
              P6 P3
        ) ;_ Fin de setq
        (setq P5 P1
              P6 P4
        ) ;_ Fin de setq
      ) ;_ Fin de if
      (if (> (distance P2 P3) (distance P2 P4))
        (setq P7 P2
              P8 P3
        ) ;_ Fin de setq
        (setq P7 P2
              P8 P4
        ) ;_ Fin de setq
      ) ;_ Fin de if
      (if (> (distance P5 P6) (distance P7 P8))
        (command "_LINE" P5 P6 "")
        (command "_LINE" P7 P8 "")
      ) ;_ Fin de if
      (command "_LAYER" "_S" CL "")
      (setvar "CMDECHO" 1)
    ) ;_ Fin de progn
  ) ;_ Fin de 1er cond

  ((and
           (= (cdr (assoc 0 ENTG1)) "POLYLINE")
           (= (cdr (assoc 0 ENTG2)) "POLYLINE")
      ) ;_ Fin de and
    (progn
      (setq PW (cdr (assoc 40 ENTG1)))
      (command "_EXPLODE" ENTS1)
      (setq ENTS1 (entlast))
      (command "_EXPLODE" ENTS2)
      (setq ENTS2 (entlast))
      (setq ENTG1 (entget ENTS1))
      (setq ENTG2 (entget ENTS2))
      (setq P1 (cdr (assoc 10 ENTG1))
            P2 (cdr (assoc 11 ENTG1))
            P3 (cdr (assoc 10 ENTG2))
            P4 (cdr (assoc 11 ENTG2))
            EL (cdr (assoc 8 ENTG1))
      ) ;_ Fin de setq
      (entdel ENTS1)
      (entdel ENTS2)
      (command "_LAYER" "_S" EL "")
      (if (> (distance P1 P3) (distance P1 P4))
        (setq P5 P1
              P6 P3
        ) ;_ Fin de setq
        (setq P5 P1
              P6 P4
        ) ;_ Fin de setq
      ) ;_ Fin de if
      (if (> (distance P2 P3) (distance P2 P4))
        (setq P7 P2
              P8 P3
        ) ;_ Fin de setq
        (setq P7 P2
              P8 P4
        ) ;_ Fin de setq
      ) ;_ Fin de if
      (if (> (distance P5 P6) (distance P7 P8))
        (command "_PLINE" P5 "_W" PW "" P6 "")
        (command "_PLINE" P7 "_W" PW "" P8 "")
      ) ;_ Fin de if
      (command "_LAYER" "_S" CL "")
      (setvar "CMDECHO" 1)
    ) ;_ Fin de progn
  ) ;_ Fin de 2eme cond

  ((and
           (= (cdr (assoc 0 ENTG1)) "LWPOLYLINE")
           (= (cdr (assoc 0 ENTG2)) "LWPOLYLINE")
      ) ;_ Fin de and
    (progn
      (setq PW (cdr (assoc 40 ENTG1)))
      (command "_EXPLODE" ENTS1)
      (setq ENTS1 (entlast))
      (command "_EXPLODE" ENTS2)
      (setq ENTS2 (entlast))
      (setq ENTG1 (entget ENTS1))
      (setq ENTG2 (entget ENTS2))
      (setq P1 (cdr (assoc 10 ENTG1))
            P2 (cdr (assoc 11 ENTG1))
            P3 (cdr (assoc 10 ENTG2))
            P4 (cdr (assoc 11 ENTG2))
            EL (cdr (assoc 8 ENTG1))
      ) ;_ Fin de setq
      (entdel ENTS1)
      (entdel ENTS2)
      (command "_LAYER" "_S" EL "")
      (if (> (distance P1 P3) (distance P1 P4))
        (setq P5 P1
              P6 P3
        ) ;_ Fin de setq
        (setq P5 P1
              P6 P4
        ) ;_ Fin de setq
      ) ;_ Fin de if
      (if (> (distance P2 P3) (distance P2 P4))
        (setq P7 P2
              P8 P3
        ) ;_ Fin de setq
        (setq P7 P2
              P8 P4
        ) ;_ Fin de setq
      ) ;_ Fin de if
      (if (> (distance P5 P6) (distance P7 P8))
        (command "_PLINE" P5 "_W" PW "" P6 "")
        (command "_PLINE" P7 "_W" PW "" P8 "")
      ) ;_ Fin de if
      (command "_LAYER" "_S" CL "")
      (setvar "CMDECHO" 1)
    ) ;_ Fin de progn
  ) ;_ Fin de 3eme cond



  ((and (= (cdr (assoc 0 ENTG1)) "ARC")
           (= (cdr (assoc 0 ENTG2)) "ARC")
      ) ;_ Fin de and
    (progn
      (setq
        CA (strcase (getstring "\nChanger arcs en cercle? Y or <N> "))
      ) ;_ Fin de setq
      (if (= CA "Y")
        (progn
          (setq P1 (cdr (assoc 10 ENTG1))
                RA (cdr (assoc 40 ENTG1))
          ) ;_ Fin de setq
          (command "_LAYER" "_S" EL "")
          (entdel ENTS1)
          (entdel ENTS2)
          (command "_CIRCLE" P1 RA)
          (command "_LAYER" "_S" CL "")
        ) ;_ Fin de progn
        (progn
          (setq 150X (car (polar (cdr (assoc 10 ENTG1))
                                 (cdr (assoc 50 ENTG1))
                                 (cdr (assoc 40 ENTG1))
                          ) ;_ Fin de polar
                     ) ;_ Fin de car
                150Y (cadr (polar (cdr (assoc 10 ENTG1))
                                  (cdr (assoc 50 ENTG1))
                                  (cdr (assoc 40 ENTG1))
                           ) ;_ Fin de polar
                     ) ;_ Fin de cadr
                151X (car (polar (cdr (assoc 10 ENTG1))
                                 (cdr (assoc 51 ENTG1))
                                 (cdr (assoc 40 ENTG1))
                          ) ;_ Fin de polar
                     ) ;_ Fin de car
                151Y (cadr (polar (cdr (assoc 10 ENTG1))
                                  (cdr (assoc 51 ENTG1))
                                  (cdr (assoc 40 ENTG1))
                           ) ;_ Fin de polar
                     ) ;_ Fin de cadr
                250X (car (polar (cdr (assoc 10 ENTG2))
                                 (cdr (assoc 50 ENTG2))
                                 (cdr (assoc 40 ENTG2))
                          ) ;_ Fin de polar
                     ) ;_ Fin de car
                250Y (cadr (polar (cdr (assoc 10 ENTG2))
                                  (cdr (assoc 50 ENTG2))
                                  (cdr (assoc 40 ENTG2))
                           ) ;_ Fin de polar
                     ) ;_ Fin de cadr
                251X (car (polar (cdr (assoc 10 ENTG2))
                                 (cdr (assoc 51 ENTG2))
                                 (cdr (assoc 40 ENTG2))
                          ) ;_ Fin de polar
                     ) ;_ Fin de car
                251Y (cadr (polar (cdr (assoc 10 ENTG2))
                                  (cdr (assoc 51 ENTG2))
                                  (cdr (assoc 40 ENTG2))
                           ) ;_ Fin de polar
                     ) ;_ Fin de cadr
                AP1  (list 150X 150Y)
                AP2  (list 151X 151Y)
                AP3  (list 251X 251Y)
          ) ;_ Fin de setq
          (command "_LAYER" "_S" EL "")
          (entdel ENTS1)
          (entdel ENTS2)
          (command "_ARC" AP1 AP2 AP3)
          (command "_LAYER" "_S" CL "")
        ) ;_ Fin de progn
      ) ;_ Fin de if
    ) ;_ Fin de progn
  ) ;_ Fin de 3eme cond

);cond generales

) ;_ Fin de defun

I enclose also another lisp, which only works for lines , but it's the type of selection what I want .

Code: [Select]
;serves to rebuild broken [u]lines[/u] by selection window
 ;==============================================================================
 ;      PROJ    Projection du point A sur la droite B C avec verification
 ;              selon D comme la fonction INTERS
 ;==============================================================================

(defun _proj (a b c d)
  (inters b
          c
          a
                (polar a (+ (* 0.5 pi) (angle  b c)) 1.0)
          d
          )
  )


(defun c:reb-lig ( / p q lot la i lb ea eb d p1 p2 p3 p4 d1 d2 ea10 ea11 eb10 eb11 temp)
(setq p nil q nil)
  (initget 1)
  (setq p (getpoint "\nPremier coin : "))
  (initget 1)
  (setq q (getcorner p "\nAutre coin : "))
(setvar "cmdecho" 0)
  (command "_erase" "_w" p q "")
  (if (setq lot (ssget "c" p q))
    (progn
      (while (setq la (ssname lot 0))
        (ssdel la lot)
        (setq i 0)
        (repeat (sslength lot)
          (setq lb (ssname lot i))

          (setq ea (entget la))
          (setq eb (entget lb))
          (setq d
                 (apply '(lambda (e1 e2)
                           (if (= "LINE" (cdr (assoc 0 e1)) (cdr (assoc 0 e2)))
                             (progn
                               (setq p1 (cdr (assoc 10 e1))
                                     p2 (cdr (assoc 11 e1))
                                     p3 (cdr (assoc 10 e2))
                                     p4 (cdr (assoc 11 e2))
                                     d1 (distance p1 (_proj p1 p3 p4 nil))
                                     d2 (distance p2 (_proj p2 p3 p4 nil))
                                     )
                               (if (> 0.001 (abs (- d1 d2)))
                                 d1
                                 nil
                                 )
                               )
                             )
                           )
                        (list ea eb)
                        )
                )

          (cond ((not d) nil)
                ((> 0.001 (abs d))
                 (if (= (cdr (assoc 8 ea)) (cdr (assoc 8 eb)))
                   (progn
                     (setq ea10 (cdr (assoc 10 ea))
                           ea11 (cdr (assoc 11 ea))
                           eb10 (cdr (assoc 10 eb))
                           eb11 (cdr (assoc 11 eb))
                           )
                     (if (> (distance ea10 eb10)
                            (distance ea10 eb11)
                            )
                       (setq temp eb10
                             eb10 eb11
                             eb11 temp
                             )
                       )
                     (if (< (distance ea10 eb10)
                            (distance ea11 eb10)
                            )
                       (setq temp ea10
                             ea10 ea11
                             ea11 temp
                             )
                       )
                     (entdel lb)
                     (entmod (append ea
                                     (list (cons 10 ea10)
                                           (cons 11 eb11)
                                           )
                                     )
                             )
                     T
                     )
                   )
                 )
                (T nil)
                )

          (setq i (1+ i))
          )
       
        )
      )
    )
  (setvar "highlight" 1)
  (redraw)
  (princ)
  )
« Last Edit: February 23, 2012, 04:28:03 AM by sergeluc »