Align attribute to 3Dpolylind - LISP modification

[yu85.info]

Hi,

I have this lisp written kindly by @marko_ribar.

It aligns attribute to 3Dpolyline.

It is grate. But in the DWG file attached the 3D polyline and the blocks where inserted separately so I think there is a small  gap  of 0.000... between the insertion point of the block and the vertex of the 3D polyline so for some reason the lisp does not work.

If someone could help me modify it I will really appreciate the help.

This is the lisp:

(defun c:aliblopols ( / LM:MakeReadable s i pol ss loop n lstpar blo p dir lstpar )

(defun LM:MakeReadable ( a )
;; © Lee Mac 2010
(
(lambda ( a )
(cond
( (and (> a (/ pi 2)) (<= a pi))
(- a pi)
)
( (and (> a pi) (<= a (/ (* 3 pi) 2)))
(+ a pi)
)
( t a )
)
)
(rem a (* 2 pi))
)
)

(prompt "\nSelect polyline entities on which you want to make block alignments readable...")
(setq s (ssget (list (cons 0 "*POLYLINE"))))
(repeat (setq i (sslength s))
(setq pol (ssname s (setq i (1- i))))
(setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 "M1502_P"))))
(if (= (logand 1 (cdr (assoc 70 (entget pol)))) 1)
(setq loop (fix (vlax-curve-getEndParam pol)))
(setq loop (1+ (fix (vlax-curve-getEndParam pol))))
)
(setq n -1)
(repeat loop
(setq lstpar (cons (vlax-curve-getpointatparam pol (setq n (1+ n))) lstpar))
)
(setq n -1)
(repeat (sslength ss)
(setq blo (ssname ss (setq n (1+ n))))
(setq p (cdr (assoc 10 (entget blo))))
(if (member p lstpar)
(progn
(setq dir (LM:MakeReadable (angle (list 0.0 0.0) (vlax-curve-getFirstDeriv pol (vlax-curve-getparamatpoint pol p)))))
(vlax-put (vlax-ename->vla-object blo) (quote rotation) dir)
)
)
)
(setq lstpar nil)
)
(princ)
)
(prompt "\nType ALIBLOPOLS to run the topo point alignment command on a polyline(s)\n")
(princ)

[ronjonp · Accepted solution]

@yu85.info Give this a try, the comparison needed a 'fuzz' value using the function 'EQUAL' to compare the points:

(defun c:aliblopols (/ lm:makereadable blo dir i loop lstpar n p pol s ss)
  (defun lm:makereadable (a)
    ;; © Lee Mac 2010
    ((lambda (a)
       (cond ((and (> a (/ pi 2)) (<= a pi)) (- a pi))
	     ((and (> a pi) (<= a (/ (* 3 pi) 2))) (+ a pi))
	     (t a)
       )
     )
      (rem a (* 2 pi))
    )
  )
  (prompt "\nSelect polyline entities on which you want to make block alignments readable...")
  (setq s (ssget (list (cons 0 "*POLYLINE"))))
  ;; RJP » Check that block definition exists
  (if (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 "M1502_P"))))
    (repeat (setq i (sslength s))
      (setq pol (ssname s (setq i (1- i))))
      (if (= (logand 1 (cdr (assoc 70 (entget pol)))) 1)
	(setq loop (fix (vlax-curve-getendparam pol)))
	(setq loop (1+ (fix (vlax-curve-getendparam pol))))
      )
      (setq n -1)
      (repeat loop (setq lstpar (cons (vlax-curve-getpointatparam pol (setq n (1+ n))) lstpar)))
      (setq n -1)
      (repeat (sslength ss)
	(setq blo (ssname ss (setq n (1+ n))))
	(setq p (cdr (assoc 10 (entget blo))))
	(if ;; RJP » 2025-01-08 Need to use a fuzz value, this is typical for comparing any reals
	    (vl-some '(lambda (x) (and (equal p x 1e-2) (setq p x))) lstpar)
	  ;; (member p lstpar)
	  (progn (setq dir (lm:makereadable
			     (angle (list 0.0 0.0)
				    ;; RJP » Use 'equal' point from polyline list to get param
				    (vlax-curve-getfirstderiv pol (vlax-curve-getparamatpoint pol p))
			     )
			   )
		 )
		 ;; RJP » Cleanup, move block to 'equal' point
		 (vlax-put (vlax-ename->vla-object blo) 'insertionpoint p)
		 (vlax-put (vlax-ename->vla-object blo) (quote rotation) dir)
		 ;; RJP » Remove point from list so it does not get processed twice
		 (setq lstpar (vl-remove p lstpar))
	  )
	)
      )
      (setq lstpar nil)
    )
    (print "Need block definition 'M1502_P' for this to work...")
  )
  (princ)
)
(prompt "\nType ALIBLOPOLS to run the topo point alignment command on a polyline(s)\n")
(princ)

[yu85.info]

Thank you sir for helping me.

It is greate!

[ronjonp]

Glad to help 🙂

[yu85.info]

Sorry to disturb you again @ronjonp but can you think it could be modified to work on every block and not just M1502_P?

Like the DWG2 I attached where there are many blocks

Thanks in advance

[ronjonp · Accepted solution]

---

@yu85.info wrote:

Sorry to disturb you again @ronjonp but can you think it could be modified to work on every block and not just M1502_P?

Like the DWG2 I attached where there are many blocks

Thanks in advance

---

@yu85.info Take this out of the filter to get all blocks: 

(cons 2 "M1502_P")

[yu85.info]

Thank you very much sir!

[ronjonp]

---

@yu85.info wrote:

Thank you very much sir!

---

Glad to help 🙂