CADXChange

Toutes les commandes LISP

CXJOINMesure et polylignesVersion 1.0.0Testé dans AutoCAD

Joindre lignes et arcs en polylignes, avec tolérance d'écart

Joint les lignes, arcs et polylignes qui se touchent en polylignes uniques, et peut combler de petits écarts jusqu'à une distance que vous fixez.

Télécharger cxjoin.lspConditions LISP

Comment l'utiliser

  1. Saisissez CXJOIN et sélectionnez les lignes, arcs et polylignes.
  2. Saisissez l'écart maximal à combler, ou 0 pour des extrémités exactes.
  3. Les chaînes qui se rejoignent deviennent des polylignes.

Bon à savoir

  • Les objets qui ne touchent rien restent tels quels.

Le charger dans AutoCAD

  1. Enregistrez le fichier où vous voulez.
  2. Tapez APPLOAD, choisissez le fichier et cliquez sur Charger.
  3. Tapez le nom de la commande : CXJOIN.

Pour l'avoir à chaque démarrage, ajoutez-le à la Mallette de démarrage dans la même boîte de dialogue, ou chargez un dossier entier d'un coup avec le chargeur facultatif. À propos du chargeur facultatif

Testé dans AutoCAD (version complète). D'autres programmes qui exécutent AutoLISP peuvent fonctionner, mais ils n'ont pas été testés.

Le code

Du texte brut, rien de caché. Copiez-le dans un fichier nommé cxjoin.lsp ou téléchargez-le.

;;; ============================================================================
;;; CXJOIN - Join lines and arcs into polylines, gaps allowed
;;; Version 1.0.0
;;; CADXChange LISP tools - https://cadxchange.net/resources/lisp/cxjoin
;;; Tested in: AutoCAD (full version). Other programs that run AutoLISP may work but are not tested.
;;; Copyright (c) CADXChange. Free for personal and commercial use; do not resell or
;;; republish it as a collection. Terms: https://cadxchange.net/legal/lisp-terms
;;; ============================================================================

;; Join the lines, arcs and polylines in NAMES into polylines, bridging gaps up to FUZZ.
;; PEDITACCEPT must be 1 so that lines and arcs convert without a question.
(defun cx:join-run (names fuzz / ss)
  (setq ss (ssadd))
  (foreach e names (ssadd e ss))
  (command "_.PEDIT" "_M" ss "" "_J" fuzz "")
  (princ))

(defun c:CXJOIN ( / *error* cx:sv ss fuzz before)
  (setq *error* cx:err)
  (if (setq ss (cx:pick "\nSelect lines, arcs and polylines to join: " '((0 . "LINE,ARC,LWPOLYLINE"))))
    (progn
      (setq fuzz   (cx:ask-real "Join gaps up to this distance (0 for exact ends only)" 0.0)
            before (sslength ss))
      (cx:start '(("CMDECHO" . 0) ("PEDITACCEPT" . 1)))
      (cx:join-run (cx:ss->list ss) fuzz)
      (princ (strcat "\nJoined " (itoa before) " selected object(s)."))
      (cx:end)))
  (princ))


;;; ---- Shared helpers (used by the command above; identical in every CADXChange tool) ----

;; Close the undo step and put the system variables back.
(defun cx:end ()
  (foreach v cx:sv (setvar (car v) (cdr v)))
  (command "_.UNDO" "_End")
  (setq cx:sv nil)
  (princ))

;; Error handler: restores everything, stays quiet on Esc.
(defun cx:err (msg)
  (if (> (getvar "CMDACTIVE") 0) (command))
  (cx:end)
  (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")))
    (princ (strcat "\nError: " msg)))
  (princ))

;; Use the objects already selected, or ask the user to select; FILTER is an ssget filter list or nil.
(defun cx:pick (msg filter / ss)
  (setq ss (if filter (ssget "_I" filter) (ssget "_I")))
  (if (null ss)
    (progn
      (princ msg)
      (setq ss (if filter (ssget filter) (ssget)))))
  ss)

;; Real X as text with at most PREC decimals and no trailing zeros ("2.50" -> "2.5", "3.00" -> "3").
(defun cx:num (x prec / s)
  (setq s (rtos x 2 prec))
  (if (wcmatch s "*.*")
    (progn
      (while (= (substr s (strlen s)) "0") (setq s (substr s 1 (1- (strlen s)))))
      (if (= (substr s (strlen s)) ".") (setq s (substr s 1 (1- (strlen s)))))))
  (if (or (= s "-0") (= s "")) "0" s))

(defun cx:ask-real (msg def / v)
  (setq v (getreal (strcat "\n" msg " <" (cx:num def 6) ">: ")))
  (if v v def))

;; Save the system variables in VARS ((name . value) ...), set them, and open one undo step.
;; The caller declares cx:sv as a local so the saved values live exactly as long as the command.
(defun cx:start (vars)
  (setq cx:sv (mapcar (function (lambda (v) (cons (car v) (getvar (car v))))) vars))
  (command "_.UNDO" "_Begin")
  (foreach v vars (setvar (car v) (cdr v)))
  (princ))

;; Selection set to a list of entity names.
(defun cx:ss->list (ss / i out)
  (setq i 0)
  (if ss
    (repeat (sslength ss)
      (setq out (cons (ssname ss i) out)
            i   (1+ i))))
  (reverse out))

(princ "\nCXJOIN loaded. Type CXJOIN to start.")
(princ)

Historique des versions

Version 1.0.0 · 27 octobre 2026

Première version.

Autres commandes : Mesure et polylignes