Déplacer des blocs sur des polylignes 3D

[ablue1]

test.dwgBonjour,

Je cherche un lisp ou une commande qui permettrait de déplacer des blocs situés aux extrémités de polylignes 3D de 20cm vers l'intérieur de la polyligne sachant qu'il peut y avoir plusieurs extrémités superposées, à différentes altitudes. Je ne sais pas si çà rend les choses plus faciles mais mes polylignes n'ont qu'un segment. Si ca peut se faire pour toutes les polylignes d'un calque s'est encore mieux !

Merci d'avance au pros du Lisp.

Bonne journée

ablue1

Modifié le 9 décembre 2021 par ablue1
Ajout d'un exemple

[Olivier Eckmann]

Bonjour,

 

C'est quoi "l'intérieur" d'une polyligne à 1 seul segment?

 

Olivier

[Curlygoth]

VBA accepté ?

[Luna]

Coucou,

Il y a 8 heures, ablue1 a dit :

il peut y avoir plusieurs extrémités superposées, à différentes altitudes. Je ne sais pas si çà rend les choses plus faciles mais mes polylignes n'ont qu'un segment.

Que signifie cela ? Que tes polylignes sont purement verticales ? Si c'est le cas et pour la totalité de tes polylignes 3D, alors peut-être est-ce possible en prenant comme hypothèse que au même titre que l'outil DECALER utilise le plan XY comme plan de référence, on peut prendre le plan XZ ou YZ comme plan de référence (uniquement si les coordonnées XY sont identiques pour les deux sommets de ta polyligne 3D).

Bisous,
Luna

[didier]

Bonjour @ablue1

Comme vous constatez, puisque vous êtes un nouvel inscrit, il y a de la réponse sur ce site.

Il faut toujours éviter que les réponses soient des questions, mais quand le problème est incomplètement exposé, c'est ce qui se passe.

Donc on doit déplacer des blocs, de quel côté on en saura plus bientôt, mais du coup le rapport entre le point d'insertion et le sommet de la polyligne sera perdu.
Il n'y aura plus de relation en cas d'extraction de données ce qui est une perte d'information et ce n'est pas bien les pertes....

Je propose de rendre les blocs dynamiques avec une action de déplacement basée sur un point XY et de pouvoir déplacer le "graphique" du bloc MAIS en gardant le point d'insertion sur le sommet de la polyligne.
Il est possible de les mouvoir par lisp tout autant même si c'est un tantinet plus compliqué, mais quand on aime le travail bien fait on ne compte pas.

Nous attendons vos remarques pour répondre.

Amicalement

 

[ablue1]

Il y a 2 heures, Olivier Eckmann a dit :

Bonjour,

 

C'est quoi "l'intérieur" d'une polyligne à 1 seul segment?

 

Olivier

Il s'agit de déplacer le bloc de l'extrémité où il est situé vers l'autre extrémité.

[ablue1]

Il y a 1 heure, Curlygoth a dit :

VBA accepté ?

Bonjour,

 

Oui, merci

[ablue1]

Oups ! Ce qui se conçoit bien s'énonce clairement... Ça n'a pas l'air d'être mon cas ici. Non les polylignes ne sont pas verticales, mais avec diverses pentes. Mais elles peuvent avoir un sommet sur la même verticale. J'ai édité mon premier message pour ajouter un exemple.

J'espère que j'ai été suffisamment clair dans mon explication...

[ablue1]

@Didier, j'ai édité mon premier message pour y ajouter un exemple qui sera beaucoup plus parlant. J'aurais du commencer par là.

L'idée de déplacer uniquement la partie graphique du bloc me plait bien. Je n'y avait pas pensé. 

[Curlygoth]

 

A mettre dans la boucle de recherche de tes poly3D

Les block se supprimeront et le point d'insertion ce mettre a 20cm  vers le point opposé

si les block ne sont pas propre suffit de faire la différences et les déplacer via .move

 

Dim blockrefobj1 As AcadBlockReference
Dim blockrefobj2 As AcadBlockReference

Dim poly3D As Acad3DPolyline
Dim pT1(0 To 2) As Double
Dim pT2(0 To 2) As Double

Dim P1(0 To 2) As Double
Dim P2(0 To 2) As Double

DELTA = 0.2

