Couper polyligne avec OD à chaque sommet

Hyppolight · le 5 décembre 2015

Bonjour,

J'utilise depuis longtemps le lisp MAPBREAK de (gile) permettant de couper une poyligne en deux tout en conservant les données d'objets sur les 2 poylignes. (Voir fichier lisp ci-joint)

Je viens de découvrir le lisp break_lw de Bonuscad permettant d'itérer sur l'ensemble des polylignes d'un dwg et de les coupés à chaque sommet. (Voir fichier lisp ci-joint)

J'aurais aimé savoir s'il était possible de combiner les deux afin de pouvoir couper toutes les poylignes d'un dwg à chacun de ces sommets tout en conservant les données d'objets?

Par avance merci.

Hyppolight

MAPBRK.lsp

break_lw.lsp

bonuscad · le 5 décembre 2015

Bonjour,

Alors je vais compléter le mien.

RESTRICTIONS: NE COPIE PAS les données empilées. (seul le premier enregistrement est lu)

(defun c:break_lw@vtx_withOD ( / js i ent dxf_obj xd_l dxf_43 dxf_38 dxf_39 dxf_10 dxf_40 dxf_41 dxf_42 dxf_39 dxf_210 n lst_data nwent tbldef )
 (initget "Toutes Sélection _All Select")
 (if (eq (getkword "\nLWPolylignes à couper à chaque sommets? [Toutes/Sélection] <Sélection>: ") "All")
(setq
 	js
   	(ssget "_X" 
     	(list
       	(cons 0 "LWPOLYLINE")
       	(cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
       	(cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
     	)
   	)
 	i -1
)
(setq
 	js
   	(ssget
     	(list
       	(cons 0 "LWPOLYLINE")
       	(cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
       	(cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
     	)
   	)
 	i -1
)
 )
 (cond
(js
 	(repeat (sslength js)
   	(setq
     	dxf_obj (entget (setq ent (ssname js (setq i (1+ i)))) (list "*"))
     	xd_l (assoc -3 dxf_obj)
   	)
   	(if (cdr (assoc 43 dxf_obj))
     	(setq dxf_43 (cdr (assoc 43 dxf_obj)))
     	(setq dxf_43 0.0)
   	)
   	(if (cdr (assoc 38 dxf_obj))
     	(setq dxf_38 (cdr (assoc 38 dxf_obj)))
     	(setq dxf_38 0.0)
   	)
   	(if (cdr (assoc 39 dxf_obj))
     	(setq dxf_39 (cdr (assoc 39 dxf_obj)))
     	(setq dxf_39 0.0)
   	)
   	(setq
     	dxf_10 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_obj))
     	dxf_40 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 40)) dxf_obj))
     	dxf_41 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 41)) dxf_obj))
     	dxf_42 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 42)) dxf_obj))
     	dxf_210 (cdr (assoc 210 dxf_obj))
   	)
   	(if (not (zerop (boole 1 (cdr (assoc 70 dxf_obj)) 1)))
     	(setq
       	dxf_10 (append dxf_10 (list (car dxf_10)))
       	dxf_40 (append dxf_40 (list (car dxf_40)))
       	dxf_41 (append dxf_41 (list (car dxf_41)))
       	dxf_42 (append dxf_42 (list (car dxf_42)))
       	n (cdr (assoc 90 dxf_obj))
     	)
     	(setq n (1- (cdr (assoc 90 dxf_obj))))
   	)
   	(repeat n
     	(entmake
       	(append
         	(list
           	(cons 0 "LWPOLYLINE")
           	(cons 100 "AcDbEntity")
           	(assoc 67 dxf_obj)
           	(assoc 410 dxf_obj)
           	(assoc 8 dxf_obj)
           	(if (assoc 62 dxf_obj) (assoc 62 dxf_obj) (cons 62 256))
           	(if (assoc 6 dxf_obj) (assoc 6 dxf_obj) (cons 6 "BYLAYER"))
           	(if (assoc 370 dxf_obj) (assoc 370 dxf_obj) (cons 370 -1))
           	(cons 100 "AcDbPolyline")
           	(cons 90 2)
           	(cons 70 (boole 1 (cdr (assoc 70 dxf_obj)) 128))
           	(cons 38 dxf_38)
           	(cons 39 dxf_39)
           	(cons 10 (car dxf_10))
           	(cons 40 (car dxf_40))
           	(cons 41 (car dxf_41))
           	(cons 42 (car dxf_42))
           	(cons 10 (cadr dxf_10))
           	(cons 40 (cadr dxf_40))
           	(cons 41 (cadr dxf_41))
           	(cons 42 (cadr dxf_42))
           	(assoc 210 dxf_obj)
         	)
         	(if xd_l (list xd_l) '())
       	)
     	)
     	(setq dxf_10 (cdr dxf_10) dxf_40 (cdr dxf_40) dxf_41 (cdr dxf_41) dxf_42 (cdr dxf_42) lst_data nil nwent (entlast))
     	(if
       	(or
         	(numberp (vl-string-search "Map 3D" (vla-get-caption (vlax-get-acad-object))))
         	(numberp (vl-string-search "Civil 3D" (vla-get-caption (vlax-get-acad-object))))
       	)
       	(progn
         	(foreach n (ade_odgettables ent)
           	(setq tbldef (ade_odtabledefn n))
           	(setq lst_data
             	(cons
               	(mapcar
                 	'(lambda (fld / tmp_rec numrec)
                   	(setq numrec (ade_odrecordqty ent n))
                   	(cons
                     	n
                     	(while (not (zerop numrec))
                       	(setq numrec (1- numrec))
                       	(if (zerop numrec)
                         	(if tmp_rec
                           	(cons fld (list (cons (ade_odgetfield ent n fld numrec) tmp_rec)))
                           	(cons fld (ade_odgetfield ent n fld numrec))
                         	)
                         	(setq tmp_rec (cons (ade_odgetfield ent n fld numrec) tmp_rec))
                       	)
                     	)
                   	)
                 	)
                 	(mapcar 'cdar (cdaddr tbldef))
               	)
               	lst_data
             	)
           	)
         	)
         	(cond
           	(lst_data
             	(mapcar
               	'(lambda (x / ct)
                 	(while (< (ade_odrecordqty nwent (caar x)) (ade_odrecordqty ent (caar x)))
                   	(ade_odaddrecord nwent (caar x))
                 	)
                 	(foreach el (mapcar 'cdr x)
                   	(if (listp (cdr el))
                     	(progn
                       	(setq ct -1)
                       	(mapcar
                         	'(lambda (y / )
                           	(ade_odsetfield nwent (caar x) (car el) (setq ct (1+ ct)) y)
                         	)
                         	(cadr el)
                       	)
                     	)
                     	(ade_odsetfield nwent (caar x) (car el) 0 (cdr el))
                   	)
                 	)
               	)
               	lst_data
             	)
           	)
         	)
       	)
     	)
   	)
   	(entdel ent)
 	)
 	(print (sslength js)) (princ " LWpolyligne(s) coupée(s) à ses sommets avec ses Object Datas.")
)
 )
 (prin1)
)

EDIT du 14-05-19: lève la restriction sur les N records

Modifié le 14 mai 2019 par bonuscad

Hyppolight · le 5 décembre 2015

Re-bonjour,

Un grand merci pour la spontanéité...

J'ai testé sur un petit bout du SIG que j'ai a traité et ca marche parfaitement...

Merci également pour la restriction, je la connaissais mais c'est gentil de préciser.

Bonjour,

Alors je vais compléter le mien.

RESTRICTIONS: NE COPIE PAS les données empilées. (seul le premier enregistrement est lu)

