Lisp défectueux - Insetion de bloc sur extrémités

[G2.toff]

Bonjour,

Je cherchais un lisp susceptible d'insérer un bloc aux extrémités de polylignes (pas aux sommets)et j'ai trouvé un lisp de lili2006 (qui date un peu)qui ne fonctionne pas sur MAP3D 2013 donc je ne sais pas comment il fonctionne. Si quelqu'un pouvait le regarder !

 

J'ai pas mal fouillé le net mais je ne trouve pas d'autre lisp se rapprochant de ma recherche. J'ai trouvé des lisp qui m'insèrent des blocs (déjà présent dans mon dessin), aux sommets de poly que je dois sélectionner manuellement.

 

En fait je cherchais un lisp capable de m'insérer des blocs (pas forcements présents dans mon dessin mais présent dans ma bibliothèque (raccourcis créé dans outils/options/fichiers/chemin de recherche)) aux extrémités de polylignes se trouvant sur un calque précis.

Par exemple insérer un bloc QQ1 aux extrémités des poly du calque CC1 et un bloc QQ2 sur les poly du calques CC2, puis de finir par décomposer tous ces blocs commençants par QQ* afin de récupérer leur contenu (en fait ces blocs pourraient contenir d'autre blocs, textes, attribut,poly, etc...).

 

Voilà, si quelqu'un pouvait venir à mon secours !!!!

 

 

(defun c:ins-vtx (/ acdoc space bname ss lay layf n ins)

(vl-load-com)

(setq acdoc (vla-get-activeDocument (vlax-get-acad-object))

space (if (= (getvar "CVPORT") 1)

(vla-get-PaperSpace acdoc)

(vla-get-ModelSpace acdoc)

)

)

(if (setq bname (getblock "Nom du bloc"))

(progn

(if (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 bname))))

(setq lay (cdr (assoc 8 (entget (ssname ss 0)))))

)

(if (setq layf (getlayer "Choisir le calque filtre de polylignes"))

(if (ssget "_X" (list '(0 . "*POLYLINE") (cons 8 layf)))

(progn

(vla-startUndoMark acdoc)

(vlax-for pl (vla-get-ActiveSelectionSet acdoc)

(setq n (fix (vlax-curve-getEndParam pl)))

(or (= (vla-get-Closed pl) :vlax-false)

(setq n (1- n))

)

(repeat (1+ n)

(setq ins

(vla-InsertBlock

space

(vlax-3d-point (vlax-curve-getPointAtParam pl n))

bname

1.0

1.0

1.0

0.0

)

)

(if lay

(vla-put-layer ins lay)

)

(setq n (1- n))

)

)

(vla-EndUndoMark acdoc)

)

)

[bonuscad]

Bonjour,

 

Je n'ai pas regardé en détail ins_vtx, mais il n'a pas l'air complet! (les parenthèses ne sont pas appariées)

Je te propose celui-ci qui date un peu aussi, je te laisse adapter...

 

(defun c:blk2end ( / obj dxf_obj obj_vlax pt1_start pt2_start par pt1_end pt2_end dxf_210)
(defun z_dir (p1 p2 / )
 (trans
   '(0.0 1.0 0.0)
   (mapcar
     '(lambda (k)
       (/ k
         (sqrt
           (apply '+
             (mapcar
               '(lambda (x) (* x x))
               (mapcar '- p2 p1)
             )
           )
         )
       )
     )
     (mapcar '- p2 p1)
   )
   0
 )
)
 (while (not (setq obj (entsel "\nSelect a polyline: "))))
 (cond
   ((or (eq (cdr (assoc 0 (setq dxf_obj (entget (car obj))))) "LWPOLYLINE")
     (and
       (eq (cdr (assoc 0 dxf_obj)) "POLYLINE")
       (zerop (boole 1 112 (cdr (assoc 70 dxf_obj))))
     )
   )
     (vl-load-com)
     (setq
       obj_vlax (vlax-ename->vla-object (car obj))
       pt1_start (vlax-curve-getStartPoint obj_vlax)
       pt1_end (vlax-curve-getEndPoint obj_vlax)
       par (vlax-curve-getParamAtPoint obj_vlax pt1_end)
     )
     (cond
       ((not (zerop par))
         (setq
           pt2_start (vlax-curve-getPointAtParam obj_vlax 1)
           pt2_end (vlax-curve-getPointAtParam obj_vlax (1- par))
         )
         (while (not (tblsearch "BLOCK" (setq name_blk (getstring "\nName of block: " T))))
           (princ "\n ** incorrect name block! **")
         )
         (foreach n (list (list pt1_start pt2_start) (list pt1_end pt2_end))
           (setq dxf_210 (z_dir (car n) (cadr n)))
           (entmake
             (list
               (cons 0 "INSERT")
               (cons 100 "AcDbEntity")
               (assoc 67 dxf_obj)
               (assoc 410 dxf_obj)
               (cons 8 (getvar "CLAYER"))
               (cons 100 "AcDbBlockReference")
               (cons 2 name_blk)
               (cons 10 (trans (car n) 0 dxf_210))
               (cons 50 (angle (trans (car n) 0 dxf_210) (trans (cadr n) 0 dxf_210)))
               (cons 210 dxf_210)
             )
           )
         )
       )
     )
   )
   (T
     (princ "\nIsn't 2Dpolyline avalaible for this function!")
   )
 )
 (prin1)
)

[G2.toff]

Bonjour,

 

Merci bien pour ta réponse très rapide, il marche celui-ci et c'est ce que je recherche au niveau résultat.

 

Maintenant il faut que je trouve comment le faire évoluer pour que la démarche soit plus simple, j'ai 2 points à faire évoluer.

 

Premièrement, sur ce lisp, il faut entrer le nom d'un bloc (pas forcément connu pas tout le monde) et surtout si le bloc n'est pas présent dans le dessin, il ne trouve pas le bloc à insérer. Il faut que j'arrive à intégrer dans le lisp le nom du ou des blocs à insérer ainsi que leur chemin, pour qu'il les trouve.

 

Deuxièmement, on ne peut sélectionner qu'une polyligne, il faudrait qu'il le fasse sur toutes les polyligne d'un calque ou de plusieurs calques précis qui seraient listés dans le lisp.

 

Encore merci et à bientôt...