L_COORD = poly3D.Coordinates
For i = 0 To 5
    If i < 3 Then
        pT1(i) = L_COORD(i)
    Else
        pT2(i - 3) = L_COORD(i)
    End If
Next i

L_Blockrefobj = AUTOCAD_CTRL.RECH_BLOCK_EXTREMITE(poly3D)

Set blockrefobj1 = AUTOCAD_CTRL.HANDLE_TO_OBJET(L_Blockrefobj(0))
B1 = blockrefobj1.EffectiveName
blockrefobj1.Delete

Set blockrefobj2 = AUTOCAD_CTRL.HANDLE_TO_OBJET(L_Blockrefobj(0))
B2 = blockrefobj2.EffectiveName
blockrefobj2.Delete

D = poly3D.Length 'ou MATH.HYPOTHENUSE_2PT(pT1, pT2, True)
A_X_Y = MATH.ANGLE_XY_2PTS(pT1, pT2)

P1(0) = pT1(0) + DELTA * Cos(A_X_Y)
P1(1) = pT1(1) + DELTA * Sin(A_X_Y)
P1(2) = MATH.Z_ENTRE_2_POINTS(D, pT1(2), pT2(2), DELTA)

P2(0) = pT1(0) + (D - DELTA) * Cos(A_X_Y)
P2(1) = pT1(1) + (D - DELTA) * Sin(A_X_Y)
P2(2) = MATH.Z_ENTRE_2_POINTS(D, pT1(2), pT2(2), D - DELTA)

Set blockrefobj1 = ThisDrawing.ModelSpace.InsertBlock _
(P1, B1, Echelle_X, Echelle_Y, Echelle_Z, Rotation_Bloc)

Set blockrefobj2 = ThisDrawing.ModelSpace.InsertBlock _
(P2, B2, Echelle_X, Echelle_Y, Echelle_Z, Rotation_Bloc)

Function Z_ENTRE_2_POINTS(D, Z1, Z2, DIST_ENTRE_PTBASE_ET_PT_ZRECH)
Z_ENTRE_2_POINTS = Z1 + (DIST_ENTRE_PTBASE_ET_PT_ZRECH - 0) * ((Z2 - Z1) / (D))
End Function

 

[didier]

Bonjour @ablue1

Je propose une solution en Lisp.

Le nom de la commande est ABLUE1
Il suffit de sélectionner les polylignes à traiter, car je n'ai pas mis de filtre de nom de calque ou autre.
Ne fonctionne que sur les polylignes 3D avec un seul segment.
Par contre, il n'y a pas à sélectionner les blocs, c'est automatique, seuls les blocs nommés blocC seront traités.
Si un bloc est sur une des extrémités du segment il sera déplacé (en 3D) dans le sens de la polyligne conformément à la demande et Si le bloc a déjà été déplacé il ne sera pas traité.
La variable dep actuellement à 0.20 est la distance de déplacement demandée, la changer dans le Lisp si elle doit évoluer.

Nota : je travaille avec les blocs du dessin proposé, je n'ai pas créé de blocs dynamiques comme j'ai proposé précédemment, si l'idée plait je veux bien revoir ma copie.

Amicalement

     ;https://cadxp.com/topic/54799-d%C3%A9placer-des-blocs-sur-des-polylignes-3d/?tab=comments#comment-312048
(defun c:ablue1 (/ blo dep ent lon n nn p1 p2 p3 p4 ss1 ss2)
  (setq dep 0.20 n 0 comp)
  (prompt "\nSélection des polylignes 3D\n")
  (setq ss1 (ssget (list (cons 0 "POLYLINE"))))
  (setq ss2 (ssget "_x" (list (cons 0 "INSERT")(cons 2 "blocC"))))
  (repeat (sslength ss1)
    (setq ent (ssname ss1 n)
                p1  (vlax-curve-getpointatparam ent 0)
                p2  (vlax-curve-getpointatparam ent 1)
                lon (distance p1 p2)
                p3  (vlax-curve-getpointatdist ent dep)
                p4  (vlax-curve-getpointatdist ent (- lon dep))
                nn  0
    ) ;_ Fin de setq
    (repeat (sslength ss2)
      (setq blo (ssname ss2 nn))
      (cond ((equal p1 (cdr (assoc 10 (entget blo))))
             (entmod
               (subst (cons 10 p3) (assoc 10 (entget blo)) (entget blo))
             ) ;_ Fin de entmod
            )
            ((equal p2 (cdr (assoc 10 (entget blo))))
             (entmod
               (subst (cons 10 p4) (assoc 10 (entget blo)) (entget blo))
             ) ;_ Fin de entmod
            )
      ) ;_ Fin de cond
      (setq nn (1+ nn))
    ) ;_ Fin de repeat
    (setq n (1+ n))
  ) ;_ Fin de repeat
) ;_ Fin de defun

 

 

 

 

