LISP that Automatically rotates my block perpendicular to a polyline

[pyon09]

I am a CAD Drafter and Land Surveyor and one of my main job is to plot my surveyed poles. However the standard is to have all the poles perpendicular to the road or to a polyline. Is there a lisp to do that?

 

Here is a sample of what I am doing. The top most pole is what It should look like. I have around 1000 poles to rotate perpendicular and is time consuming. Can anyone help me. 
 

 

[fuccaro]

Welcome in the forum, pyon09!

Can you upload a drawing?

[fuccaro]

Well, assuming that by "poles" you mean "texts", try this:

(defun c:pp( / txt points delete)
  (setq precision 300)
  (setq pl (entsel "Select the polyline"))
  (princ "\nselect TEXTs to align")
  (setq txt (ssget '((0 . "TEXT"))))  
  (princ "\nselect the polyline (again)\n")
  (setq elast (entlast))
  (command "divide" pause precision)
  (setq points nil delete nil)
   (repeat (- precision 3)
    (setq elast (entnext elast)
	  delete (cons elast delete)
	  points (cons (cdr (assoc 10 (entget elast))) points))
    )
  (repeat (setq i (sslength txt))
    (setq tx1 (ssname txt (setq i (1- i)))
	  a10 (cdr (assoc 10 (setq el (entget tx1))))
	  dist 1e5
	  closest 0
	  j -1)
    (repeat (length points)
      (setq d1 (distance a10 (nth (setq j (1+ j)) points))
	    dist (if (> dist d1) (setq closest j dist d1) dist))
      )
    (entmod (subst (cons 50 (angle a10 (nth closest points))) (assoc 50 el) el))
    )
  (foreach del1 delete (entdel del1))
  )

It is not mathematical accurate, but I think it does the job. The precision is set to 300 (see the 2nd program line), it can be raised to about 32000, but it will slow down the program.

Waiting to your feed-back!

[Steven P]

A different method,

 

 

Draws a circle around the block a small radius (MyRad) larger than the distance to the closest point on the polyline, which should return 2 points of intersection - these are used to calculate the angle. This method will fail if there is only 1 intersection (for example at the end of the polyline) or more than 2 intersections where it will only use the first 2 it finds. No undo marker added to this and limited testing. It might give an odd angle if the closest point is near to a sharp angle in the polyline, and depending on the block  and its positioning the text could be rotated 180 degrees the wrong way.

 

I am assuming the poles & texts are blocks. Can be altered to suit otherwse

 

 

(defun c:test ( / )
  (defun LM:intersections ( ob1 ob2 mod / lst rtn )                  ;;Function, intersection between 2 points (ref. Lee Mas website)
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
             (vlax-method-applicable-p ob2 'intersectwith)
             (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
        )
        (repeat (/ (length lst) 3)
            (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
                  lst (cdddr lst)
    ))) ; end repeat, and, if
    (reverse rtn)
  )

  (setq ob2 (vlax-ename->vla-object (car (entsel "Select PolyLine"))))  ;;Select the polyline returned as a VLA- object
  (princ "Select Blocks: ")                                             ;;Prompt to select blocks
  (setq MySS (ssget '((0 . "INSERT"))))                                 ;;Selection set, filtered to blocks
  (setq acount 0)                                                       ;;A counter
  (while (< acount (sslength MySS))                                     ;;Loop length of selection set
    (setq MyEnt (ssname MySS acount))                                   ;;Next block in the selection
    (setq MyBasePt (cdr (assoc 10 (entget MyEnt))))                     ;;Get the base point of the block for rotation
    (setq MyRad (+ (distance (vlax-curve-getClosestPointTo ob2 MyBasePt) MyBasePt) 1))        ;; Closest point between base point and polyline
    (setq TempCircle (entmakex (list (cons 0 "CIRCLE") (cons 10 MyBasePt) (cons 40 MyRad))) ) ;; Draw a temporary circle
    (setq ob1 (vlax-ename->vla-object TempCircle))                      ;;VLA- obje name of the circle
    (setq rtn (car (cons (LM:intersections ob1 ob2 acextendnone) rtn))) ;;Intersection point between circle and polyline
    (entdel TempCircle)                                                 ;;Delete circle
    (setq MyAng (+ (angle (car rtn) (cadr rtn)) (/ pi 2) ))             ;;Angle of intersection point in RADs + pi/2 (right angle)
    (entmod (subst (cons 50 MyAng) (assoc 50 (entget MyEnt)) (entget MyEnt)))  ;; Modify the current block
    (setq acount (+ acount 1))                                          ;;increment counter
  ) ; end while                                                         ;; end loop
;;Add in here "Are the texts aligned correctly"... if no repeat and angle (- pi/2)
    (princ)
)

 

Edited March 8 by Steven P

[BIGAL]

My $0.05 use a little search box based on pole insertion point, use ssget "F" pts the points being say a square of points, then it will find the pline. Use getclosestpointto then you can use getparamatpoint and return the angle ie a tangent type of angle which is what you want. 

 

Having spent way to many years with field data can think of a couple of problems.

 

Really need a true sample dwg. 

 

One last question if using CIV3D they may be Cogo points not blocks. The display of a block is controlled by CIV3D.

 

 

[fuccaro]

I should read the title of the thread more carefully!

I wrote the Lisp to align texts -that's how I understood from the image.

Anyway, here is the program slightly adjusted to align Blocks:

(defun c:pp( /  txt points delete )
  (setq precision 300)
  (setq pl (entsel "Select the polyline"))
  (princ "\nselect BLOCKss to align")
  (setq txt (ssget '((0 . "INSERT"))))  
  (princ "\nselect the polyline (again)\n")
  (setq elast (entlast))
  (command "divide" pause precision)
  (setq points nil delete nil)
   (repeat (- precision 3)
    (setq elast (entnext elast)
	  delete (cons elast delete)
	  points (cons (cdr (assoc 10 (entget elast))) points))
    )
  (repeat (setq i (sslength txt))
    (setq tx1 (ssname txt (setq i (1- i)))
	  a10 (cdr (assoc 10 (setq el (entget tx1))))
	  dist 1e5
	  closest 0
	  j -1)
    (repeat (length points)
      (setq d1 (distance a10 (nth (setq j (1+ j)) points))
	    dist (if (> dist d1) (setq closest j dist d1) dist))
      )
    (entmod (subst (cons 50 (+ pi (angle a10 (nth closest points)))) (assoc 50 el) el))
    )
  (foreach del1 delete (entdel del1))
  )

 

[XDSoft]

On 3/8/2024 at 5:30 PM, pyon09 said:

I am a CAD Drafter and Land Surveyor and one of my main job is to plot my surveyed poles. However the standard is to have all the poles perpendicular to the road or to a polyline. Is there a lisp to do that?

 

Here is a sample of what I am doing. The top most pole is what It should look like. I have around 1000 poles to rotate perpendicular and is time consuming. Can anyone help me. 
 

 

 

https://www.theswamp.org/index.php?topic=59433.0