Handle Nested Curves in Blocks

hamza_itani
Contributor
Contributor

Handle Nested Curves in Blocks

hamza_itani
Contributor
Contributor

The below LISP aligns (rotates) entities (blocks, text, MText) to various curves. Currently it successfully selects and aligns entities to standard curves like lines, polylines, arcs, circles, ellipses, and splines.

However, I need it to also properly handle curves that are nested within blocks. Since it does allow block selection, but the result is not always correct (especially if the nested object is not a straight line, or if the block is rotated at angle other than 0 degrees).

Specifically, I want the script to:

1- Detect when a user selects a curve that is part of a block.
2- Temporarily copy the nested object below the cursor.
3- Use the copied object if it’s a supported curve (line, polyline, arc, circle, ellipse, spline) to calculate the rotation.
4- Align subsequent text, MText, or block selections based on this rotation.

 

 

 

;; Auto Align Multiple Entities (Blocks, Text, MText) to various curves
(defun C:RTC (/ picksize bss bname ins bdata pt param enx idx entityType pl o c a valid initial-angle adjusted-angle last-angle)
  (vl-load-com)
  (setq picksize (* (getvar 'viewsize) (/ (getvar 'pickbox) (car (getvar 'screensize)))))

  (setq valid nil)

  ;; Loop until a valid curve is picked
  (while (not valid)
    (setq pl (nentselp "\nPick a point on any curve (line, polyline, arc, circle, ellipse, spline): "))
    (if (and pl (wcmatch (cdr (assoc 0 (entget (car pl)))) "*LINE,*POLYLINE,*ARC,*CIRCLE,*ELLIPSE,*SPLINE"))
      (setq valid t)  ; Set valid flag to true as a valid curve is selected
      (princ "\nInvalid curve. Try again.")
    )
  )

  ;; If a valid curve is selected, then proceed to select the blocks, text, and MText
  (if valid
    (if (setq bss (ssget "_:L" '((0 . "INSERT,MTEXT,TEXT"))))
      (progn
        (setq o (car pl)
              c (vlax-curve-getclosestpointto o (cadr pl))  ; Closest point on curve
              param (vlax-curve-getparamatpoint o c)  ; Parametric point on curve
        )
        ;; Loop through each selected entity
        (setq idx 0 last-angle 0)
        (repeat (sslength bss)
          (setq enx (ssname bss idx)
                bdata (entget enx)  ; Get entity data
                ins (cdr (assoc 10 bdata))  ; Get insertion point of the entity
                bname (cdr (assoc 2 bdata))  ; Get entity name
                entityType (cdr (assoc 0 bdata))  ; Get entity type
          )
          ;; Modify the entity to align rotation if it is a block or text
          (if (or (= entityType "INSERT") (= entityType "TEXT") (= entityType "MTEXT"))
            (progn
              (setq initial-angle (angle '(0 0 0) (vlax-curve-getFirstDeriv o param)))
              ;; Check if the angle is between 90 and 270 degrees
              (setq adjusted-angle
                    (if (and (> initial-angle (/ pi 2)) (< initial-angle (* 3 (/ pi 2))))
                        (+ initial-angle pi)
                      initial-angle
                    )
              )
              (setq last-angle (* (/ 180 pi) adjusted-angle))  ; Store last angle for reporting
              (entmod
                (subst
                  (cons 50 adjusted-angle)
                  (assoc 50 bdata)
                  bdata
                )
              )
            )
          )
          (setq idx (+ idx 1))
        )  ; repeat
        (princ (strcat "\nEntities aligned to curve @ " (rtos last-angle 2 2) "°."))
      )  ; progn if bss
    )  ; if entities selected
  )  ; if valid curve
  
  (princ)
)

 

Edit: Added Drawing + ScreenshotScreenshot 2024-04-25 093943.jpg

0 Likes
Reply
Accepted solutions (1)
460 Views
6 Replies
Replies (6)

Sea-Haven
Mentor
Mentor

Post sample dwg with before and after.

0 Likes

hamza_itani
Contributor
Contributor

Added drawing and screenshot to the main post.

0 Likes

Sea-Haven
Mentor
Mentor

I think the problem may be linked to the "block Rotation angle: 19.2765" having problems still. Need to start say with an arc then progress onto a spline not rotated, then a rotated one to work out what is going on. 

 

Testing on a rotated ellipse works fine so something in the way that spline exists in that block it may be at some other angle than 0.0 in block.

 

Why have it as a block why not just a spline ?

 

Ok after going around in circles for 20 minutes just explode the spline block so it becomes a spline !

 

angle 340.08 red 340.08 Green pick point is critical.

 

CADaSchtroumpf
Advisor
Advisor
Accepted solution

Maybe by making transformation matrices like this?

;; Auto Align Multiple Entities (Blocks, Text, MText) to various curves
(defun transpts (apt matrix / )
  (list
    (+
      (* (car (nth 0 matrix)) (car apt))
      (* (car (nth 1 matrix)) (cadr apt))
      (* (car (nth 2 matrix)) (caddr apt))
      (cadddr (nth 0 matrix))
    )
    (+
      (* (cadr (nth 0 matrix)) (car apt))
      (* (cadr (nth 1 matrix)) (cadr apt))
      (* (cadr (nth 2 matrix)) (caddr apt))
      (cadddr (nth 1 matrix))
    )
    (+
      (* (caddr (nth 0 matrix)) (car apt))
      (* (caddr (nth 1 matrix)) (cadr apt))
      (* (caddr (nth 2 matrix)) (caddr apt))
      (cadddr (nth 2 matrix))
    )
  )
)
(defun v_matr (dpt alphax alphay alphaz echx echy echz / )
  (list
    (list
      (* echx (cos alphaz) (cos alphay))
      (- (sin alphaz))
      (sin alphay)
      (car dpt)
    )
    (list
      (sin alphaz)
      (* echy (cos alphaz) (cos alphax))
      (- (sin alphax))
      (cadr dpt)
    )
    (list
      (- (sin alphay))
      (sin alphax)
      (* echz (cos alphax) (cos alphay))
      (caddr dpt)
    )
    (list 0.0 0.0 0.0 1.0)
  )
)
(defun C:RTC (/ picksize bss bname ins bdata pt param enx idx entityType pl o c a valid initial-angle adjusted-angle last-angle blk dep ori tmp deriv rtx)
  (vl-load-com)
  (setq picksize (* (getvar 'viewsize) (/ (getvar 'pickbox) (car (getvar 'screensize)))))

  (setq valid nil)

  ;; Loop until a valid curve is picked
  (while (not valid)
    (setq pl (nentselp "\nPick a point on any curve (line, polyline, arc, circle, ellipse, spline): "))
    (if (and pl (wcmatch (cdr (assoc 0 (entget (car pl)))) "*LINE,*POLYLINE,*ARC,*CIRCLE,*ELLIPSE,*SPLINE"))
      (setq valid t)  ; Set valid flag to true as a valid curve is selected
      (princ "\nInvalid curve. Try again.")
    )
  )

  ;; If a valid curve is selected, then proceed to select the blocks, text, and MText
  (if valid
    (if (setq bss (ssget "_:L" '((0 . "INSERT,MTEXT,TEXT"))))
      (progn
        (setq o (car pl))
        ;; Loop through each selected entity
        (setq idx 0 last-angle 0)
        (repeat (sslength bss)
          (setq enx (ssname bss idx)
                bdata (entget enx)  ; Get entity data
                ins (cdr (assoc 10 bdata))  ; Get insertion point of the entity
                bname (cdr (assoc 2 bdata))  ; Get entity name
                entityType (cdr (assoc 0 bdata))  ; Get entity type
          )
          ;; Modify the entity to align rotation if it is a block or text
          (if (or (= entityType "INSERT") (= entityType "TEXT") (= entityType "MTEXT"))
            (progn
              (if (eq (type (car (last pl))) 'ENAME)
                (setq
                  blk (entget (car (last pl)))
                  dep (cdr (assoc 10 blk))
                  ori (cdr (assoc 50 blk))
                  tmp (transpts (cadr pl) (v_matr (mapcar '- dep) 0.0 0.0 0.0 1.0 1.0 1.0))
                  c (vlax-curve-getclosestpointto o (transpts tmp (v_matr '(0.0 0.0 0.0) 0.0 0.0 ori 1.0 1.0 1.0)))
                  param (vlax-curve-getparamatpoint o c)
                  deriv (vlax-curve-getFirstDeriv o param)
                  rtx (- (atan (cadr deriv) (car deriv)) (angle '(0 0 0) (getvar "UCSXDIR")))
                  initial-angle (+ rtx ori)
                )
                (setq
                  c (vlax-curve-getclosestpointto o (cadr pl))  ; Closest point on curve
                  param (vlax-curve-getparamatpoint o c)  ; Parametric point on curve
                  initial-angle (angle '(0 0 0) (vlax-curve-getFirstDeriv o param))
                )
              )
              ;; Check if the angle is between 90 and 270 degrees
              (setq adjusted-angle
                    (if (and (> initial-angle (/ pi 2)) (< initial-angle (* 3 (/ pi 2))))
                        (+ initial-angle pi)
                      initial-angle
                    )
              )
              (setq last-angle (* (/ 180 pi) adjusted-angle))  ; Store last angle for reporting
              (entmod
                (subst
                  (cons 50 adjusted-angle)
                  (assoc 50 bdata)
                  bdata
                )
              )
            )
          )
          (setq idx (+ idx 1))
        )  ; repeat
        (princ (strcat "\nEntities aligned to curve @ " (rtos last-angle 2 2) "°."))
      )  ; progn if bss
    )  ; if entities selected
  )  ; if valid curve
  
  (princ)
)

hamza_itani
Contributor
Contributor

@Sea-Haven I don't know what the problem might be, but you are right, if I just explode it it works.

 

@CADaSchtroumpf Thanks a lot, your solution works on blocks.

 

Thank you both for your time!

 

0 Likes

Sea-Haven
Mentor
Mentor

Glad it worked, it looked to me like you have copied and pasted the spline from another dwg with the result as a block and not a spline.

0 Likes