[ablue1]

@Didier et @curlygoth Merci pour vos réponses. Je teste çà et je reviens vers vous au plus vite. 

[ablue1]

@didier J'ai un retour d'erreur de syntaxe au chargement de la fonction

[didier]

Bonjour @ablue1

Ce serait utile de savoir quel est ce message, dans quel dessin il est reçu et quelle est la version d'AutoCAD?
Le VBA fonctionne-t-il ? Ou seul le LSP cafouille ?

Amicalement

[ablue1]

@didier Je n'ai pas réussi à faire tourner le VBA. Le Lisp fait très bien le boulot finalement. Je continue de tester

Je n'y connais rien mais je pense qu'il manquait un paramètre sur cette ligne :

 

(setq dep 0.20 n 0 comp) ;  (setq dep 0.20 n 0 comp 0) 

 

Tous mes remerciements pour ce travail qui va me faire gagner pas mal de temps.

J'essaie de me mettre au Lisp dès que je peux dégager un peu de temps. Si vous avez des conseils pour débuter, je suis preneur.

Encore merci !

[didier]

Bonjour @ablue1

Merci de la correction, j'ai mis à jour le code fourni, effectivement j'avais une faute dans mon code un reste de variable de compteur qui n'a pas été correctement effacé.
Je suis content que ça fonctionne et que ça rende service en répondant à la demande.

L'idée du bloc dynamique, faut-il travailler dessus ?

• L'intérêt est de garder un point d'insertion en rapport avec le sommet de la polyligne
• Le défaut est de ne pas pouvoir mettre à jour, car la comparaison trouvera toujours un bloc à ce point d'insertion.

À réfléchir...

Quant au VBA, il n'est pas disponible en AutoCAD nativement, il faut charger le module volontairement avec un lien externe suivant la version d'AutoCAD.

Amicalement

[ablue1]

Bonjour,

J'ai pourtant bien installé VBA. 

 

A priori le bloc statique me convient, c'est pour de l'habillage. Par contre, il me semble que le décalage tient compte de la distance inclinée. Aussi selon les pente le bloc "s'affiche" plus ou moins loin. 

Par contre j'ai encore un soucis de chevauchement des blocs (il s'agit de blocs servant d'étiquettes) entre eux quand plusieurs extrémités de polylignes sont superposées. serait il possible de changer l'orientation des blocs en fonction de la direction de la polyligne sur lequel il se trouve ?

Merci d'avance,

 

Bonne journée

 

[didier]

Bonjour

Le bloc dont j'avais connaissance dans l'exemple ne pose pas ce genre de souci

Puisque je l'ai trouvé inséré avec une valeur Z correspondant au sommet de la polyligne j'ai pensé (bêtement) qu'il fallait le déplacer en 3D suivant la pente.
Ce n'est pas le cas ?

Pour ce qui est étiquettes, je pense qu'on parle d'attributs, non ? Il n'y en avait pas dans l'exemple à disposition.
Je veux bien en savoir plus pour corriger, mais il faut être explicite, merci.

Pour ce qui est du VBA je laisse l'auteur répondre.

Amicalement

[Curlygoth]

Comme je le disais c'est une function

donc avec un titre du type

(marche aussi en sub puisque je ne renvoie pas de valeur)

function BLOC_VERS_INT_3D(POLyobj3D)

set poly3d = POLyobj3D

'le code

end function

ensuite il faut boucler sur les objet

du style :

sub test

For i = 0 To ThisDrawing.ModelSpace.Count - 1
    Set Entity = ThisDrawing.ModelSpace.Item(i)for i

 if Entity.ObjectName = "AcDb3dPolyline" then

call BLOC_VERS_INT_3D(Entity)

else

end if

next i

end sub

 

 

Function RECH_BLOCK_EXTREMITE(polyobj)