(defun c:break_lw_withOD ( / js i ent dxf_obj dxf_43 dxf_38 dxf_39 dxf_10 dxf_40 dxf_41 dxf_42 dxf_39 dxf_210 n lst_data nwent tbldef )
 (initget "Toutes Sélection _All Select")
 (if (eq (getkword "\nLWPolylignes à couper à chaque sommets? [Toutes/Sélection] <Sélection>: ") "All")
   (setq
     js
       (ssget "_X" 
         (list
           (cons 0 "LWPOLYLINE")
           (cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
           (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
         )
       )
     i -1
   )
   (setq
     js
       (ssget
         (list
           (cons 0 "LWPOLYLINE")
           (cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
           (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
         )
       )
     i -1
   )
 )
 (cond
   (js
     (repeat (sslength js)
       (setq dxf_obj (entget (setq ent (ssname js (setq i (1+ i))))))
       (if (cdr (assoc 43 dxf_obj))
         (setq dxf_43 (cdr (assoc 43 dxf_obj)))
         (setq dxf_43 0.0)
       )
       (if (cdr (assoc 38 dxf_obj))
         (setq dxf_38 (cdr (assoc 38 dxf_obj)))
         (setq dxf_38 0.0)
       )
       (if (cdr (assoc 39 dxf_obj))
         (setq dxf_39 (cdr (assoc 39 dxf_obj)))
         (setq dxf_39 0.0)
       )
       (setq
         dxf_10 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_obj))
         dxf_40 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 40)) dxf_obj))
         dxf_41 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 41)) dxf_obj))
         dxf_42 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 42)) dxf_obj))
         dxf_210 (cdr (assoc 210 dxf_obj))
       )
       (if (not (zerop (boole 1 (cdr (assoc 70 dxf_obj)) 1)))
         (setq
           dxf_10 (append dxf_10 (list (car dxf_10)))
           dxf_40 (append dxf_40 (list (car dxf_40)))
           dxf_41 (append dxf_41 (list (car dxf_41)))
           dxf_42 (append dxf_42 (list (car dxf_42)))
           n (cdr (assoc 90 dxf_obj))
         )
         (setq n (1- (cdr (assoc 90 dxf_obj))))
       )
       (repeat n
         (entmake
           (list
             (cons 0 "LWPOLYLINE")
             (cons 100 "AcDbEntity")
             (assoc 67 dxf_obj)
             (assoc 410 dxf_obj)
             (assoc 8 dxf_obj)
             (if (assoc 62 dxf_obj) (assoc 62 dxf_obj) (cons 62 256))
             (if (assoc 6 dxf_obj) (assoc 6 dxf_obj) (cons 6 "BYLAYER"))
             (if (assoc 370 dxf_obj) (assoc 370 dxf_obj) (cons 370 -1))
             (cons 100 "AcDbPolyline")
             (cons 90 2)
             (cons 70 (boole 1 (cdr (assoc 70 dxf_obj)) 128))
             (cons 38 dxf_38)
             (cons 39 dxf_39)
             (cons 10 (car dxf_10))
             (cons 40 (car dxf_40))
             (cons 41 (car dxf_41))
             (cons 42 (car dxf_42))
             (cons 10 (cadr dxf_10))
             (cons 40 (cadr dxf_40))
             (cons 41 (cadr dxf_41))
             (cons 42 (cadr dxf_42))
             (assoc 210 dxf_obj)
           )
         )
         (setq dxf_10 (cdr dxf_10) dxf_40 (cdr dxf_40) dxf_41 (cdr dxf_41) dxf_42 (cdr dxf_42) lst_data nil nwent (entlast))
         (foreach n (ade_odgettables ent)
           (setq tbldef (ade_odtabledefn n))
           (setq lst_data (cons (mapcar '(lambda (fld) (cons n (cons fld (ade_odgetfield ent n fld 0)))) (mapcar 'cdar (cdr (nth 2 tbldef)))) lst_data))
         )
         (cond
           (lst_data
             (mapcar '(lambda (x) (ade_odaddrecord nwent (caar x)) (foreach el x (ade_odsetfield nwent (car el) (cadr el) 0 (cddr el)))) lst_data)
           )
         )
       )
       (entdel ent)
     )
     (print (sslength js)) (princ " LWpolyligne(s) coupée(s) à ses sommets avec ses Object Datas.")
   )
 )
 (prin1)
)

lili2006 · le 5 décembre 2015

Bonsoir à toutes et tous,

RESTRICTIONS: NE COPIE PAS les données empilées. (seul le premier enregistrement est lu)

Quelqu'un pourrait développer un peu SVP ?

Merci d'avance,

lecrabe · le 7 décembre 2015

Hello

Avec AutoCAD MAP (ou CIVIL) on affecte une table OD (prealablement definie) sur un objet graphique, et ensuite on "remplit" les ODs ...

Sauf que (si on manipule MAL), on peut avoir N records OD pour UNE table OD !

Dans ce cas, on ne voit par la case de dialogue des proprietes (ou par un MAPEXPORT) que le PREMIER record OD !!

Seule la commande ADEEDITDATA (ou par programmation) permet de voir/modifier/supprimer les N records OD !!!

Bye, lecrabe

lili2006 · le 7 décembre 2015

Bonsoir à toutes et tous,

Salut Patrice,

Merci pour ces précisions mais comment on peut avoir =>

N records OD pour UNE table OD

! ???

Merci d'avance,

