Jump to content

Merge two lisp codes into one so it functions?


AbrAutoCADabra

Recommended Posts

Hello people,

 

I have written two codes, one for slope and the other for an arrow that is supposed to be drawn under the slope text. An example to simplify things: I have two elevation texts for example, h1= 2.44 and h2=2.55, i draw a line between these two elevation points and the code for slope calculates the slope and creates a mtext with the same rotation angle as the line and lets you can select insertion point for. The second code "arrow" draws an arrow with a fixed length etc. and allows you to choose where to put the arrow head.

My goal is to merge these two codes into one and be able to these steps as follows:

1. Slope Calculation:

  • The user is prompted to select two elevation text entities. These text entities typically represent heights or elevations.
  • The program retrieves the numerical values from these text entities, converting them to floating-point numbers. It takes into account that the numbers might be formatted with a comma as a decimal separator.
  • Next, the user is prompted to select a line entity that represents a distance or a slope direction.
  • The program calculates the slope percentage between the two elevation points using the formula: slope = (elevation2 - elevation1) / distance * 100.
  • The slope value is rounded to one decimal place using the LM:roundm function.

2. Text Insertion:

  • Prompt to pick an insertion point for the slope text.
  • Create a new single-line text entity at the specified insertion point.
  • Text displays the calculated slope percentage and is rotated to align with the direction of the selected line.

3. Arrow Placement:

  • Place the arrow under the slope % text with a vertical distance of 0.2.
  • Point the arrow head towards the lower elevation point to determine slope direction.

 

Credits for the arrow code goes to LeeMac, I have just improvised the code to function in a different manner but he is the one who created it.

 

SLOPE Code:

(defun c:Slopetext (/ h1 h2 line d slp slope_text insert_point slope_text_entity angle)
  ;; Get the first elevation value from user-selected text
  (setq h1 (car (entsel "\nSelect first elevation text > ")))

  (if (not (null h1))
    (progn
      (setq h1 (cdr (assoc 1 (entget h1))))
      (if (vl-string-search "," h1)
        (setq h1 (atof (vl-string-subst "." "," h1)))
        (setq h1 (atof h1))
      ))
    (setq h1 nil)
  )

  ;; Check if the first elevation value was successfully retrieved
  (if (null h1)
    (princ "\nInvalid selection for the first elevation text.")
    (progn
      ;; Get the second elevation value from user-selected text
      (setq h2 (car (entsel "\nSelect second elevation text > ")))

      (if (not (null h2))
        (progn
          (setq h2 (cdr (assoc 1 (entget h2))))
          (if (vl-string-search "," h2)
            (setq h2 (atof (vl-string-subst "." "," h2)))
            (setq h2 (atof h2))
          ))
        (setq h2 nil)
      )

      ;; Check if the second elevation value was successfully retrieved
      (if (null h2)
        (princ "\nInvalid selection for the second elevation text.")
        (progn
          ;; Get the line for calculating the distance
          (setq line (car (entsel "\nSelect a line to represent the distance > ")))

          (if (and line (eq (cdr (assoc 0 (entget line))) "LINE"))
            (progn
              ;; Calculate the distance between the endpoints of the line
              (setq d (distance (cdr (assoc 10 (entget line))) (cdr (assoc 11 (entget line)))))

              ;; Calculate the slope percentage
              (if (= d 0)
                (setq slp "The slope is undefined.")
                (setq slp (LM:roundm (* (/ (- h2 h1) d) 100) 0.1)) ; Use LM:roundm to round the slope value to one decimal place
              )

              ;; Get a point for inserting the slope text
              (setq insert_point (getpoint "\nPick a point for the slope text insertion: "))

              ;; Calculate the direction vector of the line
              (setq line-start (cdr (assoc 10 (entget line))))
              (setq line-end (cdr (assoc 11 (entget line))))
              (setq line-direction (mapcar '- line-end line-start))

              ;; Calculate the angle from the direction vector
              (setq angle (atan (cadr line-direction) (car line-direction)))

              ;; Adjust the angle by 180 degrees
              (setq angle (+ angle pi))

              ;; Create the slope text entity with a height of 0.4 and rotation angle
              (setq slope_text_entity (entmake
                (list
                  '(0 . "TEXT")
                  '(8 . "0") ; Layer 0
                  (cons 10 insert_point)
                  (cons 1 (strcat (rtos slp 2 1) "%")) ; Display the slope value rounded to one decimal place
                  (cons 40 0.4) ; Text height
                  (cons 50 angle) ; Text rotation angle
                )
              ))

              ;; Display the calculated results in the command bar
              (princ (strcat "\n" (rtos slp 2 1) "%"))

            )
            (princ "\nInvalid input. Select a valid distance line.")
          )
        )
      )
    )
  )
)

 

ARROW Code:

(defun c:arrow ( / di en gr l1 l2 nm p1 p2 )
   (if
       (and
           (setq p1 (getpoint "\n1st Point: "))
           (setq p2 (polar p1 0.0 1.0)) ; Set the length of the arrow to 1 unit and make it horizontal
       )
       (progn
           (setq di (/ (distance p1 p2) 3.0)
                 nm (trans '(0. 0. 1.) 1 0 t)
           )
           (setq en
               (entget
                   (entmakex
                       (append
                           (list
                              '(0 . "LWPOLYLINE")
                              '(100 . "AcDbEntity")
                              '(100 . "AcDbPolyline")
                              '(90 . 3)
                              '(70 . 0)
                           )
                           (setq l1
                               (list
                                   (cons 10 (trans p1 1 nm))
                                   (cons 10 (trans (polar p2 (angle p2 p1) di) 1 nm))
                                   (cons 40 (/ di 2.0))
                                  '(41 . 0.0)
                                   (cons 10 (trans p2 1 nm))
                                   (cons 210 nm)
                               )
                           )
                       )
                   )
               )
           )
           (setq l2
               (list
                   (cons 10 (trans p1 1 nm))
                  '(40 . 0.0)
                   (cons 41 (/ di 2.0))
                   (cons 10 (trans (polar p1 (angle p1 p2) di) 1 nm))
                   (cons 10 (trans p2 1 nm))
                   (cons 210 nm)
               )
           )
           (setq en (reverse (member (assoc 39 en) (reverse en))))
           (princ "\nChoose Arrow End...")
           (while (= 5 (car (setq gr (grread t 13 0))))
               (entmod
                   (append en
                       (if (< (distance (cadr gr) p2) (distance (cadr gr) p1)) l1 l2)
                   )
               )
           )
       )                    
   )
   (princ)
)

 

Link to comment
Share on other sites

Here is the updated code. Now I am getting ; error: bad function: 5.95856.

(defun LM:roundm (n m)
  (* m (fix ((if (minusp n) - +) (/ n (float m)) 0.5)))
)

(defun c:Slopetextarrow1 (/ h1 h2 line d slp slope_text insert_point slope_text_entity angle arrow_tail arrowhead arrowhead_position arrowhead_on_right)
  ;; Get the first elevation value from user-selected text
  (setq h1 (car (entsel "\nSelect first elevation text > ")))

  (if (not (null h1))
    (progn
      (setq h1 (cdr (assoc 1 (entget h1))))
      (if (vl-string-search "," h1)
        (setq h1 (atof (vl-string-subst "." "," h1)))
        (setq h1 (atof h1))
      ))
    (setq h1 nil)
  )

  ;; Check if the first elevation value was successfully retrieved
  (if (null h1)
    (princ "\nInvalid selection for the first elevation text.")
    (progn
      ;; Get the second elevation value from user-selected text
      (setq h2 (car (entsel "\nSelect second elevation text > ")))

      (if (not (null h2))
        (progn
          (setq h2 (cdr (assoc 1 (entget h2))))
          (if (vl-string-search "," h2)
            (setq h2 (atof (vl-string-subst "." "," h2)))
            (setq h2 (atof h2))
          ))
        (setq h2 nil)
      )

      ;; Check if the second elevation value was successfully retrieved
      (if (null h2)
        (princ "\nInvalid selection for the second elevation text.")
        (progn
          ;; Get the line for calculating the distance
          (setq line (car (entsel "\nSelect a line to represent the distance > ")))

          (if (and line (eq (cdr (assoc 0 (entget line))) "LINE"))
            (progn
              ;; Calculate the distance between the endpoints of the line
              (setq d (distance (cdr (assoc 10 (entget line))) (cdr (assoc 11 (entget line)))))

              ;; Calculate the slope percentage
              (if (= d 0)
                (setq slp "The slope is undefined.")
                (setq slp (LM:roundm (* (/ (- h2 h1) d) 100) 0.1)) ; Use LM:roundm to round the slope value to one decimal place
              )

              ;; Get a point for inserting the slope text
              (setq insert_point (getpoint "\nPick a point for the slope text insertion: "))

              ;; Calculate the direction vector of the line
              (setq line-start (cdr (assoc 10 (entget line))))
              (setq line-end (cdr (assoc 11 (entget line))))
              (setq line-direction (mapcar '- line-end line-start))

              ;; Calculate the angle from the direction vector
              (setq angle (atan (cadr line-direction) (car line-direction)))

              ;; Adjust the angle by 180 degrees
              (setq angle (+ angle pi))

              ;; Create the slope text entity with a height of 0.4 and rotation angle
              (setq slope_text_entity (entmake
                (list
                  '(0 . "TEXT")
                  '(8 . "0") ; Layer 0
                  (cons 10 insert_point)
                  (cons 1 (strcat (rtos slp 2 1) "%")) ; Display the slope value rounded to one decimal place
                  (cons 40 0.4) ; Text height
                  (cons 50 angle) ; Text rotation angle
                )
              ))

              ;; Calculate the position for the arrow tail (below the text)
              (setq arrow_tail_position (list (car insert_point) (- (cadr insert_point) 0.2)))

              ;; Calculate the arrow tail endpoint based on the same angle as the distance line with a length of 1.0
              (setq arrow_tail_end (polar arrow_tail_position angle 1.0))

              ;; Create a fraction of the distance between arrow_tail_position and arrow_tail_end
              (setq di (/ (distance arrow_tail_position arrow_tail_end) 3.0))

              ;; Create a transformation matrix for Z-axis translation
              (setq nm (trans '(0. 0. 1.) 1 0 t))

              ;; Define properties for the arrowhead's first line segment
              (setq l1
                (list
                  (cons 10 (trans arrow_tail_position 1 nm))                      ; Starting point for the arrowhead
                  (cons 10 (trans (polar arrow_tail_end (angle arrow_tail_end arrow_tail_position) di) 1 nm)) ; Ending point for the arrowhead
                  (cons 40 (/ di 2.0))                           ; Line width
                  '(41 . 0.0)                                    ; Bulge factor (straight line)
                  (cons 10 (trans arrow_tail_end 1 nm))                      ; Endpoint of the arrow's shaft
                  (cons 210 nm)                                  ; 3D transformation data
                )
              )

              ;; Define properties for the arrowhead's second line segment
              (setq l2
                (list
                  (cons 10 (trans arrow_tail_position 1 nm))                      ; Starting point for the arrowhead
                  '(40 . 0.0)                                    ; Line width (0.0)
                  (cons 41 (/ di 2.0))                           ; Bulge factor (half of shaft length)
                  (cons 10 (trans (polar arrow_tail_position (angle arrow_tail_position arrow_tail_end) di) 1 nm)) ; Endpoint for the arrowhead
                  (cons 10 (trans arrow_tail_end 1 nm))                      ; Endpoint of the arrow's shaft
                  (cons 210 nm)                                  ; 3D transformation data
                )
              )

              ;; Reverse the entity property order to ensure proper rendering
              (setq en (reverse (member (assoc 39 en) (reverse en))))

              ;; Print a message to prompt the user to choose the arrow end
              (princ "\nChoose Arrow End...")

              ;; Start a loop that reads user input in a graphics window
              (while (= 5 (car (setq gr (grread t 13 0))))
                  ;; Modify the arrow entity based on user input
                  (entmod
                      (append en
                          ;; Choose either l1 or l2 based on user input
                          (if (< (distance (cadr gr) arrow_tail_end) (distance (cadr gr) arrow_tail_position)) l1 l2)
                      )
                  )
              )

              ;; Exit the command
              (princ)

              ;; Display the calculated results in the command bar
              (princ (strcat "\n" (rtos slp 2 1) "%"))

            )
          )
        )
      )
    )
  )
)
Link to comment
Share on other sites

So bad function 5.9856 sounds like you have got a bracket in the wrong place, the LISP is reading a variable as a command.


For example:

 

(setq ANumber 1.23456)
(ANumber)

 

will produce the same error message -seeing ANumber as a command and not a variable

Link to comment
Share on other sites

11 hours ago, AbrAutoCADabra said:

Here is the updated code. Now I am getting ; error: bad function: 5.95856.

 

You can't have a variable share a named with a function. switch the angle variable to ang or something else. didn't really look at the rest of the code.

would also suggest to shorten the some of the variable naming down.

Edited by mhupp
  • Like 1
Link to comment
Share on other sites

39 minutes ago, mhupp said:

 

You can't have a variable share a named with a function. switch the angle variable to ang or something else. didn't really look at the rest of the code.

would also suggest to shorten the some of the variable naming down.

Hello, also I am kind of new to this so I try to be clear about what I do. Managed to edit most of it but now I am getting syntax error when I try to upload it in autolisp.... Here is the updated code:

(defun LM:roundm (n m)
  (* m (fix ((if (minusp n) - +) (/ n (float m)) 0.5)))
)

(defun c:Slopetextarrow (/ h1 h2 line d slp slope_text insert_point slope_text_entity rotation-angle p1 p2 di nm en l1 l2)
  ;; Get the first elevation value from user-selected text
  (setq h1 (car (entsel "\nSelect first elevation text > ")))

  (if (not (null h1))
    (progn
      (setq h1 (cdr (assoc 1 (entget h1)))) ; Extract the elevation value
      (if (vl-string-search "," h1) ; Check if it uses a comma as a decimal separator
        (setq h1 (atof (vl-string-subst "." "," h1))) ; Convert comma to dot for number parsing
        (setq h1 (atof h1)) ; Parse the elevation as a floating-point number
      ))
    (setq h1 nil) ; Set to nil if no valid elevation is selected
  )

  ;; Check if the first elevation value was successfully retrieved
  (if (null h1)
    (princ "\nInvalid selection for the first elevation text.")
    (progn
      ;; Get the second elevation value from user-selected text
      (setq h2 (car (entsel "\nSelect second elevation text > ")))

      (if (not (null h2))
        (progn
          (setq h2 (cdr (assoc 1 (entget h2)))) ; Extract the elevation value
          (if (vl-string-search "," h2) ; Check if it uses a comma as a decimal separator
            (setq h2 (atof (vl-string-subst "." "," h2))) ; Convert comma to dot for number parsing
            (setq h2 (atof h2)) ; Parse the elevation as a floating-point number
          ))
        (setq h2 nil) ; Set to nil if no valid elevation is selected
      )

      ;; Check if the second elevation value was successfully retrieved
      (if (null h2)
        (princ "\nInvalid selection for the second elevation text.")
        (progn
          ;; Get the line for calculating the distance
          (setq line (car (entsel "\nSelect a line to represent the distance > ")))

          (if (and line (eq (cdr (assoc 0 (entget line))) "LINE")) ; Check if a valid line is selected
            (progn
              ;; Calculate the distance between the endpoints of the line
              (setq d (distance (cdr (assoc 10 (entget line))) (cdr (assoc 11 (entget line)))))

              ;; Calculate the slope percentage
              (if (= d 0)
                (setq slp "The slope is undefined.") ; Handle the case of a vertical line
                (setq slp (LM:roundm (* (/ (- h2 h1) d) 100) 0.1)) ; Calculate and round the slope percentage
              )

              ;; Get a point for inserting the slope text
              (setq insert_point (getpoint "\nPick a point for the slope text insertion: "))

              ;; Calculate the direction vector of the line
              (setq line-start (cdr (assoc 10 (entget line))))
              (setq line-end (cdr (assoc 11 (entget line))))
              (setq line-direction (mapcar '- line-end line-start))

              ;; Calculate the rotation angle from the direction vector
              (setq rotation-angle (atan (cadr line-direction) (car line-direction)))

              ;; Adjust the angle by 180 degrees to align the text with the line
              (setq rotation-angle (+ rotation-angle pi))

              ;; Create the slope text entity with a height of 0.4 and the calculated rotation angle
              (setq slope_text_entity (entmake
                (list
                  '(0 . "TEXT")
                  '(8 . "0") ; Layer 0
                  (cons 10 insert_point) ; Insertion point
                  (cons 1 (strcat (rtos slp 2 1) "%")) ; Display the slope value rounded to one decimal place
                  (cons 40 0.4) ; Text height
                  (cons 50 rotation-angle) ; Text rotation angle
                )
              ))

              ;; Calculate the position for the arrow tail (below the text)
              (setq p1 (list (car insert_point) (- (cadr insert_point) 0.2)))

              ;; Calculate the arrow tail endpoint based on the same angle as the distance line with a length of 1.0
              (setq p2 (polar p1 rotation-angle 1.0))

              ;; Create a fraction of the distance between the arrow tail and arrowhead
              (setq di (/ (distance p1 p2) 3.0))

              ;; Create a transformation matrix for Z-axis translation
              (setq nm (trans '(0. 0. 1.) 1 0 t))
              ;; Generate an entity for the arrow
              (setq en
                (entget
                  (entmakex
                    (append
                      (list
                        '(0 . "LWPOLYLINE")     ; Define the entity as a polyline
                        '(100 . "AcDbEntity")   ; Specify the entity type
                        '(100 . "AcDbPolyline") ; Specify it as a polyline subtype
                        '(90 . 3)               ; Number of vertices
                        '(70 . 0)               ; Flags (default)
                        )
                      )
                    )
                  )
                )
              )

              ;; Define properties for the arrowhead's first line segment
              (setq l1
                (list
                  (cons 10 (trans p1 1 nm)) ; Starting point for the arrowhead
                  (cons 10 (trans (polar p2 (angle p2 p1) di) 1 nm)) ; Ending point for the arrowhead
                  (cons 40 (/ di 2.0)) ; Line width
                  '(41 . 0.0) ; Bulge factor (straight line)
                  (cons 10 (trans p2 1 nm)) ; Endpoint of the arrow's shaft
                  (cons 210 nm) ; 3D transformation data
                )
              )

              ;; Define properties for the arrowhead's second line segment
              (setq l2
                (list
                  (cons 10 (trans p1 1 nm)) ; Starting point for the arrowhead
                  '(40 . 0.0) ; Line width
                  (cons 41 (/ di 2.0)) ; Bulge factor (half of shaft length)
                  (cons 10 (trans (polar p1 (angle p1 p2) di) 1 nm)) ; Endpoint for the arrowhead
                  (cons 10 (trans p2 1 nm)) ; Endpoint of the arrow's shaft
                  (cons 210 nm) ; 3D transformation data
                )
              )

              ;; Reverse the entity property order to ensure proper rendering
              (setq en (reverse (member (assoc 39 en) (reverse en))))

              ;; Print a message to prompt the user to choose the arrow end
              (princ "\nChoose Arrow End...")

              ;; Start a loop that reads user input to modify the arrow entity
              (while (= 5 (car (setq gr (grread t 13 0))))
                ;; Modify the arrow entity based on user input
                (entmod
                  (append en
                   ;; Choose either l1 or l2 based on user input
                   (if (< (distance (cadr gr) p2) (distance (cadr gr) p1)) l1 l2)
                  )
                )
              )

              ;; Exit the command
              (princ)

              ;; Display the calculated results in the command bar
              (princ (strcat "\n" (rtos slp 2 1) "%"))

            )
          )
        )
      )
    )
  )
)

 

Edited by AbrAutoCADabra
Link to comment
Share on other sites

2 hours ago, mhupp said:

 

You can't have a variable share a named with a function. switch the angle variable to ang or something else. didn't really look at the rest of the code.

would also suggest to shorten the some of the variable naming down.

 

I'll often prefix a variable with something, perhaps in this case something like Arr_ (for example Arr_Angle) just to be sure that it can never be confused with a function and still retain some sort of description just to avoid this

  • Like 1
Link to comment
Share on other sites

After tinkering some more with the code I managed to update it a bit. What happens now is that I get the desired arrow under the slope % text-entity but the arrow head always points to the right and when I get prompted to choose an arrow end, even though I click on the left end it appears nothing happens and the arrow head still remains on the right side.

would really appreciate if someone could help me with this part since I can't seem to fix it on my own (Lack of experience).
 

(defun LM:roundm (n m)
  (* m (fix ((if (minusp n) - +) (/ n (float m)) 0.5)))
)

(defun c:Slopetextarrow (/ h1 h2 line d slp slope_text insert_point slope_text_entity rotation-angle p1 p2 di nm en l1 l2)
  ;; Get the first elevation value from user-selected text
  (setq h1 (car (entsel "\nSelect first elevation text > ")))

  (if (not (null h1))
    (progn
      (setq h1 (cdr (assoc 1 (entget h1)))) ; Extract the elevation value
      (if (vl-string-search "," h1) ; Check if it uses a comma as a decimal separator
        (setq h1 (atof (vl-string-subst "." "," h1))) ; Convert comma to dot for number parsing
        (setq h1 (atof h1)) ; Parse the elevation as a floating-point number
      ))
    (setq h1 nil) ; Set to nil if no valid elevation is selected
  )

  ;; Check if the first elevation value was successfully retrieved
  (if (null h1)
    (princ "\nInvalid selection for the first elevation text.")
    (progn
      ;; Get the second elevation value from user-selected text
      (setq h2 (car (entsel "\nSelect second elevation text > ")))

      (if (not (null h2))
        (progn
          (setq h2 (cdr (assoc 1 (entget h2)))) ; Extract the elevation value
          (if (vl-string-search "," h2) ; Check if it uses a comma as a decimal separator
            (setq h2 (atof (vl-string-subst "." "," h2))) ; Convert comma to dot for number parsing
            (setq h2 (atof h2)) ; Parse the elevation as a floating-point number
          ))
        (setq h2 nil) ; Set to nil if no valid elevation is selected
      )

      ;; Check if the second elevation value was successfully retrieved
      (if (null h2)
        (princ "\nInvalid selection for the second elevation text.")
        (progn
          ;; Get the line for calculating the distance
          (setq line (car (entsel "\nSelect a line to represent the distance > ")))

          (if (and line (eq (cdr (assoc 0 (entget line))) "LINE")) ; Check if a valid line is selected
            (progn
              ;; Calculate the distance between the endpoints of the line
              (setq d (distance (cdr (assoc 10 (entget line))) (cdr (assoc 11 (entget line)))))

              ;; Calculate the slope percentage
              (if (= d 0)
                (setq slp "The slope is undefined.") ; Handle the case of a vertical line
                (setq slp (LM:roundm (* (/ (- h2 h1) d) 100) 0.1)) ; Calculate and round the slope percentage
              )

              ;; Get a point for inserting the slope text
              (setq insert_point (getpoint "\nPick a point for the slope text insertion: "))

              ;; Calculate the direction vector of the line
              (setq line-start (cdr (assoc 10 (entget line))))
              (setq line-end (cdr (assoc 11 (entget line))))
              (setq line-direction (mapcar '- line-end line-start))

              ;; Calculate the rotation angle from the direction vector
              (setq rotation-angle (atan (cadr line-direction) (car line-direction)))

              ;; Adjust the angle by 180 degrees to align the text with the line
              (setq rotation-angle (+ rotation-angle pi))

              ;; Create the slope text entity with a height of 0.4 and the calculated rotation angle
              (setq slope_text_entity (entmake
                (list
                  '(0 . "TEXT")
                  '(8 . "0") ; Layer 0
                  (cons 10 insert_point) ; Insertion point
                  (cons 1 (strcat (rtos slp 2 1) "%")) ; Display the slope value rounded to one decimal place
                  (cons 40 0.4) ; Text height
                  (cons 50 rotation-angle) ; Text rotation angle
                )
              ))

              ;; Calculate the position for the arrow tail (below the text)
              (setq p1 (list (car insert_point) (- (cadr insert_point) 0.2)))

              ;; Calculate the arrow tail endpoint based on the same angle as the distance line with a length of 1.0
              (setq p2 (polar p1 rotation-angle 1.0))

              ;; Create a fraction of the distance between the arrow tail and arrowhead
              (setq di (/ (distance p1 p2) 3.0))

              ;; Create a transformation matrix for Z-axis translation
              (setq nm (trans '(0. 0. 1.) 1 0 t))
              ;; Generate an entity for the arrow
              (setq en
                (entget
                  (entmakex
                    (append
                      (list
                        '(0 . "LWPOLYLINE")     ; Define the entity as a polyline
                        '(100 . "AcDbEntity")   ; Specify the entity type
                        '(100 . "AcDbPolyline") ; Specify it as a polyline subtype
                        '(90 . 3)               ; Number of vertices
                        '(70 . 0)               ; Flags (default)
                      )
                      ;; Define the vertices for the polyline (arrow)
                      (setq l1
                        (list
                          (cons 10 (trans p1 1 nm))                      ; Vertex 1: Transformed p1
                          (cons 10 (trans (polar p2 (angle p2 p1) di) 1 nm)) ; Vertex 2: Transformed p2
                          (cons 40 (/ di 2.0))                           ; Line width
                          '(41 . 0.0)                                    ; Bulge factor (straight line)
                          (cons 10 (trans p2 1 nm))                      ; Vertex 3: Transformed p2
                          (cons 210 nm)                                  ; 3D transformation data
                        )
                      )
                    )
                  )
                )
              )
              ;; Define properties for the arrowhead's first line segment
              (setq l1
                (list
                  (cons 10 (trans p1 1 nm)) ; Starting point for the arrowhead
                  (cons 10 (trans (polar p2 (angle p2 p1) di) 1 nm)) ; Ending point for the arrowhead
                  (cons 40 (/ di 2.0)) ; Line width
                  '(41 . 0.0) ; Bulge factor (straight line)
                  (cons 10 (trans p2 1 nm)) ; Endpoint of the arrow's shaft
                  (cons 210 nm) ; 3D transformation data
                )
              )

              ;; Define properties for the arrowhead's second line segment
              (setq l2
                (list
                  (cons 10 (trans p1 1 nm)) ; Starting point for the arrowhead
                  '(40 . 0.0) ; Line width (0.0)
                  (cons 41 (/ di 2.0)) ; Bulge factor (half of shaft length)
                  (cons 10 (trans (polar p1 (angle p1 p2) di) 1 nm)) ; Endpoint for the arrowhead
                  (cons 10 (trans p2 1 nm)) ; Endpoint of the arrow's shaft
                  (cons 210 nm) ; 3D transformation data
                )
              )

              ;; Reverse the entity property order to ensure proper rendering
              (setq en (reverse (member (assoc 39 en) (reverse en))))

              ;; Print a message to prompt the user to choose the arrow end
              (princ "\nChoose Arrow End...")

              ;; Prompt the user to choose the arrowhead position
              (setq arrowhead_position (getpoint "\nChoose Arrow End: "))

              ;; Start a loop that reads user input to modify the arrow entity
              (while (= 5 (car (setq gr (getpoint "\nChoose Arrow End: "))))
                ;; Modify the arrow entity based on user input
                (entmod
                  (append en
                    ;; Choose either l1 or l2 based on user input
                    (if (< (distance gr p2) (distance gr p1)) l1 l2)
                  )
                )
              )

              ;; Exit the command
              (princ)

              ;; Display the calculated results in the command bar
              (princ (strcat "\n" (rtos slp 2 1) "%"))

            )
          )
        )
      )
    )
  )
)

 

Edited by AbrAutoCADabra
Link to comment
Share on other sites

So when I looked at this just now - to see how it works. 

Select elevation text 1 works OK

Select elevation text 2 works OK

Select line works OK

Select Text Insertion Point works OK

Then some calculations, the text is inserted OK, at the correct angle - OK

 

... however if the line is drawn 'backwards' - in reverse then the text isn't quite right

 

But at the same time the arrow is drawn - not OK?

Then is askes for the arrow direction.. after the arrow is drawn.... - not OK?

So I think you need to ask for the arrow direction before it is inserted

 

Link to comment
Share on other sites

Try this.. made a couple of changes for fun - didn't have much else to do just then

 

Main change was to set the percent text justified to bottom centre and then work out if the arrow end selection point is left or right  - and to rotate p2 by pi or not depending which way it is.

 

Quite a nice little program - just needed p2 altering

 

 

(defun c:testthis ( / h1 h2 Lineent LinePt1 LinePt2 LinePtTemp d slp insert_point line_start line_end line_direction rotation_Angle)

;;Sub Functions
;; Round Nuimber See Lee Mac Website
  (defun LM:roundm (n m)
    (* m (fix ((if (minusp n) - +) (/ n (float m)) 0.5)))
  )

;; Get number - select a text and verifies it is a number
;; as sub function since this is repeated in main LISP
  (defun getnumber ( message / txtent txtval ) 
    (princ "\n")                                            ; new line
    (while (/= (cdr (assoc 0 (entget (setq txtent (car (entsel message)) ) ))) "TEXT") ; Loop till text selected
      (princ "\nThat's not text; Hit Escape to Cancel or ") ; error message
    )                                                       ; end while
    (setq txtval (cdr (assoc 1 (entget txtent))))           ; Get text string
    (setq txtval (vl-string-subst "." "," txtval))          ; if ',' and not '.' deciml seperator 
    (if (= (rtos (atof txtval )) txtval )                   ; check and convert string to number
      (setq txtval (atof txtval))
      (progn
        (princ ". The selected text is not a number. ")
        (setq txtval (getnumber message) ) ; loop if text is not a number
      ) ; end progn
    )
    txtval ; return text value                              ; return text value
  )

;;Main Function
;;Select the height values
  (setq h1 (getnumber "Select first elevation text > "))   ; call sub function above
  (princ h1)(princ "\n")
  (setq h2 (getnumber "Select second elevation text > "))  ; call sub function above
  (princ h2)(princ "\n")

;;Select the line for distacne
  (while (/= (cdr (assoc 0 (entget (setq Lineent (car (entsel "\nSelect a line to represent the distance > ")) ) ))) "LINE")                                                    ; Loop till line selected
    (princ "\nThat's not a line; Hit Escape to Cancel or "); error message
  )                                                        ; end while

;; Get line ends
  (setq LinePt1 (cdr (assoc 10 (entget lineent))) )       ; end 1 of line, don't know desired 'start' point
  (setq LinePt2 (cdr (assoc 11 (entget lineent))) )       ; end 1 of line, don't know desired 'end' point
  (if (< (car LinePt1) (car LinePt2))                     ; swap points so 'start' is smallest 'x' value
    (progn                                                ; swap ends, pt1 is smallest 'x'
      (setq LinePtTemp LinePt1)
      (setq LinePt1 LinePt2)
      (setq LinePt2 LinePtTemp)
    ) ; end progn
  ) ; end if


;; Calculate the distance between the endpoints of the line
  (setq d (distance LinePt1 LinePt2))                     ; Length of selected line

;; Calculate the slope percentage
  (if (= d 0)
    (setq slp "The slope is undefined.") ; Handle the case of a vertical line
    (setq slp (LM:roundm (* (/ (- h2 h1) d) 100) 0.1))    ; Calculate and round the slope percentage
  )

;; Get a point for inserting the slope text
  (setq insert_point (getpoint "\nPick a point for the slope text insertion: "))

;;; Calculate the direction vector of the line
  (setq line-direction (mapcar '- LinePt2 LinePt1))

;; Calculate the rotation angle from the direction vector
  (setq rotation-angle (atan (cadr line-direction) (car line-direction)))

;; Adjust the angle by 180 degrees to align the text with the line
  (setq rotation-angle (+ rotation-angle pi))

 ;; Create the slope text entity with a height of 0.4 and the calculated rotation angle
  (setq slope_text_entity (entmakex
    (list
      '(0 . "TEXT")
      '(8 . "0") ; Layer 0
      (cons 10 insert_point) ; Insertion point
      (cons 1 (strcat (rtos slp 2 1) "%")) ; Display the slope value rounded to one decimal place
      (cons 40 0.4) ; Text height
      (cons 50 rotation-angle) ; Text rotation angle
      '(71 . 1) ; bottom centered
      '(72 . 1)
      (cons 11 insert_point)
      '(73 . 1)
    ) ; end list
  )) ; end setq

  (setq ArrowPt (getpoint "Select side for arrow"))
  
;; Calculate the position for the arrow tail (below the text)
  (setq p1 (mapcar '+ '(0 -0.2 0) insert_point))

;; Calculate the arrow tail endpoint based on the same angle as the distance line with a length of 1.0
  (if (< (car ArrowPt) (car insert_Point))                ; If Arrow direction smaller 'x' than nsert point
    (setq p2 (polar p1 (+ rotation-angle pi) 1.0))        ; swap arrow direction
    (setq p2 (polar p1 rotation-angle 1.0))               ; else leave it alone
  )                                                       ; end if

;; Create a fraction of the distance between the arrow tail and arrowhead
  (setq di (/ (distance p1 p2) 3.0))

;; Create a transformation matrix for Z-axis translation
  (setq nm (trans '(0. 0. 1.) 1 0 t))

;; Generate an entity for the arrow
  (setq en
    (entget
      (entmakex
        (append
          (list
            '(0 . "LWPOLYLINE")     ; Define the entity as a polyline
            '(100 . "AcDbEntity")   ; Specify the entity type
            '(100 . "AcDbPolyline") ; Specify it as a polyline subtype
            '(90 . 3)               ; Number of vertices
            '(70 . 0)               ; Flags (default)
          )
;; Define the vertices for the polyline (arrow)
         (setq l1
          (list
            (cons 10 (trans p1 1 nm))                      ; Vertex 1: Transformed p1
            (cons 10 (trans (polar p2 (angle p2 p1) di) 1 nm)) ; Vertex 2: Transformed p2
            (cons 40 (/ di 2.0))                           ; Line width
            '(41 . 0.0)                                    ; Bulge factor (straight line)
            (cons 10 (trans p2 1 nm))                      ; Vertex 3: Transformed p2
            (cons 210 nm)                                  ; 3D transformation data
          )
        )
      )
    )
  )
  )

;; Define properties for the arrowhead's first line segment
  (setq l1
    (list
      (cons 10 (trans p1 1 nm)) ; Starting point for the arrowhead
      (cons 10 (trans (polar p2 (angle p2 p1) di) 1 nm)) ; Ending point for the arrowhead
      (cons 40 (/ di 2.0)) ; Line width
      '(41 . 0.0) ; Bulge factor (straight line)
      (cons 10 (trans p2 1 nm)) ; Endpoint of the arrow's shaft
      (cons 210 nm) ; 3D transformation data
    )
  )

;; Define properties for the arrowhead's second line segment
  (setq l2
    (list
      (cons 10 (trans p1 1 nm)) ; Starting point for the arrowhead
      '(40 . 0.0) ; Line width (0.0)
      (cons 41 (/ di 2.0)) ; Bulge factor (half of shaft length)
      (cons 10 (trans (polar p1 (angle p1 p2) di) 1 nm)) ; Endpoint for the arrowhead
      (cons 10 (trans p2 1 nm)) ; Endpoint of the arrow's shaft
      (cons 210 nm) ; 3D transformation data
    )
  )

  (princ)
)

 

Link to comment
Share on other sites

11 hours ago, Steven P said:

Try this.. made a couple of changes for fun - didn't have much else to do just then

 

Main change was to set the percent text justified to bottom centre and then work out if the arrow end selection point is left or right  - and to rotate p2 by pi or not depending which way it is.

 

Quite a nice little program - just needed p2 altering

 

 

(defun c:testthis ( / h1 h2 Lineent LinePt1 LinePt2 LinePtTemp d slp insert_point line_start line_end line_direction rotation_Angle)

;;Sub Functions
;; Round Nuimber See Lee Mac Website
  (defun LM:roundm (n m)
    (* m (fix ((if (minusp n) - +) (/ n (float m)) 0.5)))
  )

;; Get number - select a text and verifies it is a number
;; as sub function since this is repeated in main LISP
  (defun getnumber ( message / txtent txtval ) 
    (princ "\n")                                            ; new line
    (while (/= (cdr (assoc 0 (entget (setq txtent (car (entsel message)) ) ))) "TEXT") ; Loop till text selected
      (princ "\nThat's not text; Hit Escape to Cancel or ") ; error message
    )                                                       ; end while
    (setq txtval (cdr (assoc 1 (entget txtent))))           ; Get text string
    (setq txtval (vl-string-subst "." "," txtval))          ; if ',' and not '.' deciml seperator 
    (if (= (rtos (atof txtval )) txtval )                   ; check and convert string to number
      (setq txtval (atof txtval))
      (progn
        (princ ". The selected text is not a number. ")
        (setq txtval (getnumber message) ) ; loop if text is not a number
      ) ; end progn
    )
    txtval ; return text value                              ; return text value
  )

;;Main Function
;;Select the height values
  (setq h1 (getnumber "Select first elevation text > "))   ; call sub function above
  (princ h1)(princ "\n")
  (setq h2 (getnumber "Select second elevation text > "))  ; call sub function above
  (princ h2)(princ "\n")

;;Select the line for distacne
  (while (/= (cdr (assoc 0 (entget (setq Lineent (car (entsel "\nSelect a line to represent the distance > ")) ) ))) "LINE")                                                    ; Loop till line selected
    (princ "\nThat's not a line; Hit Escape to Cancel or "); error message
  )                                                        ; end while

;; Get line ends
  (setq LinePt1 (cdr (assoc 10 (entget lineent))) )       ; end 1 of line, don't know desired 'start' point
  (setq LinePt2 (cdr (assoc 11 (entget lineent))) )       ; end 1 of line, don't know desired 'end' point
  (if (< (car LinePt1) (car LinePt2))                     ; swap points so 'start' is smallest 'x' value
    (progn                                                ; swap ends, pt1 is smallest 'x'
      (setq LinePtTemp LinePt1)
      (setq LinePt1 LinePt2)
      (setq LinePt2 LinePtTemp)
    ) ; end progn
  ) ; end if


;; Calculate the distance between the endpoints of the line
  (setq d (distance LinePt1 LinePt2))                     ; Length of selected line

;; Calculate the slope percentage
  (if (= d 0)
    (setq slp "The slope is undefined.") ; Handle the case of a vertical line
    (setq slp (LM:roundm (* (/ (- h2 h1) d) 100) 0.1))    ; Calculate and round the slope percentage
  )

;; Get a point for inserting the slope text
  (setq insert_point (getpoint "\nPick a point for the slope text insertion: "))

;;; Calculate the direction vector of the line
  (setq line-direction (mapcar '- LinePt2 LinePt1))

;; Calculate the rotation angle from the direction vector
  (setq rotation-angle (atan (cadr line-direction) (car line-direction)))

;; Adjust the angle by 180 degrees to align the text with the line
  (setq rotation-angle (+ rotation-angle pi))

 ;; Create the slope text entity with a height of 0.4 and the calculated rotation angle
  (setq slope_text_entity (entmakex
    (list
      '(0 . "TEXT")
      '(8 . "0") ; Layer 0
      (cons 10 insert_point) ; Insertion point
      (cons 1 (strcat (rtos slp 2 1) "%")) ; Display the slope value rounded to one decimal place
      (cons 40 0.4) ; Text height
      (cons 50 rotation-angle) ; Text rotation angle
      '(71 . 1) ; bottom centered
      '(72 . 1)
      (cons 11 insert_point)
      '(73 . 1)
    ) ; end list
  )) ; end setq

  (setq ArrowPt (getpoint "Select side for arrow"))
  
;; Calculate the position for the arrow tail (below the text)
  (setq p1 (mapcar '+ '(0 -0.2 0) insert_point))

;; Calculate the arrow tail endpoint based on the same angle as the distance line with a length of 1.0
  (if (< (car ArrowPt) (car insert_Point))                ; If Arrow direction smaller 'x' than nsert point
    (setq p2 (polar p1 (+ rotation-angle pi) 1.0))        ; swap arrow direction
    (setq p2 (polar p1 rotation-angle 1.0))               ; else leave it alone
  )                                                       ; end if

;; Create a fraction of the distance between the arrow tail and arrowhead
  (setq di (/ (distance p1 p2) 3.0))

;; Create a transformation matrix for Z-axis translation
  (setq nm (trans '(0. 0. 1.) 1 0 t))

;; Generate an entity for the arrow
  (setq en
    (entget
      (entmakex
        (append
          (list
            '(0 . "LWPOLYLINE")     ; Define the entity as a polyline
            '(100 . "AcDbEntity")   ; Specify the entity type
            '(100 . "AcDbPolyline") ; Specify it as a polyline subtype
            '(90 . 3)               ; Number of vertices
            '(70 . 0)               ; Flags (default)
          )
;; Define the vertices for the polyline (arrow)
         (setq l1
          (list
            (cons 10 (trans p1 1 nm))                      ; Vertex 1: Transformed p1
            (cons 10 (trans (polar p2 (angle p2 p1) di) 1 nm)) ; Vertex 2: Transformed p2
            (cons 40 (/ di 2.0))                           ; Line width
            '(41 . 0.0)                                    ; Bulge factor (straight line)
            (cons 10 (trans p2 1 nm))                      ; Vertex 3: Transformed p2
            (cons 210 nm)                                  ; 3D transformation data
          )
        )
      )
    )
  )
  )

;; Define properties for the arrowhead's first line segment
  (setq l1
    (list
      (cons 10 (trans p1 1 nm)) ; Starting point for the arrowhead
      (cons 10 (trans (polar p2 (angle p2 p1) di) 1 nm)) ; Ending point for the arrowhead
      (cons 40 (/ di 2.0)) ; Line width
      '(41 . 0.0) ; Bulge factor (straight line)
      (cons 10 (trans p2 1 nm)) ; Endpoint of the arrow's shaft
      (cons 210 nm) ; 3D transformation data
    )
  )

;; Define properties for the arrowhead's second line segment
  (setq l2
    (list
      (cons 10 (trans p1 1 nm)) ; Starting point for the arrowhead
      '(40 . 0.0) ; Line width (0.0)
      (cons 41 (/ di 2.0)) ; Bulge factor (half of shaft length)
      (cons 10 (trans (polar p1 (angle p1 p2) di) 1 nm)) ; Endpoint for the arrowhead
      (cons 10 (trans p2 1 nm)) ; Endpoint of the arrow's shaft
      (cons 210 nm) ; 3D transformation data
    )
  )

  (princ)
)

 

Awesome thinking and coding! 

There is an issue that "4,55" won't be recognized as a number also, I did some tuning to how the length of the line is retrieved (distance). I really like your solution for justified slope text at bottom center but now but is it possible to get the line first then be able to toggle between left and right for the arrow head? Like this (credit goes to leemac): Acadarrow.thumb.gif.70964d1dbdaa5ed45408f0abac646bc7.gif 

arrow.lsp
 

Also was wondering if it is possible to let the program know which elevation height is low (h1) and which one is high (h2), like between two selected texts it should recognize the one that is lowest as h1 or the one that is highest as h2.

Slopetextarrow2.lsp

Edited by AbrAutoCADabra
Added another file and request.
Link to comment
Share on other sites

10 hours ago, BIGAL said:

Like this, again this can control arrow direction say as always up.

 

(if (< h1 h2)
(progn
(setq temp h1)
(setq h1 h2)
(setq h2 temp)
)
)

 

This is actually a good idea that I've also been thinking about...

Edited by AbrAutoCADabra
Link to comment
Share on other sites

  • 3 weeks later...
  • 1 month later...

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...