Tranformer une polyligne légére en polyligne 3D en conservant ses données d'objet

[bonuscad]

Bonjour,

Suite à une demande sur le forum US d'Autodesk, j'ai trouvé l'idée intéressante mais la routine proposée imparfaite à mon goût. J'ai donc décidé de l'améliorer...

Elle permet de transformer une LWPOLYLINE en une 3DPOLYLINE.

Si cette polyligne légère possède:

- Une élévation, celle ci devient le Z des points de la 3Dpoly.

- Des OD (Données d'Objets) ceux-ci sont transférer: il peut y avoir plusieurs tables ainsi que plusieurs enregistrements de données d'un même champ.

- Des XData qui seront transférer à la nouvelle 3Dpoly (Donc avec un Autocad Classique la fonction fera le job mais ignorera les OD)

Le calque est aussi conservé, les arcs de la polyligne légère (si présent) seront discrétiser (par angle de 1/36 de pi/2)

Si la sélection de polylignes légères est importante avec beaucoup de données d'objet, le traitement peut être un peu long. Soyez patient ...! 😉

 

lwto3dpoly.lsp

lwto3dpoly.lsp

Modifié le 21 septembre 2021 par bonuscad
Rajout de modifications de récupération de propriétés

[lecrabe]

Hello Bruno

BRAVO !

La Sante, Bye, lecrabe

 

[lili2006]

Bonsoir à toutes et tous,

 

Merci @bonuscad👌,

 

Donc, on peut ensuite modifier l'alti des sommets de cette nouvelle poly 3D sans perdre les ODs ?

[bonuscad]

Il y a 16 heures, lili2006 a dit :

Donc, on peut ensuite modifier l'alti des sommets de cette nouvelle poly 3D sans perdre les ODs ?

Modifier l'alti des sommets est possible. Cependant il faut se méfier de certaines commandes d'édition tel que: COUPURE, AJUSTER par exemple.

En fait de toutes commande d'édition qui est susceptible de créer une seconde entité, car à ce moment là, la seconde entité (ou les deux) va perdre les OD.

J'ai édité le post du code, car j'ai rajouté la récupération de certaines propriétés (couleur, type de ligne, échelle type de ligne, épaisseur de ligne)

[lecrabe]

Hello

ReBRAVO !

Pour couper (en gardant les ODs "de chaque cote"), il faut utiliser la routine MAPCOUP de Gilles (gile) ...

Cette routine traite : LIGNE , ARC , Polylignes 2D (NON Splinees / NON Courbees)

Suggestion d'amelioration : traiter toutes les Polylignes 2D ET 3D !?

La Sante, Bye, lecrabe

 

 

MAPCOUP.zip

[lili2006]

Bonjour à toutes et tous,

 

Il y a 2 heures, lecrabe a dit :

Suggestion d'amelioration : traiter toutes les Polylignes 2D ET 3D !?

Et le tout sur le même Lisp ? Compliqué ça ? 😶

 

Il y a 3 heures, bonuscad a dit :

Cependant il faut se méfier de certaines commandes d'édition tel que: COUPURE, AJUSTER par exemple.

Oui, j'avais déjà vu un post ou tu mettais en garde quand à la perte possible ds ODs ,..Merci pour ce rappel, cependant,..

[bonuscad]

Citation

Pour couper (en gardant les ODs "de chaque cote"), il faut utiliser la routine MAPCOUP de Gilles (gile) ...

Toujours dans la même philosophie (conserver les OD avec n-record et XData), j'ai cette routine pour couper des LWPOLYLINE.

Elle permet donc de sectionner  en (n) tronçons une ou des polylignes en une seule opération avec des objets POINT, CERCLE ou INSERTION de blocs situés sur la polyligne.

(vl-load-com)
(defun add_vtx (obj add_pt ent_name fz / sw ew nw bulg next)
  (vla-GetWidth obj (fix add_pt) 'sw 'ew)
  (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 next (1+ (fix add_pt)))
  (while (equal (vlax-curve-getdistatparam obj next) (vlax-curve-getdistatparam obj (fix add_pt)) fz)
    (setq next (1+ next))
  )
  (setq
    nw
    (*
      (/
        (- ew sw)
        (- (vlax-curve-getdistatparam obj next) (vlax-curve-getdistatparam obj (fix add_pt)))
      )
      (- (vlax-curve-getdistatparam obj add_pt) (vlax-curve-getdistatparam obj (fix add_pt)))
    )
    bulg (atan (vla-GetBulge obj (fix add_pt)))
  )
  (vla-SetBulge obj
    (fix add_pt)
    (/
      (sin (* 4 bulg (- add_pt (fix add_pt)) 0.25))
      (cos (* 4 bulg (- add_pt (fix add_pt)) 0.25))
    )
  )
  (vla-SetBulge obj
    (1+ (fix add_pt))
    (/
      (sin (* 4 bulg (- (1+ (fix add_pt)) add_pt) 0.25))
      (cos (* 4 bulg (- (1+ (fix add_pt)) add_pt) 0.25))
    )
  )
  (vla-SetWidth obj
    (fix add_pt)
    sw
    (+ nw sw)
  )
  (vla-SetWidth obj
    (1+ (fix add_pt))
    (+ nw sw)
    ew
  )
  (vla-update obj)
)
(defun c:break_lw@pt_withOD ( / js typ_ent js_b dfzz i ent obj dxf_obj xd_l tbldef lst_data nb tmp_name pt lst_pt dxf_10 el_l l1 l2 c r nwent)
  (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)
      (initget 6 "1E-01 1E-08")
      (setq dfzz (getreal "\nPrécision d'égalité; grandes coordonnée x xxx xxx.xx,y yyy yyy.yy / normales xxxx.xx,yyyy.yy [1E-01/1E-08]?<1E-01>: "))
      (if (not dfzz) (setq dfzz 1E-01))
      (repeat (setq i (sslength js))
        (setq
          ent (ssname js (setq i (1- i)))
          obj (vlax-ename->vla-object ent)
          dxf_obj (entget ent (list "*"))
          xd_l (assoc -3 dxf_obj)
          lst_pt nil lst_data nil r nil
        )
        (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
                )
              )
            )
          )
          (setq lst_data 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 ent pt)) 0.0 dfzz)
                  (not (equal (distance pt (vlax-curve-getStartPoint ent)) 0.0 dfzz))
                  (not (equal (distance pt (vlax-curve-getEndPoint ent)) 0.0 dfzz))
                )
                (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 dfzz)) dxf_10)))
                (add_vtx obj (vlax-curve-getparamatpoint ent (vlax-curve-getClosestPointTo ent el)) ent dfzz)
              )
            )
            (setq el_l (entget ent))
            (foreach n el_l (if (member (car n) '(-1 5 102 330 360)) (setq el_l (vl-remove (assoc (car n) el_l) el_l))))
            (setq
              l1 (reverse (cdr (member (assoc 10 el_l) (reverse el_l))))
              l1 (subst '(70 . 0) (assoc 70 l1) l1)
              l2 (reverse (cdr (reverse (member (assoc 10 el_l) el_l))))
              c (mapcar '(lambda (x) (cons 10 (list (car x) (cadr x)))) lst_pt)
            )
            (and (= 1 (logand 1 (cdr (assoc 70 el_l)))) (setq l2 (append l2 (list (assoc 10 el_l)))))
            (foreach p l2
              (if (vl-some '(lambda (x) (equal p x dfzz)) c)
                (progn
                  (setq r (cons p r))
                  (entmake (append l1 (reverse r) (if xd_l (list xd_l) '())))
                  (setq
                    nwent (entlast)
                    r (list p)
                    c (vl-remove p c)
                  )
                  (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 r (cons p r))
              )
            )
            (entmake (append l1 (reverse r) (if xd_l (list xd_l) '())))
            (setq nwent (entlast))
            (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)
)

 

[lecrabe]

Hello Bruno

Est ce bien la version que tu avais deja diffuse ici :

La Sante, Bye, lecrabe

 

[bonuscad]

Citation

Est ce bien la version que tu avais deja diffuse ici :

Je ne pense pas! Mon dernier fichier sur mon PC date du 22/01/2021 (donc postérieur au post).

Je pense avoir introduit le fuzz (après des tests ultérieurs) pour les grandes coordonnées car la fonction pouvait ne pas faire le job dans ces cas là.

[lili2006]

😎, Merci !

[Olivier Eckmann]

Bonjour @bonuscad,

 

Merci pour le partage.

Pour le test de savoir si c'est un Map ou un Civil, j'aurais ajouté, à la recherche de Map3D ou Civil3D dans le titre de la fenêtre, la recherche de acadmap.arx ou acmapade.arx dans la liste des arx chargés, car certains applicatifs "topo bien connus" ont tendance à renommer le titre de la fenêtre AutoCAD à leur profit.

          (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))))
            (member "acmapade.arx" (arx))  ; pour les appli topo qui renomment le titre de la fenêtre AutoCAD
          )

 

Olivier

[lecrabe]

Hello

Je ne vois pas du tout quel Appli Topo peut renommer la fenetre AutoCAD :

franchement faire cela sans demander l'autorisation a Autodesk C UN SCANDALE !?

La Sante, Bye, lecrabe

 

[bonuscad]

@Olivier Eckmann

Bonjour, merci pour la précision, mais ne pouvant tester cette situation, je laisse les personnes concernées faire la modification suggérée ,si besoin, pour régler ce point précis.