(PS: Tu connais mon niveau sous MAp d'ou cette demande de précision,...)

bonuscad · le 14 mai 2019

Bonjour à tous,

Alors 4 ans après, toujours dans la même optique: couper une LWPOLYLINE (avec ou sans arc, fermée ou pas) sans perdre les données d'objet attachés mais à la différence qu'ici cela permettra de couper celles-ci aux intersections avec d'autres objets.Normalement (si pas de bug) copie aussi les N records et les Xdata si existants et fonctionne depuis et dans n'importe quel SCU.

J'ai fais des tests qui se sont bien déroulés, mais des cas entraînant un bug reste possible.Je vais aussi éditer le post #2 pour le mettre au goût du jour.

Ces routines doivent pouvoir aussi fonctionner sans Autocad Map ou Civil, mais dans ce cas bien sur les OD ne sont pas traitées.

(vl-load-com)
(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)
)
(defun c:break_lw_withOD ( / js i js_b i ent obj nb tmp_obj vrt_pt pt lst_pt dxf_obj xd_l dxf_43 dxf_38 dxf_39 dxf_10 dxf_40 dxf_41 dxf_42 dxf_39 dxf_210 n_vtx l nwent tbldef lst_data)
 (princ "\nSélection des LWPOLYLINE à couper")
 (setq js
(ssget
 	(list
   	(cons 0 "LWPOLYLINE")
   	(cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
   	(cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
 	)
)
 )
 (princ "\nSélection des objets curvilignes coupant les polylignes")
 (setq js_b
(ssget
 	(list
   	(cons 0 "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE,XLINE,RAY,MPOLYGON")
   	(cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
   	(cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
 	)
)
 )
 (cond
((and js js_B)
 	(repeat (setq i (sslength js))
   	(setq
     	ent (ssname js (setq i (1- i)))
     	obj (vlax-ename->vla-object ent)
   	)
   	(repeat (setq nb (sslength js_B))
     	(setq tmp_name (ssname js_b (setq nb (1- nb))))
     	(cond
       	(tmp_name
         	(setq
           	tmp_obj (vlax-ename->vla-object tmp_name)
           	vrt_pt (vlax-variant-value (vla-IntersectWith obj tmp_obj 0))
         	)
         	(if (>= (vlax-safearray-get-u-bound vrt_pt 1) 0)
           	(progn
             	(setq pt (vlax-safearray->list vrt_pt))
             	(if pt
               	(if (> (length pt) 3)
                 	(repeat (/ (length pt) 3)
                   	(setq lst_pt (cons (list (car pt) (cadr pt) (caddr pt)) lst_pt) pt (cdddr pt))
                 	)
                 	(setq lst_pt (cons pt lst_pt))
               	)
             	)
           	)
         	)
       	)
     	)
   	)
   	(if (and lst_pt (listp lst_pt))
     	(foreach el lst_pt
       	(add_vtx obj (vlax-curve-getparamatpoint obj (vlax-curve-getClosestPointTo obj el)) ent)
     	)
   	)
   	(setq
     	dxf_obj (entget (vlax-vla-object->ename obj) (list "*"))
     	xd_l (assoc -3 dxf_obj)
   	)
   	(if (cdr (assoc 43 dxf_obj))
     	(setq dxf_43 (cdr (assoc 43 dxf_obj)))
     	(setq dxf_43 0.0)
   	)
   	(if (cdr (assoc 38 dxf_obj))
     	(setq dxf_38 (cdr (assoc 38 dxf_obj)))
     	(setq dxf_38 0.0)
   	)
   	(if (cdr (assoc 39 dxf_obj))
     	(setq dxf_39 (cdr (assoc 39 dxf_obj)))
     	(setq dxf_39 0.0)
   	)
   	(setq
     	dxf_10 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_obj))
     	dxf_40 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 40)) dxf_obj))
     	dxf_41 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 41)) dxf_obj))
     	dxf_42 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 42)) dxf_obj))
     	dxf_210 (cdr (assoc 210 dxf_obj))
   	)
   	(if (not (zerop (boole 1 (cdr (assoc 70 dxf_obj)) 1)))
     	(setq
       	dxf_10 (append dxf_10 (list (car dxf_10)))
       	dxf_40 (append dxf_40 (list (car dxf_40)))
       	dxf_41 (append dxf_41 (list (car dxf_41)))
       	dxf_42 (append dxf_42 (list (car dxf_42)))
     	)
   	)
   	(setq lst_pt (reverse (mapcar '(lambda (x) (list (car (trans x 0 ent)) (cadr (trans x 0 ent)))) lst_pt)))
   	(repeat (length lst_pt)
     	(setq n_vtx -1 l nil)
     	(entmake
       	(append
         	(list
           	(cons 0 "LWPOLYLINE")
           	(cons 100 "AcDbEntity")
           	(assoc 67 dxf_obj)
           	(assoc 410 dxf_obj)
           	(assoc 8 dxf_obj)
           	(if (assoc 62 dxf_obj) (assoc 62 dxf_obj) (cons 62 256))
           	(if (assoc 6 dxf_obj) (assoc 6 dxf_obj) (cons 6 "BYLAYER"))
           	(if (assoc 370 dxf_obj) (assoc 370 dxf_obj) (cons 370 -1))
           	(cons 100 "AcDbPolyline")
           	(cons 90 (1+ (vl-position T (mapcar '(lambda (x) (equal x (car lst_pt) 1E-8)) dxf_10))))
           	(cons 70 (boole 1 (cdr (assoc 70 dxf_obj)) 128))
           	(cons 38 dxf_38)
           	(cons 39 dxf_39)
         	)
         	(reverse
           	(repeat (1+ (vl-position T (mapcar '(lambda (x) (equal x (car lst_pt) 1E-8)) dxf_10)))
             	(setq l
               	(append
                 	(list
                   	(cons 42 (nth (1+ n_vtx) dxf_42))
                   	(cons 41 (nth (1+ n_vtx) dxf_41))
                   	(cons 40 (nth (1+ n_vtx) dxf_40))
                   	(cons 10 (nth (setq n_vtx (1+ n_vtx)) dxf_10))
                 	)
                 	l
               	)
             	)
           	)
         	)
         	(list (assoc 210 dxf_obj))
         	(if xd_l (list xd_l) '())
       	)
     	)
     	(repeat n_vtx
       	(setq dxf_10 (cdr dxf_10) dxf_40 (cdr dxf_40) dxf_41 (cdr dxf_41) dxf_42 (cdr dxf_42))
     	)
     	(setq lst_pt (cdr lst_pt) lst_data nil nwent (entlast))
     	(if
       	(or
         	(numberp (vl-string-search "Map 3D" (vla-get-caption (vlax-get-acad-object))))
         	(numberp (vl-string-search "Civil 3D" (vla-get-caption (vlax-get-acad-object))))
       	)
       	(progn
         	(foreach n (ade_odgettables ent)
           	(setq tbldef (ade_odtabledefn n))
           	(setq lst_data
             	(cons
               	(mapcar
                 	'(lambda (fld / tmp_rec numrec)
                   	(setq numrec (ade_odrecordqty ent n))
                   	(cons
                     	n
                     	(while (not (zerop numrec))
                       	(setq numrec (1- numrec))
                       	(if (zerop numrec)
                         	(if tmp_rec
                           	(cons fld (list (cons (ade_odgetfield ent n fld numrec) tmp_rec)))
                           	(cons fld (ade_odgetfield ent n fld numrec))
                         	)
                         	(setq tmp_rec (cons (ade_odgetfield ent n fld numrec) tmp_rec))
                       	)
                     	)
                   	)
                 	)
                 	(mapcar 'cdar (cdaddr tbldef))
               	)
               	lst_data
             	)
           	)
         	)
         	(cond
           	(lst_data
             	(mapcar
               	'(lambda (x / ct)
                 	(while (< (ade_odrecordqty nwent (caar x)) (ade_odrecordqty ent (caar x)))
                   	(ade_odaddrecord nwent (caar x))
                 	)
                 	(foreach el (mapcar 'cdr x)
                   	(if (listp (cdr el))
                     	(progn
                       	(setq ct -1)
                       	(mapcar
                         	'(lambda (y / )
                           	(ade_odsetfield nwent (caar x) (car el) (setq ct (1+ ct)) y)
                         	)
                         	(cadr el)
                       	)
                     	)
                     	(ade_odsetfield nwent (caar x) (car el) 0 (cdr el))
                   	)
                 	)
               	)
               	lst_data
             	)
           	)
         	)
       	)
     	)
   	)
   	(setq n_vtx -1 l nil)
   	(entmake
     	(append
       	(list
         	(cons 0 "LWPOLYLINE")
         	(cons 100 "AcDbEntity")
         	(assoc 67 dxf_obj)
         	(assoc 410 dxf_obj)
         	(assoc 8 dxf_obj)
         	(if (assoc 62 dxf_obj) (assoc 62 dxf_obj) (cons 62 256))
         	(if (assoc 6 dxf_obj) (assoc 6 dxf_obj) (cons 6 "BYLAYER"))
         	(if (assoc 370 dxf_obj) (assoc 370 dxf_obj) (cons 370 -1))
         	(cons 100 "AcDbPolyline")
         	(cons 90 (length dxf_10))
         	(cons 70 (boole 1 (cdr (assoc 70 dxf_obj)) 128))
         	(cons 38 dxf_38)
         	(cons 39 dxf_39)
       	)
       	(reverse
       	(repeat (length dxf_10)
         	(setq l
           	(append
             	(list
               	(cons 42 (nth (1+ n_vtx) dxf_42))
               	(cons 41 (nth (1+ n_vtx) dxf_41))
               	(cons 40 (nth (1+ n_vtx) dxf_40))
               	(cons 10 (nth (setq n_vtx (1+ n_vtx)) dxf_10))
             	)
             	l
           	)
         	)
       	)
       	)
       	(list (assoc 210 dxf_obj))
       	(if xd_l (list xd_l) '())
     	)
   	)
   	(setq lst_data nil nwent (entlast))
   	(if
     	(or
       	(numberp (vl-string-search "Map 3D" (vla-get-caption (vlax-get-acad-object))))
       	(numberp (vl-string-search "Civil 3D" (vla-get-caption (vlax-get-acad-object))))
     	)
     	(progn
       	(foreach n (ade_odgettables ent)
         	(setq tbldef (ade_odtabledefn n))
         	(setq lst_data
           	(cons
             	(mapcar
               	'(lambda (fld / tmp_rec numrec)
                 	(setq numrec (ade_odrecordqty ent n))
                 	(cons
                   	n
                   	(while (not (zerop numrec))
                     	(setq numrec (1- numrec))
                     	(if (zerop numrec)
                       	(if tmp_rec
                         	(cons fld (list (cons (ade_odgetfield ent n fld numrec) tmp_rec)))
                         	(cons fld (ade_odgetfield ent n fld numrec))
                       	)
                       	(setq tmp_rec (cons (ade_odgetfield ent n fld numrec) tmp_rec))
                     	)
                   	)
                 	)
               	)
               	(mapcar 'cdar (cdaddr tbldef))
             	)
             	lst_data
           	)
         	)
       	)
       	(cond
         	(lst_data
           	(mapcar
             	'(lambda (x / ct)
               	(while (< (ade_odrecordqty nwent (caar x)) (ade_odrecordqty ent (caar x)))
                 	(ade_odaddrecord nwent (caar x))
               	)
               	(foreach el (mapcar 'cdr x)
                 	(if (listp (cdr el))
                   	(progn
                     	(setq ct -1)
                     	(mapcar
                       	'(lambda (y / )
                         	(ade_odsetfield nwent (caar x) (car el) (setq ct (1+ ct)) y)
                       	)
                       	(cadr el)
                     	)
                   	)
                   	(ade_odsetfield nwent (caar x) (car el) 0 (cdr el))
                 	)
               	)
             	)
             	lst_data
           	)
         	)
       	)
     	)
   	)
   	(entdel ent)
 	)
 	(print (sslength js)) (princ " LWpolyligne(s) coupée(s) aux points d'intersection  avec ses Object Datas.")
)
 )
 (prin1)
)

Hyppolight · le 14 mai 2019

Bonjour,

4 ans après, nouvelle phase de test... je viens de mettre à jour le lisp et la mise à jour a l'air de bien fonctionner.. ;)

Ci-dessous le lisp pour traiter toutes les entités d'un fichiers

(defun c:BREAK_LW_WITH_OD ( / js i ent dxf_obj dxf_43 dxf_38 dxf_39 dxf_10 dxf_40 dxf_41 dxf_42 dxf_39 dxf_210 n lst_data nwent tbldef )
 (initget "Toutes Sélection _All Select")
 (if (eq (getkword "\nLWPolylignes à couper à chaque sommets? [Toutes/Sélection] <Sélection>: ") "All")
   (setq
     js
       (ssget "_X" 
         (list
           (cons 0 "LWPOLYLINE")
           (cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
           (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
         )
       )
     i -1
   )
   (setq
     js
       (ssget
         (list
           (cons 0 "LWPOLYLINE")
           (cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
           (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
         )
       )
     i -1
   )
 )
 (cond
   (js
     (repeat (sslength js)
       (setq dxf_obj (entget (setq ent (ssname js (setq i (1+ i))))))
       (if (cdr (assoc 43 dxf_obj))
         (setq dxf_43 (cdr (assoc 43 dxf_obj)))
         (setq dxf_43 0.0)
       )
       (if (cdr (assoc 38 dxf_obj))
         (setq dxf_38 (cdr (assoc 38 dxf_obj)))
         (setq dxf_38 0.0)
       )
       (if (cdr (assoc 39 dxf_obj))
         (setq dxf_39 (cdr (assoc 39 dxf_obj)))
         (setq dxf_39 0.0)
       )
       (setq
         dxf_10 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_obj))
         dxf_40 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 40)) dxf_obj))
         dxf_41 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 41)) dxf_obj))
         dxf_42 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 42)) dxf_obj))
         dxf_210 (cdr (assoc 210 dxf_obj))
       )
       (if (not (zerop (boole 1 (cdr (assoc 70 dxf_obj)) 1)))
         (setq
           dxf_10 (append dxf_10 (list (car dxf_10)))
           dxf_40 (append dxf_40 (list (car dxf_40)))
           dxf_41 (append dxf_41 (list (car dxf_41)))
           dxf_42 (append dxf_42 (list (car dxf_42)))
           n (cdr (assoc 90 dxf_obj))
         )
         (setq n (1- (cdr (assoc 90 dxf_obj))))
       )
       (repeat n
         (entmake
           (list
             (cons 0 "LWPOLYLINE")
             (cons 100 "AcDbEntity")
             (assoc 67 dxf_obj)
             (assoc 410 dxf_obj)
             (assoc 8 dxf_obj)
             (if (assoc 62 dxf_obj) (assoc 62 dxf_obj) (cons 62 256))
             (if (assoc 6 dxf_obj) (assoc 6 dxf_obj) (cons 6 "BYLAYER"))
             (if (assoc 370 dxf_obj) (assoc 370 dxf_obj) (cons 370 -1))
             (cons 100 "AcDbPolyline")
             (cons 90 2)
             (cons 70 (boole 1 (cdr (assoc 70 dxf_obj)) 128))
             (cons 38 dxf_38)
             (cons 39 dxf_39)
             (cons 10 (car dxf_10))
             (cons 40 (car dxf_40))
             (cons 41 (car dxf_41))
             (cons 42 (car dxf_42))
             (cons 10 (cadr dxf_10))
             (cons 40 (cadr dxf_40))
             (cons 41 (cadr dxf_41))
             (cons 42 (cadr dxf_42))
             (assoc 210 dxf_obj)
           )
         )
         (setq dxf_10 (cdr dxf_10) dxf_40 (cdr dxf_40) dxf_41 (cdr dxf_41) dxf_42 (cdr dxf_42) lst_data nil nwent (entlast))
         (foreach n (ade_odgettables ent)
           (setq tbldef (ade_odtabledefn n))
           (setq lst_data (cons (mapcar '(lambda (fld) (cons n (cons fld (ade_odgetfield ent n fld 0)))) (mapcar 'cdar (cdr (nth 2 tbldef)))) lst_data))
         )
         (cond
           (lst_data
             (mapcar '(lambda (x) (ade_odaddrecord nwent (caar x)) (foreach el x (ade_odsetfield nwent (car el) (cadr el) 0 (cddr el)))) lst_data)
           )
         )
       )
       (entdel ent)
     )
     (print (sslength js)) (princ " LWpolyligne(s) coupée(s) à ses sommets avec ses Object Datas.")
   )
 )
 (prin1)
)

