AutoCAD - Francais

AutoCAD - Francais

Répondre
Distinguished Contributor
dolives
Envois : 207
Inscrit : ‎09-04-2002
Message 1 sur 4 (405 visites)

inserer vertex polyligne

405 Visites, 3 Réponses
01-26-2007 02:07 AM
Bonjour à tous,
J'ai trouvé sur le forum US cette routine, j'ai adapté les commandes avec "_" pour l'internationnalisation, mais
celà ne semble pas suffir !
Comme mon lisp est encore un peut balbutiant , je fais appel
à vous.

Daniel OLIVES
; ------------------------------------------------------------------------------------------
; 05-5 - Ajoute des sommets à une polyligne sans perdre les XDATA
; ------------------------------------------------------------
;;;ADV.LSP ADD VERTEX TO POLYLINE (C)2002, Aniyam Kandiyil
;;;ADDS VERTEX TO A POLYLINE WITHOUT LOOSING XDATA
;;;(command "convertpoly")
(defun c:ADV ()
(setvar "CMDECHO" 0)
(setq PK_PLN (entsel
"\n* Sélectionner le point de la polyligne sélectionnée Hylight où vous souhaitez l'ajouter *")
)
(cond ((= (cdr (assoc 0 (entget (car PK_PLN)))) "LWPOLYLINE") (ADV-IT2))
;|((/= (cdr (assoc 0 (entget (car PK_PLN)))) "LWPOLYLINE")
; (progn
; (setq Result (ARCH:WARNING
; "Voulez vous convertir la sélection\n"
; "Polyligne épaisse par Polyline fine\n"
; "Polyligne?\n\n"
; "SVP sélectionner l'option si aprés...\n"
:smileywink:
:smileywink:
:smileywink:
:smileywink:
;|;
((/= (cdr (assoc 0 (entget (car PK_PLN)))) "LWPOLYLINE")
(progn (command "_convertpoly" "l" PK_PLN "") (ADV-IT2))
)
)
;;(cond
;;((= 0 Result) (progn (command "convertpoly" "l" PK_PLN "")(ADV-IT2)))
;;((= 1 Result) (ARCH:CANCEL))
;:smileywink:
(princ)
)

; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(defun ADV-IT1 ()
(setvar "CMDECHO" 0)
(while (or (not (setq PK_PLN
(entsel
"\n* Pick Lightweight Polyline at point to add Vertex and Stretch: *")
)
)
(/= (cdr (assoc 0 (entget (car PK_PLN)))) "LWPOLYLINE")
)
(ARCH:ALERT-Q
"MsgBox \"You did not select a Lightweight Polyline.\nPlease try again.\"")
)
(ADV-IT2)
(princ))

(defun ADV-IT2 (/ CR_LYR PL_LST XD_LST PL_OPN PL_LYR PK_PNT NR_PNT NE_PNT
EN_PNT AN_MID
EN_PNT EN_PNT1 EN_PNT2 VTX_LST)
(setq CR_LYR (getvar "CLAYER")
PL_LST (entget (car PK_PLN))
PL_WID (cdr (assoc 40 PL_LST))
XD_LST (assoc -3 (entget (car PK_PLN) (list "*")))
PL_OPN (cdr (assoc 70 PL_LST))
PL_LYR (cdr (assoc 8 PL_LST))
PC_PNT (cadr PK_PLN)
PK_PNT (osnap PC_PNT "mid")
NR_PNT (osnap PC_PNT "nea")
NE_PNT (list (car PK_PNT) (cadr PK_PNT))
EN_PNT (osnap PC_PNT "end")
AN_MID (angle PK_PNT EN_PNT)
EN_PNT (polar PK_PNT (+ AN_MID pi) (distance PK_PNT EN_PNT))
EN_PNT2 (list (car EN_PNT) (cadr EN_PNT))
VTX_LST ()
) ;_ end of setq
(foreach
N PL_LST
(if (= (car N) 10)
(setq VTX_LST (append VTX_LST (list (cdr N))))
) ;_ end of if
) ;_ end of foreach
(RVS_VTX)
(entdel (car PK_PLN))
(setvar "CLAYER" PL_LYR)
(setvar "PLINEWID" PL_WID)
(command "_.PLINE" (foreach PT NVTX_LST (command PT)))
(if (= PL_OPN 1)
(command "_.pedit" (entlast) "_c" "")
) ;_ end of if
(if XD_LST
(progn (setq OBJ_LST (entget (entlast)))
(setq OBJ_LST (append OBJ_LST (list XD_LST)))
(entmod OBJ_LST)
) ;_ end of progn
) ;_ end of if
(setvar "CLAYER" CR_LYR)
(command "_stretch" "_c" NR_PNT NR_PNT "" NR_PNT)
(princ)
) ;_ end of defun

(defun RVS_VTX ()
(setq NVTX_LST ())
(setq FOUND NIL)
(setq N 0)
(setq NTH_VTX1 (nth N VTX_LST))
(setq NTH_VTX2 (nth (+ N 1) VTX_LST))
(while (and NTH_VTX1 NTH_VTX2)
(progn (if (not (member NTH_VTX1 NVTX_LST))
(setq NVTX_LST (append NVTX_LST (list NTH_VTX1)))) ;_ end of if
(FMIDP NTH_VTX1 NTH_VTX2)
(if (and (not (member NR_PNT NVTX_LST))
(= (car MIDPNT) (car NE_PNT))
(= (cadr MIDPNT) (cadr NE_PNT))
) ;_ end of and
(setq NVTX_LST (append NVTX_LST (list NR_PNT)))
) ;_ end of if
(if (not (equal NTH_VTX1 NTH_VTX2))
(setq NVTX_LST (append NVTX_LST (list NTH_VTX2)))
) ;_ end of if
(setq N (+ N 1))
(setq NTH_VTX1 (nth N VTX_LST))
(if (not (setq NTH_VTX2 (nth (+ N 1) VTX_LST)))
(progn (if (not (member NR_PNT NVTX_LST))
(setq NVTX_LST (append NVTX_LST (list NR_PNT)))
) ;end of if
(setq NTH_VTX1 NIL)
) ;_ end of progn
) ;_ end of if
) ;progn
) ;while
) ;_ end of defun

(defun FMIDP (SP LP)
(setq MIDPNT (list (/ (+ (car SP) (car LP)) 2.0) (/ (+ (cadr SP) (cadr LP)) 2.0)) ;_ end of list
) ;_ end of setq
) ;_ end of defun

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Remove Pline vertice
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun drop (lst item)
(append (reverse (cdr (member item (reverse lst))))
(cdr (member item lst)))
)

;;;
(defun massoc (key alist / x nlist)
(foreach
x alist
(if (eq key (car x))
(setq nlist (cons (cdr x) nlist))))
(reverse nlist))
;;;
(defun rv (e pt)
(if (= (cdr (assoc 0 (setq e (entget e)))) "LWPOLYLINE")
(progn (setvar "cmdecho" 0)
(command "_undo" "_begin")
(entmod
(drop e
(cons 10
(if (= (type pt) 'LIST)
(progn (setq pt (trans pt 1 (cdr (assoc -1 e))))
(list (car pt) (cadr pt))
)
(nth pt (massoc 10 e))
)
)
)
)
(command "_undo" "_end")
(setvar "cmdecho" 1)
(princ)
)
) ; end if
)
;;;example--->(rv (car (entsel)) 2)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Remove Pline vertice
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:RMV (/ *CURR_OSNAP olderror SelectedEntity PolyProperties iCount iCount2 NewPoly)
(setq *CURR_OSNAP (getvar "osmode"))
(setq olderror *error*)
(setq *error* RVLispError)
(setvar "cmdecho" 0)
(command "_undo" "_begin")
(setvar "osmode" 0)
(setq SelectedEntity (car (entsel "\n* Select Pline to Remove Vertex *")))
(if (and (/= SelectedEntity nil)
(= (cdr (assoc 0 (entget SelectedEntity))) "LWPOLYLINE")
)
(progn (setq PolyProperties (entget SelectedEntity))
(initget 1)
(setvar "osmode" 32)
(setq SelectedVertex (getpoint "\n* Pick Vertex Point to Remove *"))
(setq iCount 0)
(while (< iCount (cdr (assoc 90 PolyProperties)))
(setq VertexPosition (cdr (nth (+ (* iCount 4) 14)
PolyProperties)))
(if (and (= (car VertexPosition) (car SelectedVertex))
(= (cadr VertexPosition) (cadr SelectedVertex)))
(progn (setq iCount2 0)
(while (< iCount2 4)
(setq NewPoly
(vL-remove
(nth (+ (* iCount 4) 14) PolyProperties)
PolyProperties))
(setq iCount2 (1+ iCount2))
)
(setq NewPoly
(subst (cons 90 (1- (cdr (assoc 90
PolyProperties))))
(assoc 90 PolyProperties)
NewPoly))
(entmod NewPoly)
(entupd (cdr (assoc -1 NewPoly)))
(setq iCount (cdr (assoc 90 PolyProperties)))
)
)
(setq iCount (1+ iCount))
)
)
(prompt "\n* No polylines selected! *")
) ; end if
(princ)
) ; end defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;

(defun c:AVX (/)
(setq cmde (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq osm (getvar "osmode"))
(setvar "osmode" 32)
(setq pnt (osnap (getpoint "\n* Pick intersection point *") "_int"))
(if pnt
(progn (setq ss (ssget "_C" pnt pnt (list (cons 0
"LWPOLYLINE,POLYLINE"))))
(while (> (sslength ss) 0)
(setq en (ssname ss 0))
(command "_break" en (trans pnt 1 en) "@")
(command "_pedit" "_m" en "_L" "" "_j" 0.000 "" "")
(ssdel en ss)
)
)
)
(setvar "cmdecho" cmde)
(setvar "osmode" osm)
(princ)
) ; end defun
(princ)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;
Distinguished Contributor
dolives
Envois : 207
Inscrit : ‎09-04-2002
Message 2 sur 4 (405 visites)

Re: inserer vertex polyligne

01-26-2007 02:10 AM en réponse à : dolives
Re
J'ai retrouvé le lien !!

http://discussion.autodesk.com/thread.jspa?messageID=4960533
Daniel OLIVES
*gégématic
Message 3 sur 4 (405 visites)

Re: inserer vertex polyligne

01-26-2007 03:06 AM en réponse à : dolives
Dans les KBtools de Kamal Boutora, il y a un arx qui fait la même chose.
Mais je crois que c'est une opération risquée d'ajouter ou de supprimer
un vertex à une polyline,
car la tu agis directement sur les pointeurs d'autocad, chaque vertex
connaissant le suivant ...
Pour le lisp, je vois qu'il n'y a pas beaucoup de commentaires, alors
j'ai pas trop envie de mettre les mains dedans ...
Bon courage

--
* * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Le site de G-EAUX et de PowerClic: http://www.g-eaux.com
Le newsgroup historique et indépendant d'Autocad
news://news.planetar.net/autocad.general
Distinguished Contributor
dolives
Envois : 207
Inscrit : ‎09-04-2002
Message 4 sur 4 (405 visites)

Re: inserer vertex polyligne

01-26-2007 04:32 AM en réponse à : dolives
Merci pour ta réponse.

Par contre le site de Kamal Boutora ne répond plus si qq avait
le fameux KBTools, je suis preneur.

Daniel OLIVES
Lyon - France
Post to the Community

Have questions about Autodesk products? Ask the community.

New Post
Annonces
Do you have 60 seconds to spare? The Autodesk Community Team is revamping our site ranking system and we want your feedback! Please click here to launch the 5 question survey. As always your input is greatly appreciated.