l_point = polyobj.Coordinates

dim table(0 to 1)

E1(0) = l_point(0)
E1(1) = l_point(1)

E2(0) = l_point(UBound(l_point) - 1)
E2(1) = l_point(UBound(l_point))

For E = 0 To ThisDrawing.ModelSpace.Count - 1
    Set Entity = ThisDrawing.ModelSpace.Item(E)
    If Entity.ObjectName = "AcDbBlockReference"

                D1 = MATH.HYPOTHENUSE_2PT(E1, blockrefobj.InsertionPoint)
                If D1 < 0.001 Then
table(0) = blockrefobj.handle
                Else
                    D2 = MATH.HYPOTHENUSE_2PT(E2, blockrefobj.InsertionPoint)
                    If D2 < 0.001 Then
                              table(1) = blockrefobj.handle
                    Else
                    End If
                End If

next E

RECH_BLOCK_EXTREMITE  =table

end function

[ablue1]

Bonjour,

Désolé pour le retour tardif, je n'avais pas mon pc sous la main depuis plusieurs jours.

@didier, en effet comme çà fonctionne très bien je me suis permis une demande supplémentaire que je n'avais pas prévu à la base : Le changement d'orientation par rapport au point de base du bloc et avec un angle défini par rapport à sa polyligne support.

Je joins le fichier modifié avec les nouveaux blocs qui sera plus explicite.

Pour le déplacement, en 3D, c'est bien, mais pour l'affichage il vaudrait mieux, d'abord effectuer un décalage horizontal de 20cm, puis projeter le bloc sur la PO3D. Mais je pinaille un peu !

@curlygoth Merci pour ces explications, je vais tester ton code ce week-end.

 

Encore merci à vous !

Bonne journée

 

Ablue2.dwg

[didier]

Bonjour @ablue1

La question est pour le moins mal exposée !.
Dans le dessin fourni (bonne idée) il n'y a rien d'explicite(mauvaise idée).
Il y a un bloc avec la valeur 65.05 accroché à une extrémité à 65.75 késako ?
En plus les Z d'insertion n'ont rien à voir avec le Z de la polyligne.
Donc :
Ce que je comprends, c'est que les blocs ne sont plus déplacés de vingt centimètres depuis l'extrémité dans la direction de la polyligne
MAIS
Les blocs sont composés d'une ligne et d'un cercle contenant un attribut et l'extrémité de la ligne est connectée à l'extrémité de la polyligne (je pense aussi en Z), le tout sur un angle droit du côté droit du sens de construction de la polyligne, l'attribut n'étant pas lié en direction par rapport à cette polyligne ni par rapport au sens de lecture (Sens croissant des X du SCU général).
Rien à voir avec la demande initiale.

Je veux bien faire ce truc, pas de souci, mais comme je déteste travailler pour rien, j'aimerais être certain d'être dans la bonne direction de compréhension.

Amicalement
 

[ablue1]

Bonjour,

Je vais tenter de reformuler ma demande plus clairement. Le décalage de 20cm est parfait c'est exactement ce que je voulais.

La demande complémentaire serait d'appliquer au bloc, après le décalage, une rotation :
- Selon un angle avec la PO3D : J'avais mis 100gr comme exemple. 
- Le sens de rotation serait fixe (Sens topo).
- Le centre de rotation serait le point d'insertion du bloc.

Je joins le fichier avec le rendu recherché.

Ablue3.dwg

[didier]

Bonjour @ablue1

OK, compris

je propose cette nouvelle version, j'ai redéfini le bloc pour que le point d'insertion de l'attribut soit en MILIEU CENTRE,
c'est mieux quand on veut centrer une valeur dans un cercle,
j'ai aussi changé en couleur DUBLOC pour la visualisation du GIF.

En effet j'ai tenu compte que des blocs ne seraient peut-être pas insérés correctement en Z sur la polyligne, ils seront traités quand même.
La valeur prise en compte pour l'attribut est la valeur Z su sommet de la polyligne, pas le point du bloc.

À suivre si tu as des questions.
Dis-moi si c'est OK et je livre le lisp...

Perso je pense que ce serait mieux de faire une routine qui insère directement les blocs avec tes demandes plutôt que de modifier les blocs en place.
Qu'en penses-tu ?

Amicalement