Author Topic: Help-Numeric text with area lisp  (Read 175 times)

0 Members and 1 Guest are viewing this topic.

PM

  • Bull Frog
  • Posts: 403
Help-Numeric text with area lisp
« on: January 14, 2023, 03:52:34 PM »
Hi,I am trying to add an option in an old code to give the option to insert the results in model or paper space.

This lines of code is in the wrong position, and I want to add an option for the text height (for paper space, default 2.5). Can anyone help ?


Code: [Select]
      (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
           ; ms (vla-get-paperspace c_doc) <-- I think here is the problem
            s_no (rh:get_int "Start")
            e_no (rh:get_int "End")
            str (strcat pfix (itoa e_no) sfix " - " pfix (itoa s_no) sfix " = "  (rtos (vlax-curve-getarea (ssname lwp 0)) 2 2)   " sq.m.")
      );end_setq



Code: [Select]
  (defun rh:get_int (msg / no)
      (initget 7)
      (setq no (getint (strcat "\nEnter " msg ": ")))
    );end_defun
     
    (defun rh:get_kword ( msg lst d_val / tmp)
      (cond ( (and (= (type lst) 'LIST) (vl-position d_val lst) (= (type msg) 'STR))
              (initget 1 (vl-string-right-trim " "(apply 'strcat (mapcar '(lambda (x) (strcat x " ")) lst))))
              (cond ( (setq tmp (getkword (strcat "\n" msg " ["(vl-string-right-trim "/" (apply 'strcat (mapcar '(lambda (x) (strcat x "/")) lst))) "] <" d_val "> : ")))) (d_val))
            )
      );end_cond
    );end_defun
     
    (defun rh:get_str ( msg / tmp)
      (cond ( (= (type msg) 'STR) (setq tmp (getstring (strcat "\n" msg " : ")))))
    );end_defun
     
    (defun c:numtext ( / *error* c_doc ms sv_lst sv_vals ps pfix sfix s_no e_no str cnt)
     (setq lwp (ssget "_+.:S:E" '((0 . "LWPOLYLINE"))))
      (defun *error* ( msg )
        (mapcar '(lambda (x y) (setvar x y)) sv_lst sv_vals)
        (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred.")))
        (princ)
      );_end_*error*_defun
     
      (setq sv_lst (list 'dynprompt 'dynmode 'cmdecho)
            sv_vals (mapcar 'getvar sv_lst)
            ps (rh:get_kword "Prefix or Suffix" (list "None" "Prefix" "Suffix" "Both") "None")
      );end_setq
     
      (mapcar 'setvar sv_lst (list 1 3 0))
     
  (cond ( (= ps "Prefix") (setq pfix (rh:get_str "Enter Prefix") sfix ""))
        ( (= ps "Suffix")  (setq sfix (rh:get_str "Enter Suffix") pfix ""))
        ( (= ps "Both")  (setq pfix (rh:get_str "Enter Prefix") sfix (rh:get_str "Enter Suffix")))
        ( (= ps "None") (setq pfix "" sfix ""))
  );end_cond

;----------------------PAPER SPACE - MODEL SPACE -------------------------------

(initget "Modelspace Paperspace")
(setq ms  (getkword "\n Insert text [Modelspace/Paperspace]? <Modelspace>: "))
      (cond
((eq ms  "Paperspace")
(vla-put-ActiveSpace c_doc acPaperSpace)
(vla-put-MSpace c_doc :vlax-false)
(setq Space (vla-get-PaperSpace c_doc))
)
(T
(vla-put-ActiveSpace c_doc acModelSpace)
(if (not (eq (getvar "TILEMODE") 1)) (vla-put-MSpace c_doc :vlax-true))
(setq Space (vla-get-ModelSpace c_doc))
)
)

;------------------------------------------------------------------------
   
        (if (=(tblsearch "layer" "ΚΕΙΜ_Layout") nil)
      (command "_layer" "_m" "ΚΕΙΜ_Layout" "_c" "7" "" "")
         );end if
       (setvar "clayer" "ΚΕΙΜ_Layout")

      (command "_.-style" "TopoCAD" "arial.ttf" "0" "1" "0" "n" "n" "n")

      (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
           ; ms (vla-get-paperspace c_doc) <-- I think here is the problem
            s_no (rh:get_int "Start")
            e_no (rh:get_int "End")
            str (strcat pfix (itoa e_no) sfix " - " pfix (itoa s_no) sfix " = "  (rtos (vlax-curve-getarea (ssname lwp 0)) 2 2)   " sq.m.")
      );end_setq
     
      (cond ( (> e_no s_no)
              (setq cnt (1- e_no))
              (while (< (1- s_no) cnt e_no)
                (setq str (strcat pfix (itoa cnt) sfix " - " str)
                      cnt (1- cnt)
                );end_setq
              );end_while
            )
            (t
              (setq cnt (1+ e_no))
              (while (> (1+ s_no) cnt e_no)
                (setq str (strcat pfix (itoa cnt) sfix " - " str)
                      cnt (1+ cnt)
                );end_setq
              );end_while
            )
      );end_cond
     
      (vla-addmtext ms (vlax-3d-point (getpoint "\nSelect Insertion Point : ")) 0 str)
     
      (mapcar '(lambda (x y) (setvar x y)) sv_lst sv_vals)

; layer  0
(mapcar 'setvar '("clayer" "cecolor" "celtype" "celweight") (list "0" "BYLAYER" "BYLAYER" -1))
(*error* "")

    );end_defun
     

Thanks
« Last Edit: January 14, 2023, 03:55:51 PM by PM »

PM

  • Bull Frog
  • Posts: 403
Re: Help-Numeric text with area lisp
« Reply #1 on: January 15, 2023, 10:53:13 AM »
Ok, I fix it.

Thanks