PolyAddPoint et PolyDelPoint

Luna · le 8 juillet 2020

Ohayo !

Petit partage pour ceux que ça intéresse (c'est essentiellement pour la modification de réseaux élec' ou autre je pense) de deux commandes nommées PolyAddPoint et PolyDelPoint. Le fonctionnement est basé sur le menu contextuel d'un sommet d'une polyligne (si les grip sont actifs) permettant d'ajouter un sommet à la suite de ce dernier, de supprimer le sommet ou bien d'étirer le sommet. Lorsqu'il y a 1 ou 2 polylignes qui partagent un tracé commun, la modification se fait facilement via ce menu contextuel. Cependant, lorsqu'une vingtaine, cinquantaine voire plus de polylignes partagent un tracé commun (ou des sommets communs) la modification du tracé est plus longue car ce menu contextuel ne fonctionne que pour une polyligne uniquement.

L'option "étirer le sommet" fonctionne déjà avec la sélection multiple de polyligne donc pas besoin de s'en occuper, mais si on veut rajouter un sommet commun pour un ensemble de polylignes ou bien en supprimer un, il n'y a pas encore d'alternative à le faire une par une.

C'est la raison de ces deux commandes (je travaille avec un plug-in permettant de tracé du câblage électrique automatiquement et les câbles sont donc tous présents sur AutoCAD pour faciliter les extract et le travail mais si le tracé est faux et/ou modifié, ça devient vite un enfer à modifier !). Sur le plan du fonctionnement c'est assez simple, elles fonctionnent toutes deux avec la pré-sélection d'objets (filtrée sur les objets de type "LWPOLYLINE" pour PolyAddPoint et "ARC,LINE,LWPOLYLINE,POLYLINE" pour PolyDelPoint, les splines sont plus complexes à gérer à cause de la différence entre la liste de points (entget) et les sommets cliquables à l'écran via "OSMODE").

PolyAddPoint : Après sélection des polylignes, on détermine le point précédent (même principe que le menu contextuel) et on spécifie le nouveau point à ajouter. Le point précédent peut ne pas appartenir à l'ensemble des polylignes car pour chaque polyligne, le point précédent correspond en réalité au sommet le plus proche du point spécifié par l'utilisateur. Le nouveau point sera ajouter à la suite, suivant le sens de création des polylignes (aucun aperçu du rendu lors de la sélection du nouveau point mis en place, à faire ?). Un retour dans l'historique de commande permet d'avoir un aperçu sur le bon fonctionnement de la commande.