lecrabe · le 31 mai 2019

Hello Bruno

1) Merci pour cette nouvelle version !

2) SVP n'aurais tu pas en stock une version légèrement différente ?

A - Sélection classique...

Ne retenir que les Blocs et Points

Parfaitement insérés à des extrémités de segments/arcs des Polylignes

B - Sélection classique...

Ne retenir que les Polylignes 2D

C - Couper aux Intersections en gardant les ODs de chaque côté...

Ne pas oublier que le MEME Bloc/Point peut être sur plusieurs Polylignes !

Souvent des Polylignes qui se croisent avec un Bloc/Point a l'Intersection ...

Merci d'avance, Bye, lecrabe

bonuscad · le 5 juin 2019

Pour Patrice,

Essayes ceci, voir si ça convient. Après quelques tests cela semble bon mais je n'ai peut être pas vu tous les cas de figure...

(vl-load-com)
(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)
)
(defun c:break_lw@pt_withOD ( / js typ_ent js_b i ent obj nb tmp_name pt lst_pt dxf_obj xd_l dxf_43 dxf_38 dxf_39 dxf_10 dxf_40 dxf_41 dxf_42 dxf_39 dxf_210 tmp_sort lst_pt_sort n_vtx l nwent tbldef lst_data)
 (princ "\nSélection des LWPOLYLINE à couper")
 (while
(not 
 	(setq js
   	(ssget
     	(list
       	(cons 0 "LWPOLYLINE")
       	(cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
       	(cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
     	)
   	)
 	)
)
 )
 (initget "POINT CERCLE INSERTION _POINT CIRCLE INSERT")
 (setq typ_ent (getkword "\nCouper avec [POINT/CERCLE/INSERTION]? <POINT>: "))
 (if (not typ_ent) (setq typ_ent "POINT"))
 (princ (strcat "\nSélection des " typ_ent " situés sur les polylignes"))
 (while
(not
 	(setq js_b
   	(ssget
     	(list
       	(cons 0 typ_ent)
       	(cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
       	(cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
     	)
   	)
 	)
)
 )
 (cond
((and js js_B)
 	(repeat (setq i (sslength js))
   	(setq
     	ent (ssname js (setq i (1- i)))
     	obj (vlax-ename->vla-object ent)
     	lst_pt nil
   	)
   	(repeat (setq nb (sslength js_B))
     	(setq tmp_name (ssname js_b (setq nb (1- nb))))
     	(cond
       	(tmp_name
         	(setq pt (cdr (assoc 10 (entget tmp_name))))
         	(if
           	(and
             	(equal (distance pt (vlax-curve-getClosestPointTo obj pt)) 0.0 1E-8)
             	(not (equal (distance pt (vlax-curve-getStartPoint obj)) 0.0 1E-8))
             	(not (equal (distance pt (vlax-curve-getEndPoint obj)) 0.0 1E-8))
           	)
           	(setq lst_pt (cons pt lst_pt))
         	)
       	)
     	)
   	)
   	(setq dxf_10 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))))
   	(cond
     	((and lst_pt (listp lst_pt))
       	(foreach el lst_pt
         	(if (not (member T (mapcar '(lambda (x) (equal (list (car el) (cadr el)) x 1E-8)) dxf_10)))
           	(add_vtx obj (vlax-curve-getparamatpoint obj (vlax-curve-getClosestPointTo obj el)) ent)
         	)
       	)
       	(setq
         	dxf_obj (entget ent (list "*"))
         	xd_l (assoc -3 dxf_obj)
       	)
       	(if (cdr (assoc 43 dxf_obj))
         	(setq dxf_43 (cdr (assoc 43 dxf_obj)))
         	(setq dxf_43 0.0)
       	)
       	(if (cdr (assoc 38 dxf_obj))
         	(setq dxf_38 (cdr (assoc 38 dxf_obj)))
         	(setq dxf_38 0.0)
       	)
       	(if (cdr (assoc 39 dxf_obj))
         	(setq dxf_39 (cdr (assoc 39 dxf_obj)))
         	(setq dxf_39 0.0)
       	)
       	(setq
         	dxf_10 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_obj))
         	dxf_40 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 40)) dxf_obj))
         	dxf_41 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 41)) dxf_obj))
         	dxf_42 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 42)) dxf_obj))
         	dxf_210 (cdr (assoc 210 dxf_obj))
       	)
       	(if (not (zerop (boole 1 (cdr (assoc 70 dxf_obj)) 1)))
         	(setq
           	dxf_10 (append dxf_10 (list (car dxf_10)))
           	dxf_40 (append dxf_40 (list (car dxf_40)))
           	dxf_41 (append dxf_41 (list (car dxf_41)))
           	dxf_42 (append dxf_42 (list (car dxf_42)))
         	)
       	)
       	(setq
         	lst_pt (mapcar '(lambda (x) (list (car (trans x 0 ent)) (cadr (trans x 0 ent)))) lst_pt)
         	tmp_sort (mapcar '(lambda (x) (vlax-curve-getDistAtPoint obj x)) lst_pt)
         	lst_pt_sort nil
       	)
       	(foreach j (vl-sort tmp_sort '<) (setq lst_pt_sort (cons (nth (vl-position j tmp_sort) lst_pt) lst_pt_sort)))
       	(setq lst_pt (reverse lst_pt_sort))
       	(repeat (length lst_pt)
         	(setq n_vtx -1 l nil)
         	(cond
           	((vl-position T (mapcar '(lambda (x) (equal x (car lst_pt) 1E-8)) dxf_10))
             	(entmake
               	(append
                 	(list
                   	(cons 0 "LWPOLYLINE")
                   	(cons 100 "AcDbEntity")
                   	(assoc 67 dxf_obj)
                   	(assoc 410 dxf_obj)
                   	(assoc 8 dxf_obj)
                   	(if (assoc 62 dxf_obj) (assoc 62 dxf_obj) (cons 62 256))
                   	(if (assoc 6 dxf_obj) (assoc 6 dxf_obj) (cons 6 "BYLAYER"))
                   	(if (assoc 370 dxf_obj) (assoc 370 dxf_obj) (cons 370 -1))
                   	(cons 100 "AcDbPolyline")
                   	(cons 90 (1+ (vl-position T (mapcar '(lambda (x) (equal x (car lst_pt) 1E-8)) dxf_10))))
                   	(cons 70 (boole 1 (cdr (assoc 70 dxf_obj)) 128))
                   	(cons 38 dxf_38)
                   	(cons 39 dxf_39)
                 	)
                 	(reverse
                   	(repeat (1+ (vl-position T (mapcar '(lambda (x) (equal x (car lst_pt) 1E-8)) dxf_10)))
                     	(setq l
                       	(append
                         	(list
                           	(cons 42 (nth (1+ n_vtx) dxf_42))
                           	(cons 41 (nth (1+ n_vtx) dxf_41))
                           	(cons 40 (nth (1+ n_vtx) dxf_40))
                           	(cons 10 (nth (setq n_vtx (1+ n_vtx)) dxf_10))
                         	)
                         	l
                       	)
                     	)
                   	)
                 	)
                 	(list (assoc 210 dxf_obj))
                 	(if xd_l (list xd_l) '())
               	)
             	)
             	(repeat n_vtx
               	(setq dxf_10 (cdr dxf_10) dxf_40 (cdr dxf_40) dxf_41 (cdr dxf_41) dxf_42 (cdr dxf_42))
             	)
             	(setq lst_pt (cdr lst_pt) lst_data nil nwent (entlast))
             	(if
               	(or
                 	(numberp (vl-string-search "Map 3D" (vla-get-caption (vlax-get-acad-object))))
                 	(numberp (vl-string-search "Civil 3D" (vla-get-caption (vlax-get-acad-object))))
               	)
               	(progn
                 	(foreach n (ade_odgettables ent)
                   	(setq tbldef (ade_odtabledefn n))
                   	(setq lst_data
                     	(cons
                       	(mapcar
                         	'(lambda (fld / tmp_rec numrec)
                           	(setq numrec (ade_odrecordqty ent n))
                           	(cons
                             	n
                             	(while (not (zerop numrec))
                               	(setq numrec (1- numrec))
                               	(if (zerop numrec)
                                 	(if tmp_rec
                                   	(cons fld (list (cons (ade_odgetfield ent n fld numrec) tmp_rec)))
                                   	(cons fld (ade_odgetfield ent n fld numrec))
                                 	)
                                 	(setq tmp_rec (cons (ade_odgetfield ent n fld numrec) tmp_rec))
                               	)
                             	)
                           	)
                         	)
                         	(mapcar 'cdar (cdaddr tbldef))
                       	)
                       	lst_data
                     	)
                   	)
                 	)
                 	(cond
                   	(lst_data
                     	(mapcar
                       	'(lambda (x / ct)
                         	(while (< (ade_odrecordqty nwent (caar x)) (ade_odrecordqty ent (caar x)))
                           	(ade_odaddrecord nwent (caar x))
                         	)
                         	(foreach el (mapcar 'cdr x)
                           	(if (listp (cdr el))
                             	(progn
                               	(setq ct -1)
                               	(mapcar
                                 	'(lambda (y / )
                                   	(ade_odsetfield nwent (caar x) (car el) (setq ct (1+ ct)) y)
                                 	)
                                 	(cadr el)
                               	)
                             	)
                             	(ade_odsetfield nwent (caar x) (car el) 0 (cdr el))
                           	)
                         	)
                       	)
                       	lst_data
                     	)
                   	)
                 	)
               	)
             	)
           	)
           	(T (print "pas membre")(setq lst_pt (cdr lst_pt) lst_data nil))
         	)
       	)
       	(setq n_vtx -1 l nil)
       	(entmake
         	(append
           	(list
             	(cons 0 "LWPOLYLINE")
             	(cons 100 "AcDbEntity")
             	(assoc 67 dxf_obj)
             	(assoc 410 dxf_obj)
             	(assoc 8 dxf_obj)
             	(if (assoc 62 dxf_obj) (assoc 62 dxf_obj) (cons 62 256))
             	(if (assoc 6 dxf_obj) (assoc 6 dxf_obj) (cons 6 "BYLAYER"))
             	(if (assoc 370 dxf_obj) (assoc 370 dxf_obj) (cons 370 -1))
             	(cons 100 "AcDbPolyline")
             	(cons 90 (length dxf_10))
             	(cons 70 (boole 1 (cdr (assoc 70 dxf_obj)) 128))
             	(cons 38 dxf_38)
             	(cons 39 dxf_39)
           	)
           	(reverse
           	(repeat (length dxf_10)
             	(setq l
               	(append
                 	(list
                   	(cons 42 (nth (1+ n_vtx) dxf_42))
                   	(cons 41 (nth (1+ n_vtx) dxf_41))
                   	(cons 40 (nth (1+ n_vtx) dxf_40))
                   	(cons 10 (nth (setq n_vtx (1+ n_vtx)) dxf_10))
                 	)
                 	l
               	)
             	)
           	)
           	)
           	(list (assoc 210 dxf_obj))
           	(if xd_l (list xd_l) '())
         	)
       	)
       	(setq lst_data nil nwent (entlast))
       	(if
         	(or
           	(numberp (vl-string-search "Map 3D" (vla-get-caption (vlax-get-acad-object))))
           	(numberp (vl-string-search "Civil 3D" (vla-get-caption (vlax-get-acad-object))))
         	)
         	(progn
           	(foreach n (ade_odgettables ent)
             	(setq tbldef (ade_odtabledefn n))
             	(setq lst_data
               	(cons
                 	(mapcar
                   	'(lambda (fld / tmp_rec numrec)
                     	(setq numrec (ade_odrecordqty ent n))
                     	(cons
                       	n
                       	(while (not (zerop numrec))
                         	(setq numrec (1- numrec))
                         	(if (zerop numrec)
                           	(if tmp_rec
                             	(cons fld (list (cons (ade_odgetfield ent n fld numrec) tmp_rec)))
                             	(cons fld (ade_odgetfield ent n fld numrec))
                           	)
                           	(setq tmp_rec (cons (ade_odgetfield ent n fld numrec) tmp_rec))
                         	)
                       	)
                     	)
                   	)
                   	(mapcar 'cdar (cdaddr tbldef))
                 	)
                 	lst_data
               	)
             	)
           	)
           	(cond
             	(lst_data
               	(mapcar
                 	'(lambda (x / ct)
                   	(while (< (ade_odrecordqty nwent (caar x)) (ade_odrecordqty ent (caar x)))
                     	(ade_odaddrecord nwent (caar x))
                   	)
                   	(foreach el (mapcar 'cdr x)
                     	(if (listp (cdr el))
                       	(progn
                         	(setq ct -1)
                         	(mapcar
                           	'(lambda (y / )
                             	(ade_odsetfield nwent (caar x) (car el) (setq ct (1+ ct)) y)
                           	)
                           	(cadr el)
                         	)
                       	)
                       	(ade_odsetfield nwent (caar x) (car el) 0 (cdr el))
                     	)
                   	)
                 	)
                 	lst_data
               	)
             	)
           	)
         	)
       	)
       	(entdel ent)
     	)
   	)
 	)
 	(print (sslength js)) (princ " LWpolyligne(s) coupée(s) aux points avec ses Object Datas.")
)
 )
 (prin1)
)

AzRoDoRzA · le 17 juillet 2019

Salut!

J'ai testé ces codes mais aucun d'entre eux me garde mes OD de polylignes, peut être que je m'y prend mal?

Je choisis ma polyligne à couper, je selectionne les points d'intersections, ça coupe parfaitement mais quand je vais dans les propriété de ma polyligne ou dans adeeditdata, je n'ai plus mes OD...

J'ai éssayé de la couper juste en 2, mais je n'ai d'OD dans aucune des deux partie de polyligne.

Est-ce que je l'utilise mal ? Ou est-ce que les OD sont stockées ailleurs ?

D'avance merci :)

Hyppolight · le 19 juillet 2019

Salut AzRoDoRzA

Peux-tu déposee ton fichier en pièce jointe pour voir ce qui ne va.

Merci

Salut!

J'ai testé ces codes mais aucun d'entre eux me garde mes OD de polylignes, peut être que je m'y prend mal?

Je choisis ma polyligne à couper, je selectionne les points d'intersections, ça coupe parfaitement mais quand je vais dans les propriété de ma polyligne ou dans adeeditdata, je n'ai plus mes OD...

J'ai éssayé de la couper juste en 2, mais je n'ai d'OD dans aucune des deux partie de polyligne.

Est-ce que je l'utilise mal ? Ou est-ce que les OD sont stockées ailleurs ?

D'avance merci :)

Aleck_Ultimate · le 19 juillet 2019

Salut.

Au cas où, pour ce qui est des pièces jointes et images : Mon lien

Cordialy.

AzRoDoRzA · le 19 juillet 2019

Salut!

Je t'ai envoyé le lien en MP car c'est un fichier que je ne peux partager désolé..

Merci de ta compréhension et de ton soutiens :)

Hyppolight · le 19 juillet 2019

Je t'ai répondu en MP... Bonne fin de journée.

Salut!

Je t'ai envoyé le lien en MP car c'est un fichier que je ne peux partager désolé..

Merci de ta compréhension et de ton soutiens :)

lecrabe · le 19 juillet 2019

Hello

Alors SVP est ce que la routine Break_LW de Bonuscad / Bruno est OK ??

Bye, lecrabe "triste" en Vacs

AzRoDoRzA · le 22 juillet 2019

Hello

Alors le lisp de Hyppolight fonctionne et coupe les polylignes à chaque sommet en gardant les OD, en revanche, j'ai un soucis avec le premier Lisp de BonusCad (celui du 14 Mai).

Son Lisp coupe bien les polylignes à chaque croisement d'une autre polyligne séléctionnée, en revanche, je n'ai plus mes OD.. Je n'ai pas testé sa nouvelle version car elle ne permet pas de couper les polylignes à chaque croisement d'une autre comme le faisait son ancien code.

Bye!

AzRoDoRzA · le 23 juillet 2019

Hello,

J'ai créé un petit programme pour couper des polylignes à chaque intersection (inspiré du code de Bonuscad, merci ^^) mais j'ai un petit problème assez embêtant, ça ne coupe pas la bonne polyligne (en fait ça coupe toujours la même quoi que je change).

Du coup voici le code:

(vl-load-com)
(defun c:cuttingpoly()
(setq pt 
	(vlax-safearray->list 
		(setq vrt_pt 
			(vlax-variant-value 
				(vla-IntersectWith 
					(setq obj
						(vlax-ename->vla-object 
							(setq ent(ssname(ssget) 0 ))
						)
					) 
					(setq tmp_obj
						(vlax-ename->vla-object 
							(setq tmp_name(ssname(ssget) 0))
						)
					) 
				0)
			)
		)
	)
)
(command "_break" "_none" pt "_none" "@")
)

Il prend en paramètre 2 polylignes et coupe à l'intersection de ces 2 polylignes (bon c'est la première fois que je code en Lisp donc le code est pas très beau ^^)

Donc ma question: Qu'est-ce que je dois rajouter dans mon code pour lui dire de couper la première polyligne sélectionnée ?

Bye!

PS: Si je rajoute le code COPY_DATA de Hyppolight et que je rajoute

(COPY_DATA ent (entlast) T)

après la commande break, ça fonctionne nickel, en considérant que "ent" soit la polyligne coupée.

Hyppolight · le 23 juillet 2019

Bonjour,

Ci-dessous un lisp non testé trouvé sur le NET

breakall

;;;=======================[ BreakObjects.lsp ]==============================
;;; Author: Copyright© 2006,2007 Charles Alan Butler 
;;; Contact @  www.TheSwamp.org
;;; Version:  1.3 April 9,2007
;;; Globalization by XANADU - www.xanadu.cz
;;; Purpose: Break All selected objects
;;;    permitted objects are lines, lwplines, plines, splines,
;;;    ellipse, circles & arcs 
;;;                            
;;;  Function  c:BreakAll -      Break all objects selected
;;;  Function  c:BreakwObjects - Break many objects with a single object
;;;  Function  c:BreakObject -   Break a single object with many objects 
;;;  Function  c:BreakWith -     Break selected objects with other selected objects
;;;  Function  c:BreakTouching - Break objects touching the single Break object
;;;  Function  c:BreakSelected - Break selected objects with any  objects that touch it 
;;;                    
;;; Sub_Routines:      
;;;    break_with      
;;;    ssget->vla-list 
;;;    list->3pair     
;;;    onlockedlayer   
;;;    get_interpts Return a list of intersect points
;;;    break_obj  Break entity at break points in list
;;; Requirements: objects must have the same z-value
;;; Restrictions: Does not Break objects on locked layers 
;;; Returns:  none
;;;=====================================================================
;;;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED     ;
;;;   WARRANTY.  ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR  ;
;;;   PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.            ;
;;;                                                                    ;
;;;  You are hereby granted permission to use, copy and modify this    ;
;;;  software without charge, provided you do so exclusively for       ;
;;;  your own use or for use by others in your organization in the     ;
;;;  performance of their normal duties, and provided further that     ;
;;;  the above copyright notice appears in all copies and both that    ;
;;;  copyright notice and the limited warranty and restricted rights   ;
;;;  notice below appear in all supporting documentation.              ;
;;;=====================================================================


;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;               M A I N   S U B R O U T I N E                   
;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun break_with (ss2brk ss2brkwith self / cmd intpts lst masterlist ss ssobjs
                  onlockedlayer ssget->vla-list list->3pair
                  get_interpts break_obj
                 )
 ;; ss2brk     selection set to break
 ;; ss2brkwith selection set to use as break points
 ;; self       when true will allow an object to break itself
 ;;            note that plined will break at each vertex
 (vl-load-com)


;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;                S U B   F U N C T I O N S                      
;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

 (defun onlockedlayer (ename / entlst)
   (setq entlst (tblsearch "LAYER" (cdr (assoc 8 (entget ename)))))
   (= 4 (logand 4 (cdr (assoc 70 entlst))))
 )
 
 (defun ssget->vla-list (ss / i ename lst)
   (setq i -1)
   (while (setq ename (ssname ss (setq i (1+ i))))
     (setq lst (cons (vlax-ename->vla-object ename) lst))
   )
   lst
 )

 (defun list->3pair (old / new)
   (while (setq new (cons (list (car old) (cadr old) (caddr old)) new)
                old (cdddr old))
   )
   (reverse new)
 )
 
;;==============================================================
;;  return a list of intersect points
;;==============================================================
(defun get_interpts (obj1 obj2 / iplist)
 (if (not (vl-catch-all-error-p
            (setq iplist (vl-catch-all-apply
                           'vlax-safearray->list
                           (list
                             (vlax-variant-value
                               (vla-intersectwith obj1 obj2 acextendnone)
                             ))))))
   iplist
 )
)


;;==============================================================
;;  Break entity at break points in list
;;==============================================================
(defun break_obj (ent brkptlst / brkobjlst en enttype maxparam closedobj
                 minparam obj obj2break p1param p2 p2param
                )

 (setq obj2break ent
       brkobjlst (list ent)
       enttype   (cdr (assoc 0 (entget ent)))
 )

 (foreach brkpt brkptlst
   ;;  get last entity created via break in case multiple breaks
   (if brkobjlst
     (progn
       ;;  if pt not on object x, switch objects
       (if (not (numberp (vl-catch-all-apply 'vlax-curve-getdistatpoint (list obj2break brkpt)))
           )
         (foreach obj brkobjlst ; find the one that pt is on
           (if (numberp (vl-catch-all-apply 'vlax-curve-getdistatpoint (list obj brkpt)))
             (setq obj2break obj) ; switch objects
           )
         )
       )
     )
   )

   ;;  Handle any objects that can not be used with the Break Command
   ;;  using one point, gap of 0.000001 is used
   (cond
     ((and (= "SPLINE" enttype) ; only closed splines
           (vlax-curve-isclosed obj2break))
      (setq p1param (vlax-curve-getparamatpoint obj2break brkpt)
            p2      (vlax-curve-getpointatparam obj2break (+ p1param 0.000001))
      )
      (command "._break" obj2break "_non" (trans brkpt 0 1) "_non" (trans p2 0 1))
     )
     ((= "CIRCLE" enttype) ; break the circle
      (setq p1param (vlax-curve-getparamatpoint obj2break brkpt)
            p2      (vlax-curve-getpointatparam obj2break (+ p1param 0.000001))
      )
      (command "._break" obj2break "_non" (trans brkpt 0 1) "_non" (trans p2 0 1))
      (setq enttype "ARC")
     )
     ((and (= "ELLIPSE" enttype) ; only closed ellipse
           (vlax-curve-isclosed obj2break))
      ;;  Break the ellipse, code borrowed from Joe Burke  6/6/2005
      (setq p1param  (vlax-curve-getparamatpoint obj2break brkpt)
            p2param  (+ p1param 0.000001)
            minparam (min p1param p2param)
            maxparam (max p1param p2param)
            obj      (vlax-ename->vla-object obj2break)
      )
      (vlax-put obj 'startparameter maxparam)
      (vlax-put obj 'endparameter (+ minparam (* pi 2)))
     )
     
     ;;==================================
     (t  ;   Objects that can be broken     
      (setq closedobj (vlax-curve-isclosed obj2break))
      (command "._break" obj2break "_non" (trans brkpt 0 1) "_non" (trans brkpt 0 1))
      (if (not closedobj) ; new object was created
          (setq brkobjlst (cons (entlast) brkobjlst))
      )
     )
   )
 )
)


 
 ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 ;;                   S T A R T   H E R E                         
 ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
   (if (and ss2brk ss2brkwith)
   (progn
     ;;  CREATE a list of entity & it's break points
     (foreach obj (ssget->vla-list ss2brk) ; check each object in ss2brk
       (if (not (onlockedlayer (vlax-vla-object->ename obj)))
         (progn
           (setq lst nil)
           ;; check for break pts with other objects in ss2brkwith
           (foreach intobj (ssget->vla-list ss2brkwith) 
             (if (and (or self (not (equal obj intobj)))
                      (setq intpts (get_interpts obj intobj))
                 )
               (setq lst (append (list->3pair intpts) lst)) ; entity w/ break points
             )
           )
           (if lst
             (setq masterlist (cons (cons (vlax-vla-object->ename obj) lst) masterlist))
           )
         )
       )
     )
     ;;  masterlist = ((ent brkpts)(ent brkpts)...)
     (if masterlist
       (foreach obj2brk masterlist
         (break_obj (car obj2brk) (cdr obj2brk))
       )
     )
     )
 )
;;==============================================================

)
(prompt "\nBreak Routines Loaded, Enter BreakAll, BreakEnt, or BreakWith to run.")
(princ)



;;==========================================
;;        Break all objects selected        
;;==========================================
(defun c:breakall (/ cmd ss)

 (command "._undo" "_begin")
 (setq cmd (getvar "CMDECHO"))
 (setvar "CMDECHO" 0)

 ;;  get objects to break
 (prompt "\nSelect All objects to break & press enter: ")
 (if (setq ss (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
    (Break_with ss ss nil) ; ss2break ss2breakwith (flag nil = not to break with self)
 )

 (setvar "CMDECHO" cmd)
 (command "._undo" "_end")
 (princ)
)


;;==========================================
;;  Break a single object with many objects 
;;==========================================
(defun c:BreakObject (/ cmd ss1 ss2)

 (command "._undo" "_begin")
 (setq cmd (getvar "CMDECHO"))
 (setvar "CMDECHO" 0)

 ;;  get objects to break
 (prompt "\nSelect single object to break: ")
 (if (and (setq ss1 (ssget "+.:E:S" '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
          (not (redraw (ssname ss1 0) 3))
          (not (prompt "\n***  Select object(s) to break with & press enter:  ***"))
          (setq ss2 (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
          (not (redraw (ssname ss1 0) 4)))
    (Break_with ss1 ss2 nil) ; ss2break ss2breakwith (flag nil = not to break with self)
 )

 (setvar "CMDECHO" cmd)
 (command "._undo" "_end")
 (princ)
)

;;==========================================
;;  Break many objects with a single object 
;;==========================================
(defun c:breakwobjects (/ cmd ss1 ss2)
 (defun ssredraw (ss mode / i num)
   (setq i -1)
   (while (setq ename (ssname ss (setq i (1+ i))))
     (redraw (ssname ss i) mode)
   )
 )
 (command "._undo" "_begin")
 (setq cmd (getvar "CMDECHO"))
 (setvar "CMDECHO" 0)

 ;;  get objects to break
 (prompt "\nSelect object(s) to break & press enter: ")
 (if (and (setq ss1 (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
          (not (ssredraw ss1 3))
          (not (prompt "\n***  Select single object to break with:  ***"))
          (setq ss2 (ssget "+.:E:S" '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
          (not (ssredraw ss1 4))
     )
   (break_with ss1 ss2 nil) ; ss2break ss2breakwith (flag nil = not to break with self)
 )

 (setvar "CMDECHO" cmd)
 (command "._undo" "_end")
 (princ)
)

;;==========================================
;;  Break many objects with many object     
;;==========================================
(defun c:BreakWith (/ cmd ss1 ss2)
 (defun ssredraw (ss mode / i num)
   (setq i -1)
   (while (setq ename (ssname ss (setq i (1+ i))))
     (redraw (ssname ss i) mode)
   )
 )
 (command "._undo" "_begin")
 (setq cmd (getvar "CMDECHO"))
 (setvar "CMDECHO" 0)

 ;;  get objects to break
 (prompt "\nSelect object(s) to break & press enter: ")
 (if (and (setq ss1 (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
          (not (ssredraw ss1 3))
          (not (prompt "\n***  Select object(s) to break with & press enter:  ***"))
          (setq ss2 (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
          (not (ssredraw ss1 4))
     )
   (break_with ss1 ss2 nil) ; ss2break ss2breakwith (flag nil = not to break with self)
 )

 (setvar "CMDECHO" cmd)
 (command "._undo" "_end")
 (princ)
)



;;=============================================
;;  Break many objects with a selected objects 
;;  Selected Objects create ss to be broken    
;;=============================================

(defun c:BreakTouching (/ cmd ss1 ss2)
 
 ;;  get all objects touching entities in the sscross
 ;;  limited obj types to "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"
 (defun gettouching (sscros / ss lst lstb lstc objl)
   (and
     (setq lstb (vl-remove-if 'listp (mapcar 'cadr (ssnamex sscros)))
           objl (mapcar 'vlax-ename->vla-object lstb)
     )
     (setq
       ss (ssget "_A" (list (cons 0 "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")
                            (cons 410 (getvar "ctab"))))
     )
     (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
     (setq lst (mapcar 'vlax-ename->vla-object lst))
     (mapcar
       '(lambda (x)
          (mapcar
            '(lambda (y)
               (if (not
                     (vl-catch-all-error-p
                       (vl-catch-all-apply
                         '(lambda ()
                            (vlax-safearray->list
                              (vlax-variant-value
                                (vla-intersectwith y x acextendnone)
                              ))))))
                 (setq lstc (cons (vlax-vla-object->ename x) lstc))
               )
             ) objl)
        ) lst)
   )
   lstc
 )

 (command "._undo" "_begin")
 (setq cmd (getvar "CMDECHO"))
 (setvar "CMDECHO" 0)
 (setq ss1 (ssadd))
 ;;  get objects to break
 (if (and (not (prompt "\nSelect object(s) to break with & press enter: "))
          (setq ss2 (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
          (mapcar '(lambda (x) (ssadd x ss1)) (gettouching ss2))
     )
   (break_with ss1 ss2 nil) ; ss2break ss2breakwith (flag nil = not to break with self)
 )

 (setvar "CMDECHO" cmd)
 (command "._undo" "_end")
 (princ)
)



;;==========================================================
;;  Break selected objects with any objects that touch it  
;;==========================================================


(defun c:BreakSelected (/ cmd ss1 ss2)
 
 ;;  get all objects touching entities in the sscross
 ;;  limited obj types to "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"
 (defun gettouching (sscros / ss lst lstb lstc objl)
   (and
     (setq lstb (vl-remove-if 'listp (mapcar 'cadr (ssnamex sscros)))
           objl (mapcar 'vlax-ename->vla-object lstb)
     )
     (setq
       ss (ssget "_A" (list (cons 0 "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")
                            (cons 410 (getvar "ctab"))))
     )
     (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
     (setq lst (mapcar 'vlax-ename->vla-object lst))
     (mapcar
       '(lambda (x)
          (mapcar
            '(lambda (y)
               (if (not
                     (vl-catch-all-error-p
                       (vl-catch-all-apply
                         '(lambda ()
                            (vlax-safearray->list
                              (vlax-variant-value
                                (vla-intersectwith y x acextendnone)
                              ))))))
                 (setq lstc (cons (vlax-vla-object->ename x) lstc))
               )
             ) objl)
        ) lst)
   )
   lstc
 )

 (command "._undo" "_begin")
 (setq cmd (getvar "CMDECHO"))
 (setvar "CMDECHO" 0)
 (setq ss1 (ssadd))
 ;;  get objects to break
 (if (and (not (prompt "\nSelect object(s) to break with & press enter: "))
          (setq ss2 (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
          (mapcar '(lambda (x) (ssadd x ss1)) (gettouching ss2))
     )
   (break_with ss2 ss1 nil) ; ss2break ss2breakwith (flag nil = not to break with self)
 )

 (setvar "CMDECHO" cmd)
 (command "._undo" "_end")
 (princ)
)


;;/'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\.
;;    E n d   O f   F i l e   I f   y o u   A r e   H e r e       
;;/'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\.

AzRoDoRzA · le 25 juillet 2019

Hello,

Je vais tester tout ça merci!

Bye!

Hyppolight · le 25 juillet 2019

Salut,

D'après une lecture rapide, il faut tester si la commande "break_with" conserve les données d'objets, sinon il faut la modifier vu qu'elle est appeler dans toutes les autres sous-programmes...

Bon courage et bonne journée!! ;)

Hello,

Je vais tester tout ça merci!

Bye!

lecrabe · le 28 juillet 2019

Hello

SVP tu nous tiens au courant...

Bye, lecrabe "triste"

AzRoDoRzA · le 29 juillet 2019

Hello,

Alors j'ai testé la commande break_with, elle coupe bien la polyligne mais ne garde les OD que sur une des 2 parties coupées.. J'ai essayé de modifier un peu le code mais je ne le comprend pas trop :/

Voila pour le retour!

AzRoDoRzA · le 29 juillet 2019

J'ai trouvé la solution à mon problème, c'était tout bête, du coup voici mon programme compacté au max:

(vl-load-com)
(defun c:cuttingpoly( / pt)
(setq pt 
	(vlax-safearray->list 
		(vlax-variant-value 	
			(vla-IntersectWith 
				(vlax-ename->vla-object 
					(ssname(ssget) 0) ;A adapter comme vous le souhaitez
				)
				(vlax-ename->vla-object 
					(ssname(ssget) 0) ;A adapter comme vous le souhaitez
				)
			0)
		)
	)
)
(command "_break" "_none" ent "_none" pt "_none" "@")
(COPY_DATA ent (entlast) T)  ;Fonction COPY_DATA de Hyppolight
)

On choisis la polyligne à couper, puis la polyligne qui viens couper notre polyligne, et ça coupe en gardant les OD de chaque coté (Merci Hyppolight pour ta fonction COPY_DATA ;) ) Je vais essayer de l'améliorer maintenant pour détecter automatiquement les polylignes qui viennent couper la polyligne sélectionnée. Je posterais aussi mon code une fois la solution trouvée.

Bye!

Hyppolight · le 29 juillet 2019

J'ai trouvé la solution à mon problème, c'était tout bête, du coup voici mon programme compacté au max:

Cool, tant mieux, désolé, je n'avais pas trop de temps à consacrer à ce problème (vacances à la fin de la semaine et encore pas mal de choses à faire

(Merci Hyppolight pour ta fonction COPY_DATA ;) )

Y'a pas de quoi...

Pour moi.. de visu ce sont les lignes

(command "._break" obj2break "_non" (trans brkpt 0 1) "_non" (trans p2 0 1))

de la partie (defun break_obj qu'il faut modifier pour pouvoir utiliser toutes les commandes du code fourni:

;;; Function c:BreakAll - Break all objects selected

;;; Function c:BreakwObjects - Break many objects with a single object

;;; Function c:BreakObject - Break a single object with many objects

;;; Function c:BreakWith - Break selected objects with other selected objects

;;; Function c:BreakTouching - Break objects touching the single Break object

;;; Function c:BreakSelected - Break selected objects with any objects that touch it

Bon courage pour la suite ;)

Connexion

Couper polyligne avec OD à chaque sommet

Messages recommandés

Hyppolight

bonuscad

Hyppolight

lili2006

lecrabe

lili2006

bonuscad

Hyppolight

lecrabe

bonuscad

AzRoDoRzA

Hyppolight

Aleck_Ultimate

AzRoDoRzA

Hyppolight

lecrabe

AzRoDoRzA

AzRoDoRzA

Hyppolight

AzRoDoRzA

Hyppolight

lecrabe

AzRoDoRzA

AzRoDoRzA

Hyppolight

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante