Create annotative text by fence

[RBrigido]

Hello Lisp Experts, how are you?

 

I would like some light here.

 

Recently I found a fantastic program that compiles some cool lisps, called "CADTools", in which it creates contour lines, but my topic is not based on that, one thing I found really cool was when creating contour lines, there is an option to put the Annotative Text by Fence, I thought this was really cool and I'm already thinking about doing something with it later, but I believe I don't have enough intelligence to carry out a command like this.

 

Can you give me any ideas on how to create something like this?

 

See the video below showing an example of how the Annotative Text created by Fence is made:

 

 

Many Thanks,

Rodrigo.

 

[Steven P]

I can't quite see what it is doing exactly from the video, however it looks like a ssget function with a selection mode, fence, crossing polygon or window ( https://lee-mac.com/ssget.html ).

 

Do you select the points as you move the mouse over the text rather then using a straight line - sort of wave the mouse around the screen and select it all that way? That could be interesting but complicated - using gread (which the documentation says is an advanced method and rarely needed). Might be worth reading about and can be interesting when you work it out:

gread to get the mouse location, using its position to select entities as it passes over them. On selection 'redraw' to highlight the entity and add to a selection set, to do that on the fly and highlight the entities.

 

You could just use gread to create a polygon fence / crossing polygon, hit enter and then use ssget to select all the text within that area which is a bit simpler.

 

If someone has the time that look like an interesting problem 

 

 

 

So 3 options:

ssget and fence based on the start and end points of the mouse based on clicks

ssget and fence based on the path the mouse takes using gread to capture the points it moves along to create the fence

'on the fly' using gread and points underneath as you go (I'd have to think about the method for that one but sounds most fun (?) 

[BIGAL]

I think its making contour labels this is a copy of the method inside CIV3D. Did something 30 years ago the fence works out the intersection with the contour and gets Z. No idea where to find it. If we go back even further in time a non ACAD civil software just auto labelled the contour RL based on a spacing factor. Way simpler than using fence.

[RBrigido]

That's why I like participating in this forum, people are very generous in their responses.

 

I really thank you 2 @Steven P & @BIGAL for giving me some light. I was able to produce a lisp routine that creates text above the line according to its layer, it was excellent. Here's my lisp routine completed:

 

(defun c:create-contour-labels ()
(setvar "cmdecho" 0)
  (setq p1 (getpoint "\nSpecify first point of fence: "))
  (setq p2 (getpoint p1 "\nSpecify second point of fence: "))

  (setq fence (list p1 p2))
  (setq fence_ss (ssget "_F" fence))

  (if fence_ss
    (progn
      (setq count (sslength fence_ss))
      (setq i 0)

      (while (< i count)
        (setq ent (ssname fence_ss i))
        (setq intersect_point (c:get-intersect-point ent fence))

        (c:create-text intersect_point ent)
        (setq i (1+ i))
      )
    )
    (prompt "\nNo contours found within the fence.")
  )
  (setvar "cmdecho" 1)
  (princ)
)

(defun c:get-intersect-point (ent fence)
  (if (and (entget ent) (cdr (assoc 10 (entget ent))))
    (progn
      (setq ent_pts (cdr (assoc 10 (entget ent))))
      (setq ent_start_pt (car ent_pts))
      (setq ent_end_pt (cadr ent_pts))

      (setq fence_start_pt (car fence))
      (setq fence_end_pt (cadr fence))

      (setq intersect_point (vlax-curve-getClosestPointTo (vlax-ename->vla-object ent) fence_start_pt))
      (if (c:point-on-segment-p intersect_point fence_start_pt fence_end_pt)
        intersect_point
        nil
      )
    )
    nil
  )
)


(defun c:point-on-segment-p (point p1 p2)
  (and
    (<= (min (car p1) (car p2)) (car point) (max (car p1) (car p2)))
    (<= (min (cadr p1) (cadr p2)) (cadr point) (max (cadr p1) (cadr p2)))
  )
)

(defun c:create-text (point ent)
  (if (and point ent)
    (progn
      (setq layer_name (cdr (assoc 8 (entget ent))))
      (setq label_text (c:extract-label-from-layer-name layer_name))
      ; Extract X and Y coordinates from the intersection point
      (setq x (car point))
      (setq y (cadr point))
      ; Debug message
      (princ (strcat "\n\n\nCreating text \"" cleaned_name "\" at point: (" (rtos x) ", " (rtos y) ")"))
      ; Create text
	  (setvar "clayer" "0-25TXT_NCW")
	  (setvar "textstyle" "STANDARD")
      (command "_.text" (list x y) "0.3" "0" cleaned_name)
    )
  )

)




(defun c:extract-label-from-layer-name (layer_name)
  (if layer_name
    (progn
      (setq cleaned_name (vl-string-subst "" "_NCW" layer_name)) ; Remove "_NCW"
      (setq cleaned_name (vl-string-subst " " "_" cleaned_name)) ; Replace "_" with white space when between two letters

      (setq parts (vl-string-split cleaned_name " ")) ; Split cleaned_name using " " as delimiter
      (if (> (length parts) 1) ; Checks if there is more than one element in the list
        (car parts) ; Returns the first element
        (progn
          (princ "\nLayer name:")
          (princ layer_name)
          layer_name ; Returns the layer name itself if there is no "_" delimiter
        )
      )
    )
  )
)






(c:create-contour-labels)

 

A quick question here, I would like to make this text rotate according to the line. I've already tried ideas like:

(defun c:create-text (point ent)
  (if (and point ent)
    (progn
      (setq layer_name (cdr (assoc 8 (entget ent))))
      (setq label_text (c:extract-label-from-layer-name layer_name))
      ; Extract X and Y coordinates from the intersection point
      (setq x (car point))
      (setq y (cadr point))
      ; Getting the start and end point of the line
      (setq line_start (vlax-curve-getStartPoint (vlax-ename->vla-object ent)))
      (setq line_end (vlax-curve-getEndPoint (vlax-ename->vla-object ent)))
		; Calculating the differences in x and y
		(setq dx (- (car line_end) (car line_start)))
		(setq dy (- (cadr line_end) (cadr line_start)))

		; Checking if the line is vertical (dx = 0)
		(if (= dx 0)
			(setq angle_deg (if (< dy 0) 90.0 270.0)) ; Se for, definimos o ângulo como 90 ou 270 graus
			(progn
			  ; Calculating angle in radians and converting to degrees
			  (setq angle_rad (if (< dx 0) (+ (atan (/ dy dx) pi) pi) (atan (/ dy dx))))
			  (setq angle_deg (* angle_rad (/ pi 180.0))) ; Converting angle to degrees
			)
		)

      ; Debug message
      (princ (strcat "\n\n\nCreating text \"" cleaned_name "\" at point: (" (rtos x) ", " (rtos y) ")"))
      ; Create text
	  (setvar "clayer" "0-25TXT_NCW")
	  (setvar "textstyle" "STANDARD")
      (command "_.text" (list x y) "0.3" angle_deg cleaned_name)
    )
  )
)

 

Unfortunately, I still haven't come up with a more conclusive idea of getting this text rotated according to the line. Could you give me another light?

 

Many Thanks,

Rodrigo.

[pyou]

Hopefully this will help to your request regarding Text alignment along the line.  In the last page you will find a lisp code.

 

 

[Tsuky]

You could work with a field
See example below.
And if the polylines simply had an elevation, we could do the same by replacing:

 

">%).Layer>%"

by

">%).Elevation \\f \"%lu2%pr0\">%"

 

(vl-load-com)
(defun c:Label_Side_by_Layer ( / js htx AcDoc Space lg_repeat n obj ename pr pt deriv rtx nw_obj)
  (princ "\nSelect lightweight polylines: ")
  (setq js
    (ssget
      (list
        '(0 . "LWPOLYLINE")
        (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
        (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
      )
    )
  )
  (cond
    (js
      (initget 6)
      (setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpecify the text height <" (rtos (getvar "TEXTSIZE")) ">: ")))
      (if htx (setvar "TEXTSIZE" htx))
      (setq
        AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
        Space
        (if (= 1 (getvar "CVPORT"))
          (vla-get-PaperSpace AcDoc)
          (vla-get-ModelSpace AcDoc)
        )
      )
      (cond
        ((null (tblsearch "LAYER" "Label Elevation"))
          (vlax-put (vla-add (vla-get-layers AcDoc) "Label Elevation") 'color 96)
        )
      )
      (initget 7)
      (setq lg_repeat (getdist (getvar "VIEWCTR") "\nLabel repeat length?: "))
      (repeat (setq n (sslength js))
        (setq
          obj (ssname js (setq n (1- n)))
          ename (vlax-ename->vla-object obj)
          pr (vlax-curve-getStartParam ename)
        )
        (while (and (vlax-curve-getParamAtDist ename lg_repeat) (< (setq pr (+ (vlax-curve-getParamAtDist ename lg_repeat) pr)) (vlax-curve-getEndParam ename)))
          (setq
            pt (vlax-curve-GetpointAtParam ename pr)
            deriv (vlax-curve-getFirstDeriv ename pr)
            rtx (- (atan (cadr deriv) (car deriv)) (angle '(0 0 0) (getvar "UCSXDIR")))
          )
          (if (or (> rtx (* pi 0.5)) (< rtx (- (* pi 0.5)))) (setq rtx (+ rtx pi)))
          (setq nw_obj
            (vla-addMtext Space
              (vlax-3d-point pt)
              0.0
              (strcat
                "{\\fArial|b0|i0|c0|p34;"
                "%<\\AcObjProp Object(%<\\_ObjId "
                (itoa (vla-get-ObjectID (vlax-ename->vla-object obj)))
                ">%).Layer>%"
              )
            )
          )
          (mapcar
            '(lambda (pr val)
              (vlax-put nw_obj pr val)
            )
            (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation 'BackgroundFill)
            (list 5 (getvar "TEXTSIZE") 5 pt "Standard" "Label Elevation" rtx -1)
          )
        )
      )
    )
  )
  (prin1)
)

 

 

[BIGAL]

For poly lines you can get angle at a point on a pline. Note Vl object.

 

(defun alg-ang (obj pnt)
  (angle '(0. 0. 0.)
     (vlax-curve-getfirstderiv
       obj
       (vlax-curve-getparamatpoint
         obj
         pnt
       )
     )
  )
)

 

 

[RBrigido]

On 05/05/2024 at 01:24, BIGAL said:

For poly lines you can get angle at a point on a pline. Note Vl object.

 

(defun alg-ang (obj pnt)
  (angle '(0. 0. 0.)
     (vlax-curve-getfirstderiv
       obj
       (vlax-curve-getparamatpoint
         obj
         pnt
       )
     )
  )
)

 

 

 

I appreciate your comment @BIGAL. You made me have a clearer vision of Lisp and managed to complete it successfully. I share the final code below so that everyone can use it in the future:

 

(prompt"\n \n \n      Loading Label Lines.lsp file.")
(prompt"\n      (c) Rodrigo Brigido 2024...")
(prompt"\n      Create labels on lines....")

;Name        : Label Lines.lsp
;Command     : Label Lines
;Output      : ---
;By          : Rodrigo Brigido
;Created     : 
;Modified    : ---
;Description : Create labels on lines


(defun c:lab ()
(c:labelline)
)

(defun c:labelline ()
(setvar "cmdecho" 0)
(setq oldorthomode (getvar "orthomode"))
(setvar "orthomode" 0)
(setq oldosmode (getvar "osmode"))
(setvar "osmode" 512)

  (setq p1 (getpoint "\nSpecify first point of fence: "))
  (setq p2 (getpoint p1 "\nSpecify second point of fence: "))

  (setq fence (list p1 p2))
  (setq fence_ss (ssget "_f" fence '((0 . "*Lwpolyline,3dpoly,polyline,Line"))))

  (if fence_ss
    (progn
      (setq count (sslength fence_ss))
      (setq i 0)

      (while (< i count)
        (setq ent (ssname fence_ss i))
        (setq intersect_point (c:get-intersect-point ent fence))

        (c:create-text intersect_point ent)
        (setq i (1+ i))
      )
    )
    (prompt "\nNo contours found within the fence.")
  )
  

 
  (setvar "orthomode" oldorthomode)
  (setvar "osmode" oldosmode)
    (setvar "cmdecho" 1)
  (princ)
)

(defun c:get-intersect-point (ent fence)
  (if (and (entget ent) (cdr (assoc 10 (entget ent))))
    (progn
      ; Getting the entity endpoints
      (setq ent_pts (cdr (assoc 10 (entget ent))))
      (setq ent_start_pt (car ent_pts))
      (setq ent_end_pt (cadr ent_pts))

      ; Getting the fence endpoints
      (setq fence_start_pt (car fence))
      (setq fence_end_pt (cadr fence))

      ; Calculating the intersection point
      (setq intersect_point (vlax-curve-getClosestPointTo (vlax-ename->vla-object ent) fence_start_pt))
    )
    (progn
      ; Debug message if entity is not found or points are not defined
      (princ "\nEntidade não encontrada ou pontos não definidos.")
      nil
    )
  )
)

(defun c:point-on-segment-p (point p1 p2)
  (let ((x (car point))
        (y (cadr point))
        (x1 (car p1))
        (y1 (cadr p1))
        (x2 (car p2))
        (y2 (cadr p2)))
    (if (<= (min x1 x2) x (max x1 x2))
      (if (<= (min y1 y2) y (max y1 y2))
        t
        nil)
      nil)
    )
  )


(defun c:create-text (point ent)
  (if (and point ent)
    (progn
      (setq layer_name (cdr (assoc 8 (entget ent))))
      (c:extract-label-from-layer-name layer_name)
      
	  ; Extract X and Y coordinates from the intersection point
      (setq x (car point))
      (setq y (cadr point))
      
      ; Calculate rotation angle
      (setq anglea (angle '(0. 0. 0.) (vlax-curve-getfirstderiv ent (vlax-curve-getparamatpoint ent point))))

      ; Debug message
      (princ (strcat "\n\nCreating text \"" cleaned_name "\" at point: (" (rtos x) ", " (rtos y) ") with rotation angle: " (rtos anglea)))
      
      ; Create text
      (setq text_data (list (cons 0 "TEXT") (cons 8 "0-25TXT_NCW") (cons 10 (list x y 0)) (cons 40 0.3) (cons 41 0.6) (cons 1 cleaned_name) (cons 50 anglea))) ; Adding rotation angle
      (entmake text_data)
    )
  )

(princ)

)







(defun c:extract-label-from-layer-name (layer_name)
  (if layer_name
    (progn
      (setq cleaned_name (vl-string-subst "" "_NCW" layer_name)) ; Remove "_NCW"
      (setq cleaned_name (vl-string-subst " " "_" cleaned_name)) ; Replace "_" with white space when between two letters

      (setq parts (vl-string-split cleaned_name " ")) ; Split cleaned_name using " " as delimiter
      (if (> (length parts) 1) ; Checks if there is more than one element in the list
        (car parts) ; Returns the first element
      )
    )
  )
)
        
        
        
;##### Credits to @Bigal ######

 

Edited Monday at 01:50 PM by RBrigido