Help to update an old code

[mhy3sx]

Hi I use this code to dimension cross sections. If move the cross section to  0, Datum Elev possiton the code works perfect. To avoid to move the cross section I add a command to move the ucs 0, Datum Elev in the place were the section exist. But the code gives me wrong values for  polyline coordinates. Can any one help me to transform the insert coordinates by the new ucs possition ? 

 

 

(defun c:test2 (/ *error* dch dcl msg des drv _option1 _option2 _option3)

  (setq pt (getpoint "\nClick on point you want to set coordinates of or specify old coordinates : "))
  (setq v pt)
  (setq Ycoord (getreal "\nSpecify Hor : "))
  (setq pt (list 0.0 Ycoord 0.0))

  (defun err (s)
    (if (= s "Function cancelled")
      (princ "\nVERTEXT - cancelled: ")
      (progn (princ "\nVERTEXT - Error: ") (princ s) (terpri))
    )
    (resetting)
    (princ "SYSTEM VARIABLES have been reset\n")
    (princ)
  )

  (defun setv (systvar newval)
    (setq x (read (strcat systvar "1")))
    (set x (getvar systvar))
    (setvar systvar newval)
  )

  (defun setting () 
    (setq oerr *error*) 
    (setq *error* err) 
    (setv "CMDECHO" 0) 
    (setv "BLIPMODE" 0)
  )

  (defun rsetv (systvar)
    (setq x (read (strcat systvar "1"))) 
    (setvar systvar (eval x))
  )

  (defun resetting () 
    (rsetv "CMDECHO") 
    (rsetv "BLIPMODE") 
    (setq *error* oerr)
  )

  (defun dxf (code ename) 
    (cdr (assoc code (entget ename)))
  )

  (defun vertext (mode / en vlist)
    (setq en (get-en))
    (if (= (dxf 0 en) "LWPOLYLINE")
      (setq vlist (get-lwvlist en))
      (setq vlist (get-plvlist en))
    )
    (write-it vlist en mode)
  )

  (defun get-en (/ no-ent en msg1 msg2)
    (if (not (tblsearch "layer" "GROUND2"))
      (command "_layer" "_m" "GROUND2" "_c" "11" "" "")
    )

    (setq no-ent 1
          en     nil
          msg1   "\nSelect polyline: "
          msg2   "\nNo polyline selected !!!."
    )

    (while no-ent
      (setq en (car (entsel msg1)))
      (if (and en (or (= (dxf 0 en) "LWPOLYLINE") 
                      (= (dxf 0 en) "POLYLINE")))
        (progn
          (setq lst (entget en))
          (entmod (subst '(8 . "GROUND2") (assoc 8 lst) lst))
          (setq no-ent nil)
        )
        (prompt msg2)
      )
    )
    en
  )

  (defun get-lwvlist (en / elist num-vert vlist)
    (setq elist    (entget en)
          num-vert (cdr (assoc 90 elist))
          elist    (member (assoc 10 elist) elist)
          vlist    nil
    )
    (repeat num-vert
      (setq vlist (append vlist (list (cdr (assoc 10 elist)))))
      (setq elist (cdr elist)
            elist (member (assoc 10 elist) elist)
      )
    )
    vlist
  )

  (defun get-plvlist (en / vlist)
    (setq vlist nil
          en    (entnext en)
    )
    (while (/= "SEQEND" (dxf 0 en))
      (setq vlist (append vlist (list (dxf 10 en))))
      (setq en (entnext en))
    )
    vlist
  )

  (defun write-it (vlst en mode / newvlist msg3 fname)
    (setq newvlist (mapcar '(lambda (x) (trans x en 0)) vlst)
          msg3     "Polyline vertex file"
          f1       (open "FNAME" "w")
    )
    (write-header)
    (write-vertices newvlist mode)
    (setq f1 (close f1))
  )

  (defun write-header (/ str)
    (setq str "        POLYLINE VERTEX POINTS")
    (write-line str f1)
    (setq str (strcat "  X            " "  Y            " "  Z"))
    (write-line str f1)
  )

  (defun write-vertices (newvlist mode / xstr ystr zstr str)
    (setvar 'osmode 0)
    (command "_layer" "_m" "GROUND2 TEXT" "_c" "7" "" "")

    (setq httt (if mode "0.35" "1.75"))

    (foreach item newvlist
      (setq xstr (rtos (nth 0 item) 2 2)
            ystr (rtos (nth 1 item) 2 2)
            zstr (rtos (nth 2 item) 2 2)
            str  (strcat xstr (spaces xstr) ystr (spaces ystr) zstr)
      )
      (command "style" "PMSF-TEXT 2" "Arial" "" "" "" "" "")
      (command "text" "_c" (list (+ (atof xstr) (/ (atof httt) 2.0)) (- (cadr v) 8.40)) httt "0" xstr)
      (command "text" "_c" (list (+ (atof xstr) (/ (atof httt) 2.0)) (- (cadr v) 6.00)) httt "0" ystr)
    )
  )

  (defun spaces (str / field num char space)
    (setq field 15
          num   (- field (strlen str))
          char  " "
          space "")
    (repeat num (setq space (strcat space char)))
  )

  (setq scf 1)
  (setting)
  (vertext t)
  (resetting)

  (princ)
)

 

 

Thanks

[mhy3sx]

I think I fix the code but I is not. I update the code to calculate the coordinates correct

 

(defun write-vertices (newvlist mode / xstr ystr zstr str transformed_pt)
  (setvar 'osmode 0)
  (command "_layer" "_m" "GROUND2 TEXT" "_c" "7" "" "")

  (setq httt (if mode "0.35" "1.75"))

  (foreach item newvlist
    (setq transformed_pt (trans item 0 1) ; Transforms the point to the new UCS
          xstr (rtos (- (car transformed_pt) (car v)) 2 2) ; Correct x coordinate
          ystr (rtos (+ (- (cadr transformed_pt) (cadr v)) Ycoord) 2 2) ; Correct y coordinate and add Ycoord
          zstr (rtos (nth 2 transformed_pt) 2 2)
          str  (strcat xstr (spaces xstr) ystr (spaces ystr) zstr)
    )
    (command "style" "PMSF-TEXT 2" "Arial" "" "" "" "" "")
    (command "text" "_c" (list (+ (atof xstr) (/ (atof httt) 2.0)) (- (cadr v) 8.40)) httt "0" xstr)
    (command "text" "_c" (list (+ (atof xstr) (/ (atof httt) 2.0)) (- (cadr v) 6.00)) httt "0" ystr)
	
  )
)

 

But now put the coordinates inwrong possiton

 

The previous code put the text in correct possition but have wrong coordinates

 

  (defun write-vertices (newvlist mode / xstr ystr zstr str)
    (setvar 'osmode 0)
    (command "_layer" "_m" "GROUND2 TEXT" "_c" "7" "" "")

    (setq httt (if mode "0.35" "1.75"))

    (foreach item newvlist
      (setq xstr (rtos (nth 0 item) 2 2)
            ystr (rtos (nth 1 item) 2 2)
            zstr (rtos (nth 2 item) 2 2)
            str  (strcat xstr (spaces xstr) ystr (spaces ystr) zstr)
      )
      (command "style" "PMSF-TEXT 2" "Arial" "" "" "" "" "")
      (command "text" "_c" (list (+ (atof xstr) (/ (atof httt) 2.0)) (- (cadr v) 8.40)) httt "0" xstr)
      (command "text" "_c" (list (+ (atof xstr) (/ (atof httt) 2.0)) (- (cadr v) 6.00)) httt "0" ystr)
    )
  )

 

Can anyone help me to fix the code?

 

Thanks

Edited Monday at 03:58 PM by mhy3sx

[mhy3sx]

Any ideas?

 

Thanks

[rlx]

not sure if this helps let alone work because I have nothing to test (and 3D / trans is not my thing) but maybe it at least can inspire you. It could also be a case of just a few typo's :

 

;;; right coordinates (string) , wrong position
(defun write-vertices (newvlist mode / xstr ystr zstr str transformed_pt)
  (setvar 'osmode 0) (setq httt (if mode "0.35" "1.75"))
  (command "_layer" "_m" "GROUND2 TEXT" "_c" "7" "" "" "style" "PMSF-TEXT 2" "Arial" "" "" "" "" "")
  (foreach item newvlist
    ; Transforms the point to the new UCS
    (setq transformed_pt (trans item 0 1)
          ;;; Correct x coordinate
          xstr (rtos (- (car transformed_pt) (car v)) 2 2)
          ;;; Correct y coordinate and add Ycoord
          ystr (rtos (+ (- (cadr transformed_pt) (cadr v)) Ycoord) 2 2)
          zstr (rtos (nth 2 transformed_pt) 2 2)
          ;;; when / where is str used?
          str  (strcat xstr (spaces xstr) ystr (spaces ystr) zstr)
    )
    (command "text" "_c" (list (+ (atof xstr) (/ (atof httt) 2.0)) (- (cadr v) 8.40)) httt "0" xstr)
    (command "text" "_c" (list (+ (atof xstr) (/ (atof httt) 2.0)) (- (cadr v) 6.00)) httt "0" ystr)	
  )
)

;;; But now put the coordinates inwrong possiton
;;; The previous code put the text in correct possition but have wrong coordinates

;;; wrong coordinates (string) , right position (points)
(defun write-vertices (newvlist mode / xstr ystr zstr str)
  (setvar 'osmode 0)
  (command "_layer" "_m" "GROUND2 TEXT" "_c" "7" "" "")
  (setq httt (if mode "0.35" "1.75"))
  (foreach item newvlist
    (setq xstr (rtos (nth 0 item) 2 2)
          ystr (rtos (nth 1 item) 2 2)
          zstr (rtos (nth 2 item) 2 2)
          ;;; is str the combined string for x / y and if so where is it useds?
          str  (strcat xstr (spaces xstr) ystr (spaces ystr) zstr)
    )
    (command "style" "PMSF-TEXT 2" "Arial" "" "" "" "" "")
    (command "text" "_c" (list (+ (atof xstr) (/ (atof httt) 2.0)) (- (cadr v) 8.40)) httt "0" xstr)
    ;;; its says atof xstr but maybe    ystr? ................................................. str?
    (command "text" "_c" (list (+ (atof xstr) (/ (atof httt) 2.0)) (- (cadr v) 6.00)) httt "0" ystr)
  )
)

;;; best of both worlds : use points from 2nd posted routine and strings from 1st
(defun write-vertices (newvlist mode / ptx pty ptz xstr ystr zstr str)
  (setvar 'osmode 0) (setq httt (if mode "0.35" "1.75"))
  (command "_layer" "_m" "GROUND2 TEXT" "_c" "7" "" "" "style" "PMSF-TEXT 2" "Arial" "" "" "" "" "")
  (foreach item newvlist
    ;;; right strings
    (setq transformed_pt (trans item 0 1) ; Transforms the point to the new UCS
          xstr (rtos (- (car transformed_pt) (car v)) 2 2) ; Correct x coordinate
          ystr (rtos (+ (- (cadr transformed_pt) (cadr v)) Ycoord) 2 2) ; Correct y coordinate and add Ycoord
          zstr (rtos (nth 2 transformed_pt) 2 2)
          str  (strcat xstr (spaces xstr) ystr (spaces ystr) zstr))
    
    ;;; right coordinates (used other variable names to keep'm apart
    (setq ptx (rtos (nth 0 item) 2 2) pty (rtos (nth 1 item) 2 2) ptz (rtos (nth 2 item) 2 2)
          str (strcat xstr (spaces xstr) ystr (spaces ystr) zstr))
    
    (command "text" "_c" (list (+ (atof ptx) (/ (atof httt) 2.0)) (- (cadr v) 8.40)) httt "0" xstr)
    (command "text" "_c" (list (+ (atof pty) (/ (atof httt) 2.0)) (- (cadr v) 6.00)) httt "0" ystr)
  )
)

 

Edited Monday at 06:31 PM by rlx

[mhy3sx]

Hi rlx . The code is too close to work. Now x coorsinates are set correct in the correct possition. The y coordinates is correct but in wrong possition.

 

Any other ideas how to fix the code. I attach  a dwg to test the code

 

Thanks

 

 

tes2t.dwg

Edited Monday at 06:39 PM by mhy3sx

[rlx]

(command "text" "_c" (list (+ (atof ptx) (/ (atof httt) 2.0)) (- (cadr v) 8.40)) httt "0" xstr)
(command "text" "_c" (list (+ (atof ptx) (/ (atof httt) 2.0)) (- (cadr v) 6.00)) httt "0" ystr)

 

I wasn't sure if I had to use ptx or pty in second command line so I changed it to pty but probably it so be twice ptx?

[mhy3sx]

Thanks rlx. Now works perfect

[mhy3sx]

Hi rlx. Is it possible to do the same coordinate transformation , and fix the correct possition of the text to this code ?

 

(defun c:foo () ; Define the function to execute the dialog


  (defun *error* (msg)
    (if (and (= 'int (type dch)) (< 0 dch)) (unload_dialog dch))
    (if (= 'file (type des)) (close des))
    (if (and (= 'str (type dcl)) (findfile dcl)) (vl-file-delete dcl))
    (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
        (princ (strcat "\nError: " msg)))
    (princ)
  )
  
  
  ;; Define the list for the popup list (values for the dropdown)
  (setq names '("GRD1" "GRD2"))
  
  ;; Create the DCL dialog as a string and write it to a temporary file
  (if (not (and (setq dcl (vl-filename-mktemp nil nil ".dcl"))
                (setq des (open dcl "w"))))
      (progn
        (princ "\nUnable to create DCL file.")
        (exit)
      )
  ) ;;; end if

  ;; Write DCL content to the temporary file
  (foreach str
      '(
         "vd1 : dialog {"
         "  label = \"Select\";"
         "  :edit_box { label = \"Hor.=:\"; key = \"Ycoord\"; alignment = left; width = 8; fixed_width = true; mnemonic = \"H\"; }"
         "  :popup_list { label = \"Select Ground:\"; key = \"dl\"; alignment = left; width = 8; mnemonic = \"L\"; value = \"6\"; }"
         "  :row {"
         "    :spacer { width = 1; }"
         "    :ok_button { label = \"Ok\"; key = \"accept\"; width = 8; fixed_width = true; }"
         "    :spacer { width = 1; }"
         "    :default_button { label = \"Cancel\"; key = \"cancel\"; width = 8; fixed_width = true; }"
         "  }"
         "}" ; end of dialog
       )
    (write-line str des)
  ) ;;; end foreach

  ;; Close the DCL file after writing the content
  (close des)
  
  ;; Debug: Check if DCL file is created and show its path
  (princ (strcat "\nDCL file created at: " dcl))
  
  ;; Load the dialog and open it
  (if (and (setq dch (load_dialog dcl)) (new_dialog "vd1" dch))
      (progn
        (start_list "dl") ;; Start the popup list
        (mapcar 'add_list names) ;; Add the items to the popup list
        (end_list) ;; End the list
		

        ;; Action for the edit box (get base line height)
        (action_tile "Ycoord" "(setq baseh (atof $value))")

        ;; Action for the accept button (OK)
        (action_tile "accept"
                     (strcat
                      "(progn"
                      "(setq index (atoi (get_tile \"dl\")))" ;; Get the selected value from the list
                      "(done_dialog) (setq userclick T))"))

        ;; Action for the cancel button
        (action_tile "cancel" "(done_dialog) (setq userclick nil)")

        ;; Start the dialog
        (start_dialog)
        
        ;; Unload the dialog and delete the temporary DCL file
        (unload_dialog dch)
        (if (and dcl (findfile dcl)) (vl-file-delete (findfile dcl)))

        ;; If the user clicked OK, proceed with the logic
        (if userclick
            (progn
              ;; Depending on the selected value, set the appropriate height
              (cond
                ((= 0 index) (setq dp 3.60))  ;; For "Φ.Ε"
                ((= 1 index) (setq dp 8.40))  ;; For "ΕΡΥΘ."
              )
              
              ;; Layer assignment based on the selection
              (if (= index 0)
                  (command "_layer" "_m" "GRD1" "_c" "7" "" "")
                  (if (= index 1)
                      (command "_layer" "_m" "GRD2" "_c" "7" "" "")
                  )
              )
			  
			  
		    ; Change UCS
    (setvar 'osmode 32)
    (setq pt (getpoint "\nChange UCS  select point: "))
    (setq v pt)
    (setq pt (list 0.0 Ycoord 0.0))
    (setvar 'osmode 1)
    (setvar 'dimzin 2)
    ;------------------------------------------------------ 

              ;; Get points and place text on the drawing based on the user input
              (while
                (setq
                  pt1 (getpoint "\nSelect point on polyline:")
                  x (car pt1)
                  y (cadr pt1)
                  xpti (- baseh dp) ;; Calculate the x distance
                  ypti (+ xpti 2.40) ;; Calculate the y distance
                  pt2 (list (car pt1) ypti 2.0)
                  pt3 (list (car pt1) xpti 2.0)
                )
				
				  (command "style" "PMSF-TEXT 2" "Arial" "" "" "" "" "")
				  
                 ;; Format x and y as "0.00" if they are 0 
                 (setq x (if (= x 0) "0.00" (rtos x 2 2))) 
                 (setq y (if (= y 0) "0.00" (rtos y 2 2)))

				 
                ;; Place the text at the calculated points
                (command "text" "mc" "_non" pt2 "0.35" "0" y)
                (command "text" "mc" "_non" pt3 "0.35" "0" x)
              ); while
            )
        )
      )
  )
   (setvar 'osmode 0)
   (vl-cmdf "_.UCS" "_W")
  (princ)
)

 

Thanks