(defun C:POLYADDPOINT (/ jsel i name n pt Add-pt)

(if (not (setq jsel (last (ssgetfirst))))
	(setq jsel (ssget '((0 . "LWPOLYLINE"))))
	(setq jsel (ssget "_I" '((0 . "LWPOLYLINE"))))
)
(sssetfirst nil jsel)
(if jsel
	(while (setq pt (getpoint "\nSélectionner le point précédant le nouveau point à ajouter (ENTER pour terminer) : "))
		(setvar "LASTPOINT" pt)
		(setq i 0
		      n 0
		      Add-pt (getpoint "\nSpécifier un nouveau point : ")
		)
		(while (< i (sslength jsel))
			(setq name (ssname jsel i)
			      i (1+ i)
			)
			(if (Add-Poly2D-Point name (trans pt 1 0) (trans Add-pt 1 0))
				(setq n (1+ n))
			)
		)
		(prompt (strcat "\nLe sommet spécifié appartient désormais à "
				(itoa n)
				" / "
				(itoa (sslength jsel))
				" polyligne(s)."
				"\n"
			)
		)
	)
	(prompt "\nAucun jeu de sélection n'a été trouvé après application du filtre.")
)
(sssetfirst nil nil)
(princ)

)

; Permet de récupérer la liste des sommets de l'entité sélectionnée sous forme de liste de coordonnées (2D ou 3D selon le type d'objet) :
;--- La fonction (get-pt-list) possède 1 argument
;--- name correspond au nom de l'entité étudié

;--- Renvoie la liste de coordonnées de chaque points de l'entité dans le repère WCS (à confirmer !)
;--- A étudier en détails sur les transpositions de coordonnées (erreurs de calcul ?)
(defun Get-pt-list (name / ent-list pt-list)

(if (= (type name) 'ENAME)
	(progn
		(setq ent-list (entget name))
		(while (setq ent-list (member (assoc 10 ent-list) ent-list))
			(setq pt-list (cons (cdr (assoc 10 ent-list)) pt-list)
			      ent-list (cdr ent-list)
			)
		)
	)
	(prompt "\nL'argument spécifié n'est pas un nom d'entité.\n")
)
(if pt-list
	(cond
		((= (cdr (assoc 0 (entget name))) "HATCH")
			(setq pt-list (cdr (reverse (cdr pt-list))))
		)
		((= (cdr (assoc 0 (entget name))) "ARC")
			(setq pt-list (append pt-list
					      (list
						(polar (car pt-list) (cdr (assoc 50 (entget name))) (cdr (assoc 40 (entget name))))
						(polar (car pt-list) (cdr (assoc 51 (entget name))) (cdr (assoc 40 (entget name))))
					      )
				      )
			)
		)
		((= (cdr (assoc 0 (entget name))) "LINE")
			(setq pt-list (reverse (cons (cdr (assoc 11 (entget name))) pt-list)))
		)
		((= (cdr (assoc 0 (entget name))) "POLYLINE")
			(setq ent-list (entget name))
			(while (/= (cdr (assoc 0 ent-list)) "SEQEND")
				(setq ent-list (entget (setq name (entnext name))))
				(if (assoc 10 ent-list)
					(setq pt-list (cons (cdr (assoc 10 ent-list)) pt-list))
				)
			)
			(setq pt-list (reverse (cdr (reverse pt-list))))
		)
		(t
			(setq pt-list (reverse pt-list))
		)
	)
	nil
)

)

; Permet de récupérer les coordonnées du sommet d'une polyligne le plus proche d'un point spécifié en argument :
;--- La fonction (osnap-poly) possède 2 argument
;--- name correspond au nom de l'entité étudié
;--- Point correspond au point de départ qui sera étudié

;--- Renvoie les coordonnées du sommet le plus proche du point de départ appartenant à l'entité name, nil si la fonction (get-pt-list) retourne nil
(defun osnap-poly (name Point / pt-list dist pt)

(if (setq pt-list (Get-pt-list name))
	(progn
		(foreach pt pt-list
			(setq dist (cons (cons (distance pt Point) pt) dist))
		)
		(setq Point (cdr (assoc (apply 'min (mapcar 'car dist)) dist)))
	)
)

)

; Permet d'ajouter un point pour les polylignes 2D uniquement à partir du point précédent spécifié en argument :
;--- La fonction (Add-Poly2D-Point) possède 3 arguments
;--- name correspond au nom de l'entité polyligne
;--- Start-pt correspond au point de départ appartenant à la polyligne (ajout de la fonction (osnap-poly) pour utilisation dans un jsel)
;--- Add-pt correspond au point que l'on souhaite ajouter à la polyligne

;--- Renvoie la liste DXF de la nouvelle polyligne si fonctionnnelle, sinon nil
(defun Add-Poly2D-Point (name Start-pt Add-pt / entlist pt-list pos add)

(if (= (cdr (assoc 0 (entget name))) "LWPOLYLINE")
	(setq entlist (entget name)
	      pt-list (Get-pt-list name)
	      Start-pt (osnap-poly name Start-pt)
	      pos (+ 5 (- (length entlist) (length (member Start-pt (mapcar 'cdr entlist)))))
	      add 	(list 	(assoc 40 (sublist entlist (- pos 4) nil))
				(assoc 41 (sublist entlist (- pos 4) nil))
				(assoc 42 (sublist entlist (- pos 4) nil))
				(assoc 91 (sublist entlist (- pos 4) nil))
			)
	      entlist	(entmod	(append
					(sublist entlist 1 pos)
					(append (list (cons 10 (if (/= 2 (length Add-pt)) (setq Add-pt (list (car Add-pt) (cadr Add-pt))) Add-pt))) add)
					(sublist entlist (1+ pos) nil)
				)
			)
	)
)

)

; Permet de renvoyer une sous-liste d'une liste spécifiée en argument (similaire à la fonction (substr)) :
;--- La fonction (sublist) possède 3 arguments
;--- lst correspond à la liste que l'on souhaite découper
;--- start correspond à la position de la première valeur conservée. Le premier élément de la liste correspond à 1
;--- lngth correspond au nombre d'éléments à conserver dans la liste retournée

;--- Renvoit la sous-liste
(defun sublist (lst s l)

(repeat (1- s) (setq lst (cdr lst)))
(setq lst (reverse lst))
(if (or (null l)
	(minusp l)
	(not (<= l (- (length lst) (1- s))))
    )
	lst
	(repeat (- (length lst) l)
		(setq lst (cdr lst))
	)
)
(reverse lst)

)

PolyDelPoint : Après la sélection des objets linéaires (exceptés les splines), supprime chaque sommet spécifié ("OSMODE" = 1) appartenant aux objets linéaires. Un retour dans l'historique de commande permet de quantifier le nombre d'objets linéaires impactés par le sommet spécifié et le nombre d'entités actuellement sélectionnées. Dans le cas d'une entité ne possédant plus que deux sommets dans sa liste et dont on supprime un sommet, cette entité est supprimée du dessin et retirée du jeu de sélection. Dans le cas où le jeu de sélection est vide, la commande s'arrête automatiquement.

(defun C:POLYDELPOINT (/ *error* msg osmode jsel i name n d p pt pt-list)


(defun *error* (msg)
	(setvar "OSMODE" osmode)
	(princ msg)
)

(if (not (setq jsel (last (ssgetfirst))))
	(setq jsel (ssget '((0 . "ARC,LINE,LWPOLYLINE,POLYLINE"))))
	(setq jsel (ssget "_I" '((0 . "ARC,LINE,LWPOLYLINE,POLYLINE"))))
)
(setq osmode (getvar "OSMODE"))
(setvar "OSMODE" 1)
(sssetfirst nil jsel)
(if jsel
	(while (and (> (sslength jsel) 0)
		    (null (prompt (strcat "\n" (itoa (sslength jsel)) " objet(s) actuellement sélectionnés")))
		    (setq pt (getpoint "\nSélectionner un point à supprimer (ENTER pour terminer) : "))
	       )
		(setq i 0
		      n 0
		      d 0
		)
		(while (< i (sslength jsel))
			(setq name (ssname jsel i)
			      pt-list (get-pt-list name)
			      p (if (< (length (car pt-list)) (length (setq p (trans pt 1 0)))) (reverse (cdr (reverse p))) p)
			      i (1+ i)
			)
			(if (pt-member p pt-list 0.01)
				(progn
					(cond
						((member (cons 10 p) (entget name))
							(entmod (vl-remove (cons 10 p) (entget name)))
						)
						((member (cons 11 p) (entget name))
							(entmod (vl-remove (cons 11 p) (entget name)))
						)
					)
					(if (or (wcmatch (cdr (assoc 0 (entget name))) "LINE,ARC")
						(<= (length (get-pt-list name)) 1)
					    )
						(progn
							(ssdel name jsel)
							(entdel name)
							(setq d (1+ d)
							      i (1- i)
							)
						)
					)
					(setq n (1+ n))
				)
			)
		)
		(sssetfirst nil jsel)
		(prompt (strcat "\nLe sommet spécifié appartenait à "
				(itoa n)
				" / "
				(itoa (+ d (sslength jsel)))
				" entité(s) linéaire(s)."
				(if (/= d 0)
					(strcat " Parmi ces "
						(itoa n)
						" entité(s), "
						(itoa d)
						" ont été supprimé du dessin."
					)
					""
				)
				"\n"
			)
		)
	)
	(prompt "\nAucun jeu de sélection n'a été trouvé après application du filtre.")
)
(sssetfirst nil nil)
(setvar "OSMODE" osmode)
(princ)

)

; Permet de récupérer la liste des sommets de l'entité sélectionnée sous forme de liste de coordonnées (2D ou 3D selon le type d'objet) :
;--- La fonction (get-pt-list) possède 1 argument
;--- name correspond au nom de l'entité étudié

;--- Renvoie la liste de coordonnées de chaque points de l'entité dans le repère WCS (à confirmer !)
;--- A étudier en détails sur les transpositions de coordonnées (erreurs de calcul ?)
(defun Get-pt-list (name / ent-list pt-list)

(if (= (type name) 'ENAME)
	(progn
		(setq ent-list (entget name))
		(while (setq ent-list (member (assoc 10 ent-list) ent-list))
			(setq pt-list (cons (cdr (assoc 10 ent-list)) pt-list)
			      ent-list (cdr ent-list)
			)
		)
	)
	(prompt "\nL'argument spécifié n'est pas un nom d'entité.\n")
)
(if pt-list
	(cond
		((= (cdr (assoc 0 (entget name))) "HATCH")
			(setq pt-list (cdr (reverse (cdr pt-list))))
		)
		((= (cdr (assoc 0 (entget name))) "ARC")
			(setq pt-list (append pt-list
					      (list
						(polar (car pt-list) (cdr (assoc 50 (entget name))) (cdr (assoc 40 (entget name))))
						(polar (car pt-list) (cdr (assoc 51 (entget name))) (cdr (assoc 40 (entget name))))
					      )
				      )
			)
		)
		((= (cdr (assoc 0 (entget name))) "LINE")
			(setq pt-list (reverse (cons (cdr (assoc 11 (entget name))) pt-list)))
		)
		((= (cdr (assoc 0 (entget name))) "POLYLINE")
			(setq ent-list (entget name))
			(while (/= (cdr (assoc 0 ent-list)) "SEQEND")
				(setq ent-list (entget (setq name (entnext name))))
				(if (assoc 10 ent-list)
					(setq pt-list (cons (cdr (assoc 10 ent-list)) pt-list))
				)
			)
			(setq pt-list (reverse (cdr (reverse pt-list))))
		)
		(t
			(setq pt-list (reverse pt-list))
		)
	)
	nil
)

)

(defun pt-member (pt pt-list fuzz / d)

(setq d (strlen (substr (vl-princ-to-string fuzz) (1+ (cond ((= (type fuzz) 'REAL) (vl-string-position (ascii ".") (vl-princ-to-string fuzz))) (t 0))))))
(if (> (length pt) (length (car pt-list)))
	 (setq pt (reverse (cdr (reverse pt))))
)
(while (and pt-list
	    (not (equal (mapcar '(lambda (x) (rtos x 2 d)) pt) (mapcar '(lambda (x) (rtos x 2 d)) (car pt-list)) fuzz))
       )
	(setq pt-list (cdr pt-list))
)
pt-list

)

Ces deux commandes fonctionnent correctement avec les SCU. Et puis comme ça, ça pourra toujours servir d'exemple au besoin pour d'autres programmes :3

Bisous,

Luna

bonuscad · le 9 juillet 2020

Bonjour Luna,

Juste un signalement, il manque la fonction (sublist) dans POLYADDPOINT.

J'en profite pour t'encourager car je constate que pour un membre inscrit récemment, tu as déjà un excellent nivaux en lisp, mais tu pratique peut être déjà depuis plus longtemps?

En tout cas ça fait plaisir de voir une nouvelle tête prête à prendre la relève, car les pointures sur le site sont les mêmes depuis un bon bout de temps.

Luna · le 9 juillet 2020

Merci pour le signalement, je n'y avais pas fait attention, le code est à jour dans le post #1 :3

C'est gentil mais je manque encore d'expérience, cela doit faire 1-2ans que j'ai découvert la programmation et AutoLISP ^^"

Autant aider quand on en a les moyens, et les grands pontes de cadxp.com ne peuvent pas non plus répondre à tout et tout le monde (surtout quand les mêmes questions reviennent sans cesse ^^).

Et puis aider les autres revient à s'aider soi-même alors il n'y a rien à perdre et tout à y gagner :3

Bisous,

Luna

Luna · le 21 avril 2021

Coucou,

Petit up sur la commande PolyAddPoint permettant un aperçu des modifications (via la fonction (grread) et (grdraw)). Il y a très certainement de nombreuses optimisations de codage mais je n'ai pas forcément le niveau pour ^^"

(defun c:PolyAddPoint (/ *error* break jsel i name rd osf osm n p c pt-list pt-c pt-s pt-e p-lst get-pt-list Add-Poly2D-Point)

	(defun *error* (msg)

		(princ msg)
		(redraw)
		(sssetfirst nil nil)
		(prompt "\n")
		(exit)

	)

	(defun get-pt-list (name / pt-list)

		(setq entlist (entget name))
		(while (setq pt (assoc 10 entlist))
			(setq pt-list (cons (cdr pt) pt-list)
			      entlist (cdr (member pt entlist))
			)
		)
		(reverse pt-list)

	)

	(defun Add-Poly2D-Point (name seg pt-a / entlist pt-s pt-e)

		(if (and
		    	(setq entlist (entget name))
			(setq pt-s (cons 10 (car seg)))
			(if (cdr seg)
				(setq pt-e (cons 10 (cdr seg)))
				(setq pt-e (assoc 210 entlist))
			)
			(member pt-s entlist)
			(entmod
				(subst
					(cons 90 (1+ (cdr (assoc 90 entlist))))
					(assoc 90 entlist)
					(append
						(reverse (cdr (member pt-e (reverse entlist))))
						(list
							(cons 10 pt-a)
							(assoc 40 (member pt-s entlist))
							(assoc 41 (member pt-s entlist))
							(assoc 42 (member pt-s entlist))
							(assoc 91 (member pt-s entlist))
						)
						(member pt-e entlist)
					)
				)
			)
		    )
			T
			nil
		)

	)

	(setq osf (LM:grsnap:snapfunction)
	      osm (getvar "OSMODE")
	      p 0
	      c 0
	)
	(if (setq jsel (ssget '((0 . "LWPOLYLINE"))))
		(while (not break)
			(setq n 0)
			(while (= 5 (car (setq rd (grread T 15 0))))
				(redraw)
				(setq p-lst nil
				      tmp-lst nil
				      pt-c (trans (osf (cadr rd) osm) 1 0)
				)
				(repeat (setq i (sslength jsel))
					(setq name (ssname jsel (setq i (1- i)))
					      c (rem (- (sslength jsel) i) 255)
					      pt-list (get-pt-list name)
					      pt-s (car
							(vl-sort
								pt-list
								'(lambda (pt1 pt2)
									(< (distance pt-c pt1) (distance pt-c pt2))
								 )
							)
						   )
					      pt-e (cadr (member pt-s pt-list))
					)
					(if (not (member pt-s tmp-lst))
						(progn
							(setq tmp-lst (cons pt-s tmp-lst))
							(grdraw (trans pt-c 0 1) (trans pt-s 0 1) c 1)
						)
					)
					(if (and pt-e
						 (not (member pt-e tmp-lst))
					    )
						(progn
							(setq tmp-lst (cons pt-e tmp-lst))
							(grdraw (trans pt-c 0 1) (trans pt-e 0 1) c 1)
							(grdraw (trans pt-s 0 1) (trans pt-e 0 1) -1 2)
						)
					)
					(setq p-lst (cons (cons name (cons pt-s pt-e)) p-lst))
				)
			)
			(if (= 3 (car rd))
				(progn
					(while (= 5 (car (setq rd (grread T 15 0))))
						(redraw)
						(setq i 0
						      tmp-lst nil
						      pt-c (trans (osf (cadr rd) osm) 1 0)
						)
						(foreach lst p-lst
							(setq name (car lst)
							      i (1+ i)
							      c (rem i 255)
							      pt-s (cadr lst)
							      pt-e (cddr lst)
							)
							(if (not (member pt-s tmp-lst))
								(progn
									(setq tmp-lst (cons pt-s tmp-lst))
									(grdraw (trans pt-c 0 1) (trans pt-s 0 1) c 1)
								)
							)
							(if (and pt-e
								 (not (member pt-e tmp-lst))
							    )
								(progn
									(setq tmp-lst (cons pt-e tmp-lst))
									(grdraw (trans pt-c 0 1) (trans pt-e 0 1) c 1)
									(grdraw (trans pt-s 0 1) (trans pt-e 0 1) -1 2)
								)
							)
						)
					)
					(if (= 3 (car rd))
						(progn
							(foreach lst p-lst
								(setq name (car lst))
								(if (Add-Poly2D-Point name (cdr lst) pt-c)
									(setq n (1+ n))
								)
							)
							(setq p (1+ p))
							(if (> n 0)
								(prompt	(strcat	"\nPoint n°"
										(itoa p)
										" :  "
										(itoa n)
										" / "
										(itoa (sslength jsel))
										" polylignes traitées avec succès, ajout du point "
										(vl-princ-to-string pt-c)
										"."
										"\n"
									)
								)
								(prompt	(strcat	"\nPoint n°"
										(itoa p)
										" :  "
										"Echec lors de l'ajout du point "
										(vl-princ-to-string pt-c)
									)
								)
							)
						)
						(progn
							(setq break T)
							(prompt "\nFin d'exécution de la commande.")
						)
					)
				)
				(progn
					(setq break T)
					(prompt "\nFin d'exécution de la commande.")
				)
			)
		)
	)
	(redraw)
	(sssetfirst nil nil)
	(princ)

)

Etant donné que l'accrochage aux objets peut s'avérer fort utile pour ce genre de chose, et que je n'ai pas trouvé mieux que les programmes de LeeMac (et que je n'ai pas du tout le niveau pour comprendre ou modifier un de ses programmes mais ils sont fabuleux), voici l'ensemble des fonctions nécessaires pour pouvoir utiliser l'accrochage aux objets directement avec (grread) :

;; Object Snap for grread: Snap Function  -  Lee Mac
;; Returns: [fun] A function requiring two arguments:
;; p - [lst] UCS Point to be snapped
;; o - [int] Object Snap bit code
;; The returned function returns either the snapped point (displaying an appropriate snap symbol)
;; or the supplied point if the snap failed for the given Object Snap bit code.

(defun LM:grsnap:snapfunction ( )
    (eval
        (list 'lambda '( p o / q )
            (list 'if '(zerop (logand 16384 o))
                (list 'if
                   '(setq q
                        (cdar
                            (vl-sort
                                (vl-remove-if 'null
                                    (mapcar
                                        (function
                                            (lambda ( a / b )
                                                (if (and (= (car a) (logand (car a) o)) (setq b (osnap p (cdr a))))
                                                    (list (distance p b) b (car a))
                                                )
                                            )
                                        )
                                       '(
                                            (0001 . "_end")
                                            (0002 . "_mid")
                                            (0004 . "_cen")
                                            (0008 . "_nod")
                                            (0016 . "_qua")
                                            (0032 . "_int")
                                            (0064 . "_ins")
                                            (0128 . "_per")
                                            (0256 . "_tan")
                                            (0512 . "_nea")
                                            (2048 . "_app")
                                            (8192 . "_par")
                                        )
                                    )
                                )
                               '(lambda ( a b ) (< (car a) (car b)))
                            )
                        )
                    )
                    (list 'LM:grsnap:displaysnap '(car q)
                        (list 'cdr
                            (list 'assoc '(cadr q)
                                (list 'quote
                                    (LM:grsnap:snapsymbols
                                        (atoi (cond ((getenv "AutoSnapSize")) ("5")))
                                    )
                                )
                            )
                        )
                        (LM:OLE->ACI
                            (if (= 1 (getvar 'cvport))
                                (atoi (cond ((getenv "Layout AutoSnap Color")) ("117761")))
                                (atoi (cond ((getenv  "Model AutoSnap Color")) ("104193")))
                            )
                        )
                    )
                )
            )
           '(cond ((car q)) (p))
        )
    )
)

;; Object Snap for grread: Display Snap  -  Lee Mac
;; pnt - [lst] UCS point at which to display the symbol
;; lst - [lst] grvecs vector list
;; col - [int] ACI colour for displayed symbol
;; Returns nil

(defun LM:grsnap:displaysnap ( pnt lst col / scl )
    (setq scl (/ (getvar 'viewsize) (cadr (getvar 'screensize)))
          pnt (trans pnt 1 2)
    )
    (grvecs (cons col lst)
        (list
            (list scl 0.0 0.0 (car  pnt))
            (list 0.0 scl 0.0 (cadr pnt))
            (list 0.0 0.0 scl 0.0)
           '(0.0 0.0 0.0 1.0)
        )
    )
)

;; Object Snap for grread: Snap Symbols  -  Lee Mac
;; p - [int] Size of snap symbol in pixels
;; Returns: [lst] List of vector lists describing each Object Snap symbol

(defun LM:grsnap:snapsymbols ( p / -p -q -r a c i l q r )
    (setq -p (- p) q (1+  p)
          -q (- q) r (+ 2 p)
          -r (- r) i (/ pi 6.0)
           a 0.0
    )
    (repeat 12
        (setq l (cons (list (* r (cos a)) (* r (sin a))) l)
              a (- a i)
        )
    )
    (setq c (apply 'append (mapcar 'list (cons (last l) l) l)))
    (list
        (list 1
            (list -p -p) (list p -p) (list p -p) (list p p) (list p p) (list -p p) (list -p p) (list -p -p)
            (list -q -q) (list q -q) (list q -q) (list q q) (list q q) (list -q q) (list -q q) (list -q -q)
        )
        (list 2
            (list -r -q) (list 0  r) (list 0  r) (list r -q)
            (list -p -p) (list p -p) (list p -p) (list 0  p) (list 0  p) (list -p -p)
            (list -q -q) (list q -q) (list q -q) (list 0  q) (list 0  q) (list -q -q)
        )
        (cons 4 c)
        (vl-list* 8 (list -r -r) (list r r) (list r -r) (list -r r) c)
        (list 16
            (list p 0) (list 0 p) (list 0 p) (list -p 0) (list -p 0) (list 0 -p) (list 0 -p) (list p 0)
            (list q 0) (list 0 q) (list 0 q) (list -q 0) (list -q 0) (list 0 -q) (list 0 -q) (list q 0)
            (list r 0) (list 0 r) (list 0 r) (list -r 0) (list -r 0) (list 0 -r) (list 0 -r) (list r 0)
        )
        (list 32
            (list  r r) (list -r -r) (list  r q) (list -q -r) (list  q r) (list -r -q)
            (list -r r) (list  r -r) (list -q r) (list  r -q) (list -r q) (list  q -r)
        )
        (list 64
            '( 0  1) (list  0  p) (list  0  p) (list -p  p) (list -p  p) (list -p -1) (list -p -1) '( 0 -1)
            '( 0 -1) (list  0 -p) (list  0 -p) (list  p -p) (list  p -p) (list  p  1) (list  p  1) '( 0  1)
            '( 1  2) (list  1  q) (list  1  q) (list -q  q) (list -q  q) (list -q -2) (list -q -2) '(-1 -2)
            '(-1 -2) (list -1 -q) (list -1 -q) (list  q -q) (list  q -q) (list  q  2) (list  q  2) '( 1  2)
        )
        (list 128
            (list (1+ -p) 0) '(0 0) '(0 0) (list 0 (1+ -p))
            (list (1+ -p) 1) '(1 1) '(1 1) (list 1 (1+ -p))
            (list -p q) (list -p -p) (list -p -p) (list q -p)
            (list -q q) (list -q -q) (list -q -q) (list q -q)
        )
        (vl-list* 256 (list -r r)  (list r r) (list -r (1+ r)) (list r (1+ r)) c)
        (list 512
            (list -p -p) (list  p -p) (list -p  p) (list p p) (list -q -q) (list  q -q)
            (list  q -q) (list -q  q) (list -q  q) (list q q) (list  q  q) (list -q -q)
        )
        (list 2048
            (list   -p     -p) (list    p      p) (list   -p      p) (list    p     -p)
            (list (+ p 05) -p) (list (+ p 06) -p) (list (+ p 05) -q) (list (+ p 06) -q)
            (list (+ p 09) -p) (list (+ p 10) -p) (list (+ p 09) -q) (list (+ p 10) -q)
            (list (+ p 13) -p) (list (+ p 14) -p) (list (+ p 13) -q) (list (+ p 14) -q)
            (list -p -p) (list p -p) (list p -p) (list p p) (list p p) (list -p p) (list -p p) (list -p -p)
            (list -q -q) (list q -q) (list q -q) (list q q) (list q q) (list -q q) (list -q q) (list -q -q)
        )
        (list 8192 (list r 1) (list -r -q) (list r 0) (list -r -r) (list r q) (list -r -1) (list r r) (list -r 0))
    )
)

;; Object Snap for grread: Parse Point  -  Lee Mac
;; bpt - [lst] Basepoint for relative point input, e.g. @5,5
;; str - [str] String representing point input
;; Returns: [lst] Point represented by the given string, else nil

(defun LM:grsnap:parsepoint ( bpt str / str->lst lst )
 
    (defun str->lst ( str / pos )
        (if (setq pos (vl-string-position 44 str))
            (cons (substr str 1 pos) (str->lst (substr str (+ pos 2))))
            (list str)
        )
    )

    (if (wcmatch str "`@*")
        (setq str (substr str 2))
        (setq bpt '(0.0 0.0 0.0))
    )           

    (if
        (and
            (setq lst (mapcar 'distof (str->lst str)))
            (vl-every 'numberp lst)
            (< 1 (length lst) 4)
        )
        (mapcar '+ bpt lst)
    )
)

;; Object Snap for grread: Snap Mode  -  Lee Mac
;; str - [str] Object Snap modifier
;; Returns: [int] Object Snap bit code for the given modifier, else nil

(defun LM:grsnap:snapmode ( str )
    (vl-some
        (function
            (lambda ( x )
                (if (wcmatch (car x) (strcat (strcase str t) "*"))
                    (progn
                        (princ (cadr x)) (caddr x)
                    )
                )
            )
        )
       '(
            ("endpoint"      " of " 00001)
            ("midpoint"      " of " 00002)
            ("center"        " of " 00004)
            ("node"          " of " 00008)
            ("quadrant"      " of " 00016)
            ("intersection"  " of " 00032)
            ("insert"        " of " 00064)
            ("perpendicular" " to " 00128)
            ("tangent"       " to " 00256)
            ("nearest"       " to " 00512)
            ("appint"        " of " 02048)
            ("parallel"      " to " 08192)
            ("none"          ""     16384)
        )
    )
)

;; OLE -> ACI  -  Lee Mac
;; Args: c - [int] OLE Colour

(defun LM:OLE->ACI ( c )
    (apply 'LM:RGB->ACI (LM:OLE->RGB c))
)

;; OLE -> RGB  -  Lee Mac
;; Args: c - [int] OLE Colour

(defun LM:OLE->RGB ( c )
    (mapcar '(lambda ( x ) (lsh (lsh (fix c) x) -24)) '(24 16 8))
)

;; RGB -> ACI  -  Lee Mac
;; Args: r,g,b - [int] Red, Green, Blue values

(defun LM:RGB->ACI ( r g b / c o )
    (if (setq o (vla-getinterfaceobject (LM:acapp) (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2))))
        (progn
            (setq c (vl-catch-all-apply '(lambda ( ) (vla-setrgb o r g b) (vla-get-colorindex o))))
            (vlax-release-object o)
            (if (vl-catch-all-error-p c)
                (prompt (strcat "\nError: " (vl-catch-all-error-message c)))
                c
            )
        )
    )
)

;; Application Object  -  Lee Mac
;; Returns the VLA Application Object

(defun LM:acapp nil
    (eval (list 'defun 'LM:acapp 'nil (vlax-get-acad-object)))
    (LM:acapp)
)

(vl-load-com) (princ)

(Issus directement du site de LeeMac -> GrSnap !)

Bisous,
Luna

Olivier Eckmann · le 23 avril 2021

Bonjour Luna,

Merci pour le partage, la prévisualisation est vraiment sympa. J'ai quand même une question, il semble que l'on change de segment dès que l'on dépasse la moitié du segment, ce qui rend difficile l'ajout d'un sommet sur la seconde moitié du segment de la polyligne.

Est-ce le fonctionnement souhaité? Je joins un screencast de ce que j'obtiens : https://autode.sk/32GWWQg

Olivier

Luna · le 23 avril 2021

Coucou,

Vui, normalement pour ajouter un sommet à une polyligne, il suffit d'utiliser le menu d'un vertex pour spécifier le "point de départ" et le segment sera déterminé en fonction du sens de la polyligne (en amont ou en aval de ce point).
Ici le fonctionnement est identique, je ne peux pas spécifier un "segment de départ" étant donné que le but du programme est de pouvoir ajouter un point commun à un ensemble de polylignes. Donc ce que je fais c'est de demander un point de départ qui s'adaptera pour chaque polyligne. C'est l'équivalent d'un osnap sur les extrémités mais à l'échelle d'un dessin.
Donc le plus simple selon moi pour récupérer ce point de départ c'est de récupérer le sommet le plus proche du point spécifié pour chaque polyligne et d'afficher le segment impacté en fonction du sens de la polyligne. C'est un peu comme si on cliquait sur le vertex d'un point et qu'on ajoute le sommet depuis le menu dynamique sauf qu'on le fait pour plusieurs polylignes en même temps donc je récupère le point et non le segment pour la première sélection.

Cependant j'ai remarqué que plus le .dwg possède un grand nombre d'objets et plus le rafraîchissement est long et lag. Et ce, même si l'on effectue la commande sur une seule entité, ce qui est très frustrant... Donc il faudrait vraiment que j'optimise le programme au maximum pour limiter le nombre d'itérations et de boucle à chaque déplacement de la souris mais ce n'est pas simple... Bref un programme utile mais très vite saturé par le nombre d'objets situés dans le .dwg >n<

Petite question : Comment fais-tu le screencast ? Car cela peut s'avérer plus efficace que des mots parfois :3

Bisous,
Luna

lecrabe · le 23 avril 2021

Hello

Mais tu installes l'outil gratuit SCREENCAST d'Autodesk !

https://knowledge.autodesk.com/fr/search-result/caas/simplecontent/content/download-autodesk-screencast.html

La Sante, Bye, lecrabe (triste & fatigue)

Olivier Eckmann · le 23 avril 2021

Bonjour Luna,

Pour ajouter un sommet sur une poly, justement j'évite d'utiliser le grip carré de sommet, car je ne sais pas dans quel sens elle est parcouru. J'utilise le grip rectangulaire central du segment, comme ça je sais sur quel segment ça sera ajouté. C'est d'ailleurs un souci que l'on a sur les poly3D où le grip central n'existe pas!

Je m'attendais à un fonctionnement identique où le point (sous la souris) serait projeté sur le segment le plus proche afin de déterminer le segment "courant" et donc les 2 points "avant" et "après" entre lesquels on ajoute le sommet.

Dans une logique SIG, lorsque tu travailles sur des polygones adjacents, les contours sont toujours dessinés dans le même sens (normalement trigo) comme ça l'intérieur est toujours à gauche. Donc sur une limite commune, les 2 polylignes sont parcourues en sens opposées, donc l'ajout d'un segment commun doit se faire sur le segment "courant" et pas par rapport au sommet le plus proche : https://autode.sk/3sL3vLW

Je comprends ta logique et elle est tout à fait valable, je vais me permettre de reprendre ton code et de l'adapter à mes besoins spécifiques.

En tout cas, encore merci.

Olivier

Luna · le 23 avril 2021

Vouih en effet c'est une bonne remarque, mais il me semble que récupérer le segment "courant" est un peu plus long et l'avantage de ne pas se pré-occuper du sens de la polyligne c'est que l'entmod est simple. J'essaierai de regarder ce que chat donne pour une sélection de segments communs, mais du coup cela risque d'être plus compliquer à optimiser...
De plus cela soulève plusieurs questions, comme par exemple lorsqu'on veut ajouter un sommet à la fin d'une polyligne ou si on clique sur un sommet (pouvant appartenir à 1, 2 voire plusieurs segments), quel segment choisir ? bref, les sommets était plus simple ^^"

Lors de mes essais, en ayant seulement 100 objets sur le dessin (et en en modifiant qu'une seule !), le logo de chargement était visible et à 1000, les fps dropent instantanément... Donc en vrai je ne suis même pas sûre que son utilisation soit...viable à la longue !

Bisous,
Luna

Modifié le 23 avril 2021 par Luna

lecrabe · le 23 avril 2021

Hello @Olivier Eckmann & @Luna

Merci Luna pour tes magnifiques contributions !

Au fait Olivier, quand tu auras realiser la version Carto / SIG, SVP je suis preneur !?

La Sante, Bye, lecrabe (triste & fatigue)

Patrick Emin · le 23 avril 2021

3 hours ago, lecrabe said:

Hello

Mais tu installes l'outil gratuit SCREENCAST d'Autodesk !

https://knowledge.autodesk.com/fr/search-result/caas/simplecontent/content/download-autodesk-screencast.html

La Sante, Bye, lecrabe (triste & fatigue)

Oui voir le tuto: https://forums.autodesk.com/t5/guides-de-l-utilisateur-des/comment-faire-un-screencast-autodesk-et-l-integrer-dans-vos/m-p/7051975#M88

Luna · le 23 avril 2021

Ooooohhh merci beaucoup !!!

C'est tellement mieux ainsi !!! Et c'est gratuit, quoi de plus parfait :3 Encore merci ♥

Bisous,
Luna

Olivier Eckmann · le 23 avril 2021

Bonjour,

J'ai refait une version rapide, sans les accrochages, ni la gestion des SCU, ni les erreurs

Il reste 1 problème pour ajouter un sommet avant le 1er point

(defun C:PolyAddVtx ( / JEU I rd oPoly PT PtPro PT1 PT2 dParam lsParam)
  (if (setq JEU (ssget (list (cons 0 "LWPOLYLINE"))))
    (progn
      (while (= 5 (car (setq rd (grread T 15 0))))
	(redraw)
	(setq PT (cadr rd)  lsParam nil)
	(repeat (setq i (sslength JEU))
	  (setq oPoly (ssname JEU (setq i (1- i))))
	  (setq PtPro (vlax-curve-getClosestPointTo oPoly PT nil))
	  (setq dParam (vlax-curve-GetParamAtPoint oPoly PtPro))
	  (cond ((<= dParam (vlax-curve-GetStartParam oPoly))
		 (setq PT1 nil  PT2 (vlax-curve-GetStartPoint oPoly)
		       lsParam (append lsParam (list (list oPoly -1))))  ; ajout le sommet au début
		)
		((>= dParam (vlax-curve-GetEndParam oPoly))
		 (setq PT1 (vlax-curve-GetEndPoint oPoly) PT2 nil
		       lsParam (append lsParam (list (list oPoly (vlax-curve-GetEndParam oPoly))))) ; ajoute le sommet à la fin
		)
		(T
		 (setq PT1 (vlax-curve-GetPointAtParam oPoly (fix dParam))
		       PT2 (vlax-curve-GetPointAtParam oPoly (1+ (fix dParam)))
		       lsParam (append lsParam (list (list oPoly (fix dParam)))))
		)
	  )
	  (if PT1 (grdraw PT1 PT 1 1))
	  (if PT2 (grdraw PT2 PT 1 1))
	)
      )
      (if (= 3 (car rd))
	(progn
	  (redraw)
	  (setq PT (cadr rd))
	  (repeat (setq i (sslength JEU))
	    (setq oPoly (ssname JEU (setq i (1- i))))
	    (setq iParam (cadr (assoc oPoly lsParam)))
	    (OE:InsertVtxAt oPoly PT iParam)
	  )
	)
      )
      (redraw)
    )
  )
)

(defun OE:InsertVertex (oPoly PT idx)
  (setq oVlaPoly (vlax-ename->vla-object (car oPoly))
      	PT (reverse (cdr (reverse PT)))
	2Dvarpnt (vlax-make-variant
	  (vlax-safearray-fill
	    (vlax-make-safearray
		vlax-vbdouble
		(cons 0 (- (vl-list-length PT) 1))
	    )
	    PT)
	  )
  )
  (vla-addvertex oVlaPoly idx 2Dvarpnt)
)


(vl-load-com)

Olivier

Luna · le 23 avril 2021

Coucou,

Du coup tu as opté pour supprimer la seconde boucle permettant de spécifier le point à ajouter ^^" Même si chat ajoute un (grread), cela permet de spécifier un nouveau point proche d'un autre segment que celui spécifié par exemple, autrement on est obligé d'ajouter un point situé entre la projection deux sommets du segment, ce qui peut s'avérer limitant à l'utilisation, nan ? :S

Je me doutais que tu passerais par les fonction (vlax-curve), mais je viens (enfin !) de comprendre la définition d'un paramètre, ce qui me facilite grandement la récupération des sommets d'un segment !! 0w0 Nettement plus simple que de récupérer la liste des points et de regarder la position du point sélectionner par rapport à la liste ^^
Pour la modification des polylignes, je ne maîtrise pas du tout les safe-array &Co donc je ne sais pas vraiment quelle est le plus rapide et/ou simple entre (entmod) et (vla-add-vertex)...

21 minutes ago, Olivier Eckmann said:

Il reste 1 problème pour ajouter un sommet avant le 1er point

Qu'est-ce qui pose problème ? Il suffit d'ajouter le point devant les autres non ? Bon après je réfléchis en modification de liste DXF donc je ne sais pas si c'est pareil pour les fonctions vlax-* :3
Je ne me suis pas non plus posée la question dans le cas où, la polyligne est fermée :S

Juste une question, pourquoi utiliser la fonction (append) au lieu de (cons) pour la création de ta liste de points ?

Bisous,
Luna

(gile) · le 23 avril 2021

Salut,

Je n'ai pas vraiment suivi ce sujet, mais je me suis souvenu qu'il y a quelques temps déjà j'avais fait : AddVtx&DelVtx en LISP sur cette page et AVX et DVX en .NET sur cette page.

Luna · le 23 avril 2021

Coucou @(gile) !

Merci du partage :3 Cependant AddVtx et DelVtx ne fonctionne que pour une unique entité linéaire...Mais si c'est applicable pour une entité, c'est applicable pour un ensemble en généralisant quelques inputs :)

Bisous,
Luna

Olivier Eckmann · le 23 avril 2021

Je comprends mieux le fonctionnement de ta fonction et pourquoi ça demandait 2 fois un point à cliquer => le 1er permet de choisir le segment sur lequel on travaille et le second point c'est le vrai point à ajouter. Je n'y étais pas du tout.

Pour l'ajout de sommet au début, en .Net on a une fonction AddVertexAt qui permet d'insérer un sommet n'importe où y compris en position 0 ce qui l'ajoute en 1ère position => en début de liste.

Pour la partie ActiveX, on a bien un AddVertex avec un indice, mais même en spécifiant 0 ça l'ajoute entre le 1er et le 2nd sommet. Je n'est pas trouvé pour ajouter en 1ère position avant la liste des sommets existants. Sinon, en lisp pas de souci, effectivement. Je trouvais juste le AddVertex plus court à implémenter.

Pour les make-safe-array ... , rassures toi, moi non plus je n'y comprends rien, j'ai cherché sur Google.

Pourquoi utiliser "append", plutôt que "cons" => parce que j'ai l'habitude de faire comme ça, je ne me pose même plus la question. Mais pourquoi pas, ça me fait gagner un "(list"

Olivier

Luna · le 23 avril 2021

2 minutes ago, Olivier Eckmann said:

Je comprends mieux le fonctionnement de ta fonction et pourquoi ça demandait 2 fois un point à cliquer => le 1er permet de choisir le segment sur lequel on travaille et le second point c'est le vrai point à ajouter. Je n'y étais pas du tout.

Vouih, je m'en serais bien passé (parce que du coup le (grread) tourne deux fois) mais c'est un mal nécessaire :3 C'est le même principe que pour la méthode native : on spécifie le segment/sommet à partir duquel on veut travailler, puis on ajoute le point. Sauf que là le segment peut être différent entre plusieurs polylignes donc bon... ^^" Mais j'avoue que ce n'était pas forcément très clair de prime abord !

6 minutes ago, Olivier Eckmann said:

Pour les make-safe-array ... , rassures toi, moi non plus je n'y comprends rien, j'ai cherché sur Google.

Bon ben chat me rassure un peu alors ! Bon théoriquement ce n'est rien de plus qu'une matrice mais j'avoue que j'ai besoin de "voir" la matrice pour comprendre les calculs à faire donc le visual j'ai un peu du mal car on obtient toujours des #<safearray...> ce qui complexifie un peu la lecture... (ce n'est que très récemment que j'ai appris qu'avec l'espion on pouvait "parcourir" les VLA-Object par un double-clic donc par exemple d'écrire (vlax-get-acad-object), l'espionner et parcourir toutes les propriétés disponibles pour récupérer une infos utiles comme par exemple la liste des layers, layouts, etc).
Bref j'apprends toujours mais le Visual me fait un peu peur donc je préfère approfondir mes connaissances en LISP pour maîtriser à minima un langage avant d'en apprendre de nouveaux ! Entre rien savoir sur tout ou tout savoir sur rien, je préfère partir de rien xD

13 minutes ago, Olivier Eckmann said:

Pourquoi utiliser "append", plutôt que "cons" => parce que j'ai l'habitude de faire comme ça, je ne me pose même plus la question. Mais pourquoi pas, ça me fait gagner un "(list"

Il me semble surtout que les (append) sont beaucoup plus lent à l'exécution que des (cons) et (reverse) mais je n'en suis pas sûre du tout pour être honnête...^^" Il faudrait faire un benchmark pour vérifier mais bon, c'est du pinaillage sur un programme pas complet ^^

En tous cas, merci de prendre du temps pour chercher un développement fonctionnel :3

Bisous,
Luna

didier · le 23 avril 2021

Bonjour

Je confirme la lenteur de append en comparaison de cons
Je n'ai pas fait de tests depuis longtemps, mais l'ordre de grandeur est environ de 1 à 10
cons est dix fois plus rapide qu'append

Toutefois, il faut que la liste soit particulièrement grande pour l'observer, jusqu'à mille (1000) éléments dans la liste c'est transparent

Amicalement

Connexion

PolyAddPoint et PolyDelPoint

Messages recommandés

Luna

bonuscad

Luna

Luna

Olivier Eckmann

Luna

lecrabe

Olivier Eckmann

Luna

lecrabe

Patrick Emin

Luna

Olivier Eckmann

Luna

(gile)

Luna

Olivier Eckmann

Luna

didier

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante