Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 04/09/2023 in all areas

  1. Not tested... (defun c:cross+cut-lins ( / process ss gap i e lay laylst slay sss ch sscross sscut ) (defun process ( sscross sscut gap / p1e p2e p1c p2c ip p1 p2 ) (foreach e (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex sscross))) (foreach c (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex sscut))) (setq p1e (cdr (assoc 10 (entget e))) p2e (cdr (assoc 11 (entget e)))) (setq p1c (cdr (assoc 10 (entget c))) p2c (cdr (assoc 11 (entget c)))) (if (and (setq ip (inters p1e p2e p1c p2c)) (not (or (equal p1e ip 1e-3) (equal p2e ip 1e-3) ) ) ) (progn (setq p1 (polar ip (angle ip p1e) (/ gap 2.0))) (setq p2 (polar ip (angle ip p2e) (/ gap 2.0))) (if command-s (command-s "_.BREAK" e "_non" p1 "_non" p2) (vl-cmdf "_.BREAK" e "_non" p1 "_non" p2) ) ) ) ) ) ) (if (and (setq ss (ssget "_:L" (list (cons 0 "LINE")))) (not (initget 5)) (setq gap (getdist "\nPick or specify gap : ")) ) (progn (repeat (setq i (sslength ss)) (setq e (ssname ss (setq i (1- i)))) (setq lay (cdr (assoc 8 (entget e)))) (if (not (vl-position lay laylst)) (setq laylst (cons lay laylst)) ) ) (foreach lay laylst (sssetfirst nil ss) (setq slay (ssget "_I" (list (cons 8 lay)))) (setq sss (cons slay sss)) ) (if (= 2 (length sss)) (progn (sssetfirst nil (car sss)) (initget "Yes No") (setq ch (cond ( (getkword "\nAre highlighted lines crossings or cutting lines [Yes / No] <Yes> : ") ) ( "Yes" ))) (sssetfirst) (if (= ch "Yes") (progn (setq sscross (car sss)) (setq sscut (cadr sss)) (process sscross sscut gap) ) (progn (setq sscut (car sss)) (setq sscross (cadr sss)) (process sscross sscut gap) ) ) ) ) ) ) (princ) ) HTH. M.R.
    1 point
  2. Try Label 3dpolys By Alan H April 2023 (defun c:wow ( / obj co-ords pt lst2 lwpoly) (defun LWPoly (plst lay col cls) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 8 lay) (cons 62 col) (cons 90 (length plst)) (cons 70 cls)) (mapcar (function (lambda (p) (cons 10 p))) plst) ) ) ) (Prompt "select 3d polylines ") (setq ss (ssget '((0 . "POLYLINE")))) (if ss (repeat (setq k (sslength ss)) (setq obj (vlax-ename->vla-object (ssname ss (setq k (1- k))))) (setq co-ords (vlax-get obj 'coordinates)) (setq co-ordsxy '()) (setq I 0) (repeat (/ (length co-ords) 3) (setq xy (list (nth i co-ords)(nth (+ I 1) co-ords)(nth (+ I 2) co-ords) )) (setq co-ordsxy (cons xy co-ordsxy)) (setq I (+ I 3)) ) (setq lst2 '()) (foreach pt co-ordsxy (setq pt (list (car pt)(cadr pt) (caddr pt))) (command "text" "C" pt 1.5 0.0 (rtos (caddr pt) 2 2)) (command "-insert" "Donut" "s" 1 (list (car pt)(cadr pt)) 0.0) (setq lst2 (cons (list (car pt)(cadr pt)) lst2)) ) (LWPoly lst2 (vla-get-layer obj) (vla-get-color obj) 0) (vla-delete obj) ) (alert "No 3dpoly's chosen ") ) (princ) ) (c:wow) this.
    1 point
×
×
  • Create New...