Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 12/11/2022 in all areas

  1. Give this version a try: (defun c:foo (/ _aap a d l lines p p2 ss text x) ;; RJP » 2021-10-06 (defun _aap (ename pt / param) (if (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list ename)))) (setq param (vlax-curve-getparamatpoint ename pt)) ) (angle '(0 0) (vlax-curve-getfirstderiv ename param)) ) ) (if (setq ss (ssget '((0 . "*polyline,Line,*Text")))) (progn (or (setq d (getdist "\nEnter offset distance:<0> ")) (setq d 0)) (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (if (wcmatch (cdr (assoc 0 (entget x))) "*TEXT") (setq text (cons x text)) (setq lines (cons x lines)) ) ) (if lines (foreach x text (setq p (cdr (assoc 10 (entget x)))) (setq l (mapcar '(lambda (x) (list (setq p2 (vlax-curve-getclosestpointto x p)) (distance p p2) (_aap x p2)) ) lines ) ) (setq l (car (vl-sort l '(lambda (a b) (< (cadr a) (cadr b)))))) ;; Check that we have an angle assigned (if (caddr l) (progn (entmod (subst (cons 50 ((lambda (x) (setq a (if (<= (* 0.5 pi) x (* 1.5 pi)) (+ x pi) x ) ) ) (caddr l) ) ) (assoc 50 (entget x)) (entget x) ) ) ) ) ; <--- Modified by Jonathan Handojo ;; RJP added offset (entmod (subst (cons 10 (polar (car l) (+ (/ pi 2) a) d)) (assoc 10 (entget x)) (entget x)) ) ; <--- Line added by Jonathan Handojo ) ) ) ) (princ) )
    1 point
  2. Try this: (defun c:foo (/ a h j l lines mp p p3 p4 pa r s text) ;; Get a list of midpoints and angles ( not for arced segments ) (defun _mpa (e / l l2) (setq l (mapcar 'cdr (vl-remove-if-not '(lambda (x) (vl-position (car x) '(10 11))) (entget e))) ) (setq l2 (append (cdr l) (list (car l)))) (mapcar '(lambda (r j) (list (mapcar '/ (mapcar '+ r j) '(2 2)) (angle r j))) l l2) ) ;; RJP » 2019-08-15 (if (setq s (ssget ":L" '((0 . "Lwpolyline,Line,Text")))) (progn (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))) (if (= "TEXT" (cdr (assoc 0 (entget x)))) (setq text (cons x text)) (setq lines (cons (_mpa x) lines)) ) ) (if (setq lines (apply 'append lines)) (foreach x text (setq p (cdr (assoc 11 (entget x)))) (setq l (car (vl-sort lines '(lambda (a b) (< (distance p (car a)) (distance p (car b)))))) ) (setq h (* 0.75 (cdr (assoc 40 (entget x))))) (setq p3 (polar (setq mp (car l)) (setq pa (+ (/ pi 2) (setq a (cadr l)))) h)) (setq p4 (polar mp (+ pi pa) h)) (if (< (distance p p4) (distance p p3)) (setq p3 p4) ) (entmod (subst (cons 50 (lm:readable a)) (assoc 50 (entget x)) (entget x))) (entmod (subst (cons 10 p3) (assoc 10 (entget x)) (entget x))) (entmod (subst (cons 11 p3) (assoc 11 (entget x)) (entget x))) (grdraw p p3 3) ) ) ) ) (princ) ) (defun lm:readable (a) ((lambda (a) (if (and (< (* pi 0.5) a) (<= a (* pi 1.5))) (lm:readable (+ a pi)) a ) ) (rem (+ a pi pi) (+ pi pi)) ) )
    1 point
×
×
  • Create New...