CADXChange

Todos los comandos LISP

CXPLCLOSEMedición y polilíneasVersión 1.0.0Probado en AutoCAD

Cerrar polilíneas cuyos extremos casi se tocan

Cierra las polilíneas abiertas cuyo final queda a menos de la distancia indicada de su inicio, y quita el último punto duplicado cuando los extremos coinciden exactamente.

Cómo se usa

  1. Escribe CXPLCLOSE y selecciona las polilíneas abiertas.
  2. Introduce el hueco máximo que se puede cerrar.
  3. Las polilíneas con un hueco mayor quedan abiertas.

Conviene saber

  • Útil antes de rayar o medir un área.

Cargarlo en AutoCAD

  1. Guarda el archivo donde quieras.
  2. Escribe APPLOAD, elige el archivo y pulsa Cargar.
  3. Escribe el nombre del comando: CXPLCLOSE.

Para tenerlo en cada inicio, agrégalo al Contenido de inicio en el mismo cuadro de diálogo, o carga una carpeta entera de una vez con el cargador opcional. Sobre el cargador opcional

Probado en AutoCAD (versión completa). Otros programas que ejecutan AutoLISP pueden funcionar, pero no se han probado.

El código

Texto sin más, nada oculto. Cópialo en un archivo llamado cxplclose.lsp o descárgalo.

;;; ============================================================================
;;; CXPLCLOSE - Close polylines whose ends almost meet
;;; Version 1.0.0
;;; CADXChange LISP tools - https://cadxchange.net/resources/lisp/cxplclose
;;; 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
;;; ============================================================================

;; Close the open polylines in NAMES whose end lies within TOL of their start. When the end sits exactly on the
;; start, the duplicate last vertex is dropped so that no zero-length segment is left. Returns how many were closed.
(defun cx:plclose-run (names tol / n ed verts startv endv)
  (setq n 0)
  (foreach e names
    (setq ed (entget e))
    (if (and (= (cx:dxf 0 ed) "LWPOLYLINE") (not (cx:ent-closed ed)))
      (progn
        (setq verts (cx:lw-verts ed)
              startv (car verts)
              endv   (last verts))
        (if (and (> (length verts) 2)
                 (<= (distance (list (car startv) (cadr startv)) (list (car endv) (cadr endv))) tol))
          (progn
            (if (< (distance (list (car startv) (cadr startv)) (list (car endv) (cadr endv))) 1e-9)
              (setq verts (reverse (cdr (reverse verts)))))
            (entmod (cx:lw-rebuild ed verts T))
            (entupd e)
            (setq n (1+ n)))))))
  n)

(defun c:CXPLCLOSE ( / *error* cx:sv ss tol)
  (setq *error* cx:err)
  (if (setq ss (cx:pick "\nSelect open polylines: " '((0 . "LWPOLYLINE"))))
    (progn
      (setq tol (cx:ask-real "Close polylines whose ends are closer than" 1.0))
      (cx:start '(("CMDECHO" . 0)))
      (princ (strcat "\n" (itoa (cx:plclose-run (cx:ss->list ss) tol)) " polyline(s) closed."))
      (cx:end)))
  (princ))


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

(defun cx:dxf (code ed)
  (cdr (assoc code ed)))

;; True for a closed polyline, a circle and a full ellipse.
(defun cx:ent-closed (ed / type)
  (setq type (cx:dxf 0 ed))
  (cond
    ((= type "LWPOLYLINE") (= 1 (logand 1 (cx:dxf 70 ed))))
    ((= type "CIRCLE") T)
    ((= type "ELLIPSE") (< (abs (- (- (cx:dxf 42 ed) (cx:dxf 41 ed)) (* 2.0 pi))) 1e-6))))

;; The vertices of an LWPOLYLINE entity list as ((x y bulge start-width end-width) ...).
(defun cx:lw-verts (ed / out cur)
  (foreach g ed
    (cond
      ((= (car g) 10)
       (if cur (setq out (cons cur out)))
       (setq cur (list (cadr g) (caddr g) 0.0 0.0 0.0)))
      ((and cur (= (car g) 40)) (setq cur (list (nth 0 cur) (nth 1 cur) (nth 2 cur) (cdr g) (nth 4 cur))))
      ((and cur (= (car g) 41)) (setq cur (list (nth 0 cur) (nth 1 cur) (nth 2 cur) (nth 3 cur) (cdr g))))
      ((and cur (= (car g) 42)) (setq cur (list (nth 0 cur) (nth 1 cur) (cdr g) (nth 3 cur) (nth 4 cur))))))
  (if cur (setq out (cons cur out)))
  (reverse out))

;; The entity list ED of an LWPOLYLINE with its vertices replaced by VERTS and the closed flag set to CLOSED.
(defun cx:lw-rebuild (ed verts closed / out placed)
  (foreach g ed
    (cond
      ((member (car g) '(10 40 41 42 91))
       (if (and (= (car g) 10) (not placed))
         (progn
           (setq placed T)
           (foreach v verts
             (setq out (cons (list 10 (nth 0 v) (nth 1 v)) out))
             (if (/= 0.0 (nth 3 v)) (setq out (cons (cons 40 (nth 3 v)) out)))
             (if (/= 0.0 (nth 4 v)) (setq out (cons (cons 41 (nth 4 v)) out)))
             (if (/= 0.0 (nth 2 v)) (setq out (cons (cons 42 (nth 2 v)) out)))))))
      ((= (car g) 90) (setq out (cons (cons 90 (length verts)) out)))
      ((= (car g) 70)
       (setq out (cons (cons 70 (if closed (boole 7 (cdr g) 1) (boole 1 (cdr g) -2))) out)))
      (T (setq out (cons g out)))))
  (reverse out))

;; 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 "\nCXPLCLOSE loaded. Type CXPLCLOSE to start.")
(princ)

Historial de versiones

Versión 1.0.0 · 27 de octubre de 2026

Primera versión.

Más comandos: Medición y polilíneas