Help - insert slope text (update old code)

[Guest]

Hi, I am using this code to inset ratio slope  text. I want to do a change to this code.

1) after pick the line or point1 point2 ----> then not pick point3 to insert the text, but insert align in the middle of the line automatic

2) Give an option to over or above the line

 

(defun c:ltrt (/	   doc	    spc	     *error*  TH:UnDo
		  TH:StartUnDo	    p1	     p2	      p3       scl   ht
		  tan2	   TL-Line  TH:UnDo
		 )
  (vl-load-com)
 (COMMAND "_layer" "_m" "_slope" "_c" "7" "" "")
 (command "style" "TopoCAD" "arial.ttf" 0 "" "" "" "" "")
  (and (setq doc (cond (doc)
		       ((vla-get-ActiveDocument (vlax-get-Acad-Object)))
		 )
       )
       (setq spc (if (zerop (vla-get-activespace doc))
		   (if (= (vla-get-mspace doc) :vlax-true)
		     (vla-get-modelspace doc)
		     (vla-get-paperspace doc)
		   )
		   (vla-get-modelspace doc)
		 )
       )
  ); end and
  (defun *error* (msg)
    (and TH:UnDo (vla-EndUndoMark doc))
    (or	(wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
	(princ (strcat "\n** Error: " msg " **"))
    )
    (princ)
  ) ; end defun
   (setq TH:StartUnDo (vla-StartUndoMark doc))
   (initget "Line Points")
 (if (eq (setq	TL-sel
		 (getkword (strcat "\nselect line or points [Line/Points]: " "< Line >"))
	  )
	  "Points"
      )
    (progn
      (setq scl (getvar "useri1")) ;<--- please don't remove set the scale of the text
      (setq ht(* 0.00175 scl)) ;<--- please don't remove set the scale of the text
      (setq p1 (getpoint "\n pick the 1st point : "))
      (setq p2 (getpoint p1 "\n pick the 2nd point: "))
      (setq p3 (getpoint "\n Pick insert text point : "))
      (setq tan2 (abs (/ (- (car p1) (car p2)) (- (cadr p1) (cadr p2)))))
      (entmake (list (cons 0 "LINE")
	;	     (cons 10 (trans p1 1 0))
	;	     (cons 11 (trans p2 1 0))
	       )
      )
      (entmake
	(list (cons 0 "TEXT")
	      (cons 10 (trans p3 1 0))
	      (cons 40 ht) ; text size
	      (cons 7 "TopoCAD") ; text style
	      (cons 1 (strcat "1 : "(rtos tan2 2 2)))
	)
      )
    ); end prog
    (progn
      (setq scl (getvar "useri1"))
      (setq ht(* 0.00175 scl))
      (prompt "\n select line : ")
      (setq TL-Line (ssget '((0 . "LINE"))))
      (setq e (ssname TL-Line 0))
      (setq p1 (cdr (assoc 10 (entget e))))
      (setq p2 (cdr (assoc 11 (entget e))))
      (setq p3 (getpoint "\n Pick insert text point : "))
      (setq tan2 (abs (/ (- (car p1) (car p2)) (- (cadr p1) (cadr p2)))))
      (entmake
	(list (cons 0 "TEXT")
	      (cons 10 (trans p3 1 0))
	      (cons 40 ht) ; text size
	      (cons 7 "TopoCAD") ; text style
	      (cons 1 (strcat "1 : "(rtos tan2 2 2)))
	)
      )
    ); end prog
  ) ;enf if
  (setq TH:UnDo (vla-EndUndoMark Doc))
  (princ "\n ")
  (princ)
  (mapcar 'setvar '("clayer" "cecolor" "celtype" "celweight")  (list "0" "BYLAYER" "BYLAYER" -1))
  (princ)
)

 

 

Thanks

Edited January 3, 2023 by prodromosm

[Steven P]

Am sure you had the text centre aligned here?

 

Easiest for the text alignment I think is make the text insertion point the same, the middle of the line but create the text either top centre or bottom centre to match what you want

 

 

I reckon you should also have somewhere a LISP that asked for user input which you can modify to ask "Above or Below Line", perhaps read up on initget with the next line containing getkeyword to limit the opti0ns to what you want.

 

 

Have a go and ask where you need more specific advice, or for us to look over the code if you make an error

[Guest]

I try this but don't insert the text at the end. Can any one help me to find the error?

 

(defun c:test (/ p1 p2 a scl ht)
  (command "_layer" "_m" "Slope" "_c" "7" "" "")
  (command "style" "TopoCAD" "arial.ttf" 0 "" "" "" "" "")
  (setq scl (getvar "useri1")) 
  (setq ht (* 0.00175 scl))
  (setq os_old (getvar "OSMODE"))
  (setvar "OSMODE" 13)

  (initget "Line Points")
  (if (eq 
      (setq TL-sel (getkword (strcat "\nSelect [Line/Points]: " "< Line >")))
      "Points"
    ) ; end eq
    (if  
      (and
        (setq p1 (getpoint "\nPoint1: "))
        (setq p2 (getpoint "\nPoint2: "))
      ) ; end and
      (setq tan2 (abs (/ (- (car p1) (car p2)) (- (cadr p1) (cadr p2)))))
    ) ; end if
    (progn
      (princ "Select Line:")
      (setq TL-Line (ssget "_+.:E:S" '((0 . "LINE"))))
      (setq e (entget (ssname TL-Line 0)))
      (setq p1 (cdr (assoc 10 e)))
      (setq p2 (cdr (assoc 11 e)))
      (setq tan2 (abs (/ (- (car p1) (car p2)) (- (cadr p1) (cadr p2)))))
    ) ; end progn
  ) ; end if
  (setvar "OSMODE" os_old)

  (entmake
    (list
      '(0 . "TEXT")
      '(7 . "TopoCAD")
      '(100 . "AcDbEntity")
      '(100 . "AcDbText")
      '(10 0. 0. 0.)
      (cons 40 ht)
      (cons 1 (strcat "1 : "(rtos tan2 2 2))); end cons
      (cons 50
      (if (minusp (cos a))
          (+ pi a)
          a
      ) ; end if
      )
      '(72 . 1)
      (cons 11 (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.)) p1 p2))
      '(73 . 1)
    ) ; end list
  ) ; end entmake
 (setvar "OSMODE" 13)
;layer 0
  (mapcar 'setvar '("clayer" "cecolor" "celtype" "celweight")  (list "0" "BYLAYER" "BYLAYER" -1))
  (princ)
)

 

 

Thanks

test.dwg

Edited January 4, 2023 by prodromosm

[Guest]

The code updated. Can anyone help me to fix the error ?

 

Thanks

[Steven P]

How far did you get in checking this? 

 

If you suspect that the creating the text is the problem, try commenting out this part of the code and seeing what happens (put a ; at the beginning of each line, remembering to make sure you do the same to any closing brackets in the case of for example 'if' statements)

 

Then work through the code reinstating lines until you find the problem, (removing the ;s) - should be an easy fix afterwards (look at the cons 50)

if you also post the error that your code is giving (t should be in the command line) then that helps us all to work out what the problem is (it could be: ; error: bad argument type: numberp: nil which suggests that CAD is looking for a number and it being given a string)

 

 

I reckon that should be enough for you to work it out

[Guest]

I  find the error

 

 

      (cons 1
        (cons 1 (strcat "1 : "(rtos tan2 2 2)))
      ) ; end cons

 

 

      (cons 1
        (strcat "1 : "(rtos tan2 2 2))
      ) ; end cons

 

Edited January 4, 2023 by prodromosm

[Steven P]

So if you think ( Cons 1 .... ) is the error then try it without the formula? Cons 1 is the text string that is displayed, how about trying it as just:

 

(cons 1 "1 : " )

 

Suspect that it might not be that, but ty it and see, and also look in the command line and note any errors CAD tells you

Edited January 4, 2023 by Steven P

[Guest]

Hi Steven P. The problem was

 

   (cons 1
        (cons 1 (strcat "1 : "(rtos tan2 2 2)))
      ) ; end cons

 

You see?

 

   (cons 1
        (cons 1 

 

Is working fine with this :

 

 (cons 1
        (strcat "1 : "(rtos tan2 2 2))
      ) ; end cons

 

I can not see anything else. I don't know if is something in the code wrong, but code works and give no erros !!!

 

 

I dont know if is  any way to have an option  to insert text not only over the line but above   [over/ above]

Edited January 4, 2023 by prodromosm

[Steven P]

Excellent and well done.

 

It should help you speed up error checking following the same process rather than waiting for answers here?

 

 

(I struggled to work our an error in a code you hadn't shared.... the last one you shared had the error on the cons 50 line).