Jump to content
Tomislav

can't get my lisp to loop

Recommended Posts

Tomislav
(defun c:lpsv (/ f a numt doc_path txt decimals name cmd alignment startstation)

  (defun *error* (msg)
    (if (or (= msg "quit / exit abort")
            (= msg "bad argument type: lentityp nil")
            (= msg "bad argument type: numberp: nil")
            ) ;_  or
      (princ "")
      (princ msg)
      ) ;_  if
    (if f
      (close f)
      ) ;_  if
    (command-s "ucs" "")
    (setvar 'CELWEIGHT oldLweight)
    (setvar 'OSMODE oldOsmode)
    (setvar 'DIMZIN oldDimzin)
    (setvar 'CMDECHO oldCmdecho)
    ) ;_  defun


  (setq pntal nil
        loop nil
        main nil
        base nil
        base_height
         nil
        station nil
        pnt nil
        some_pnt nil
        pntsort nil
        pnttrans_w
         nil
        ) ;_  setq
  (setq acadObj (vlax-get-acad-object)
        doc     (vla-get-ActiveDocument acadObj)
        mSpace  (vla-get-ModelSpace doc)
        ) ;_  setq
  (setq oldCmdecho (getvar 'CMDECHO))
  (setq oldDimzin (getvar 'DIMZIN))
  (setq oldOsmode (getvar 'OSMODE))
  (setq oldLweight (getvar 'CELWEIGHT))
  (setvar 'CMDECHO 0)
  (setvar 'DIMZIN 1)
  (vl-load-com)
  (setq txt "")
  (initget 0 "A R")
  (or
    (setq coord_type
           (getkword
             "\nDo you wish to list absolut coordinates as .txt or relative to alignment as .csv [ <Absolut> / Relative ] "
             ) ;_  getkword
          ) ;_  setq
    (setq coord_type "A")
    ) ;_  or
  (if (= coord_type "A")
    (progn
      (initget 0 "N W")
      (or
        (setq name
               (getkword
                 "\nDo you wish to list coords with name or without [ <Name> / Without ] "
                 ) ;_  getkword
              ) ;_  setq
        (setq name "N")
        ) ;_  or
      ) ;_  progn
    ) ;_  if
  (initget 0 "0 1 2 3 4")
  (or
    (setq decimals (getkword "\nEnter number of decimals  [ 0/1/2/3/4 ] <3> : "))
    (setq decimals "3")
    ) ;_  or
  (setq decimals (atoi decimals))
  (setq doc_path (getvar 'DWGPREFIX))
  (setq doc_path (vl-string-translate "/" "\\" doc_path))
  (if (= coord_type "R")
    (setq f (open (getfiled "Csv File" doc_path "csv" 5) "a"))
    (progn
      (setq f (open (getfiled "Text File" doc_path "txt" 5) "a"))
      (setq alignment
             (vlax-ename->vla-object
               (ssname
                 (lm:ssget "\nSelect an alignment : "
                           '(":S" ((0 . "LINE,LWPOLYLINE,POLYLINE,AECC_ALIGNMENT")))
                           ) ;_  lm:ssget
                 0
                 ) ;_  ssname
               ) ;_  vlax-ename->vla-object
            ) ;_  setq


;;;	podaci za alignment

      (if (= (getvar 'USERR1) 0)
        (progn
          (or (setq startstation (getreal "\nEnter alignment starting station <0.0> : "))
              (setq startstation 0.0)
              ) ;_  or
          (setvar 'USERR1 startstation)
          ) ;_  progn
        (progn
          (princ "\nEnter alignment starting station <")
          (princ (getvar 'USERR1))
          (princ "> : ")
          (if (setq startstation (getreal))
            (setvar 'USERR1 startstation)
            (setq startstation (getvar 'USERR1))
            ) ;_  if
          ) ;_  progn
        ) ;_  if
      ) ;_  progn
    ) ;_  if

  (setvar 'OSMODE 33)

;;; podaci sa profila
  (setq main T)
  (setq loop T)
  (while (setq station (getreal "\nEnter station : "))	;;;LOOP BACK HERE
    (if (> 0 (- station startstation))
      (progn
        (alert "Station must be larger than alignment starting station!!!")
        (exit)
        ) ;_  progn
      ) ;_  if
    (setq base        (getpoint "\nPick base point on section view: ")
          base_height (getreal "\nEnter lowest height : ")
          ) ;_  setq  

    (while loop


;;; racuna srediste ucs-a na osi kao i prethodnu i slijedecu tocku


      (if (= coord_type "A")
        (progn
          (setq pnt_ucs_station (vlax-curve-getPointAtDist alignment (- station startstation)))
          (setq pnt_ucs_station_prev
                 (vlax-curve-getPointAtDist
                   alignment
                   (- station startstation 0.001)
                   ) ;_  vlax-curve-getPointAtDist
                ) ;_  setq
          (setq pnt_ucs_station_next
                 (vlax-curve-getPointAtDist
                   alignment
                   (+ (- station startstation) 0.001)
                   ) ;_  vlax-curve-getPointAtDist
                ) ;_  setq


;;;	izabiranje tocaka


          (if (= name "N")
;;; SA IMENOM TOCKE
            (progn
              (if (wcmatch
                    (cdr
                      (assoc 0
                             (setq numt (ENTGET (CAR (ENTSEL "\nSelect point number: "))))
                             ) ;_  assoc
                      ) ;_  cdr
                    "ATTRIB,MTEXT,TEXT"
                    ) ;_  wcmatch
                (progn
                  (vl-cmdf "ucs" base "")
                  (vl-cmdf "ucs" (list 0 (* base_height -1)) "")
                  (vl-cmdf "ucs" "x" "-90")
                  (setvar "osmode" 9)
                  (setq pnt (getpoint (list 0.0 0.0 base_height) "\nSelect point : "))
                  (setvar 'OSMODE 0)
                  (vl-cmdf "ucs" "")
                  (if (/= station startstation)
                    (GetPointFromUserUCStoWCS pnt pnt_ucs_station pnt_ucs_station_prev "90")
                    (GetPointFromUserUCStoWCS pnt pnt_ucs_station pnt_ucs_station_next "-90")
                    ) ;_  if
                  (if (= (cdr (assoc 0 numt)) "MTEXT")
                    (progn
                      (GetTextFromMText numt)
                      (princ txt f)
                      (princ "\n")
                      ) ;_  progn 
                    (princ (cdr (assoc 1 numt)) f)
                    ) ;_  if   
                  (princ "," f)
                  (princ (rtos (car a) 2 decimals) f)
                  (princ "," f)
                  (princ (rtos (cadr a) 2 decimals) f)
                  (princ "," f)
                  (princ (rtos (caddr a) 2 decimals) f)
                  (princ "," f)
                  (princ "\n" f)
                  ) ;_  progn
                (if f
                  (close f)
                  ) ;_  if
                ) ;_  if
              ) ;_  progn
            ) ;_  if
          (if (= name "W")
;;; BEZ IMENA TOCKE
            (progn
              (vl-cmdf "ucs" base "")
              (vl-cmdf "ucs" (list 0 (* base_height -1)) "")
              (vl-cmdf "ucs" "x" "-90")
              (setvar "osmode" 9)
              (if (not (setq pnt (getpoint (list 0.0 0.0 base_height) "\nSelect point : ")))
                (setq loop nil)
                ) ;_  if
              (setvar 'OSMODE 0)
              (vl-cmdf "ucs" "")
              (if (/= station startstation)
                (GetPointFromUserUCStoWCS pnt pnt_ucs_station pnt_ucs_station_prev "90")
                (GetPointFromUserUCStoWCS pnt pnt_ucs_station pnt_ucs_station_next "-90")
                ) ;_  if
              (princ (rtos (car a) 2 decimals) f)
              (princ "," f)
              (princ (rtos (cadr a) 2 decimals) f)
              (princ "," f)
              (princ (rtos (caddr a) 2 decimals) f)
              (princ "," f)
              (princ "\n" f)
              ) ;_  progn
            ) ;_  if
          ) ;_  progn
        (if (= coord_type "R")
          (progn
            (vl-cmdf "ucs" base "")
            (vl-cmdf "ucs" (list 0 (* base_height -1)) "")
            (vl-cmdf "ucs" "x" "-90")
            (setvar "osmode" 9)
            (setq pnt (getpoint (list 0.0 0.0 base_height) "\nSelect point : "))
            (princ (strcat (rtos station 2 2)
                           ";"
                           (rtos (car pnt) 2 decimals)
                           "\n"
                           ";"
                           (rtos (caddr pnt) 2 decimals)
                           "\n"
                           ) ;_  strcat
                   f
                   ) ;_  princ
            (vl-cmdf "ucs" "")

            ) ;_  progn
          ) ;_  if
        ) ;_  while
      ) ;_  while loop
    )                                   ;while main  

;;;  (if f
;;;    (close f)
;;;    ) ;_  if
  ) ;_  defun

(princ
  "\nList points from section view..\n...Type LPSV to initiate..."
  ) ;_  princ

                                        ;*********************************************

(defun GetTextFromMText (numt / posto_pos ima)
  (setq txt (cdr (assoc 1 numt)))       ;vadim tekst
  (setq txt (vl-string-right-trim " } " txt)) ;oduzimam desnu } i razmak
  (setq txt (substr txt (+ (vl-string-search ";" txt) 2))) ;oduzimam sve do prvog ;
  (if (= (vl-string-search ";" txt (- (strlen txt) 1)) (- (strlen txt) 1)) ; ako je ; na kraju
    (setq txt (vl-string-right-trim "; " txt)) ;oduzimam desno sve do ;
    ) ;_  if
  (if (= (vl-string-search "{" txt) 0)  ;ako je ostala na prvom mjestu { vadim sve od
    (setq txt (substr txt (vl-string-search ";" txt))) ; prvog ; do kraja
    ) ;_  if
  (if (> (vl-string-search "{" txt) 0)  ;ako je ostala negdje { vadim sve od nje do ;
    (setq txt (strcat (substr txt 1 (vl-string-search "{" txt)) ; i spajam s ostalim
                      (substr txt (+ (vl-string-search ";" txt) 2))
                      ) ;_  strcat
          ) ;_  setq
    ) ;_  if
  (setq txt (vl-string-subst "" "\\S" txt))
  (setq ima T)
  (while ima
    (if (> (setq posto_pos (vl-string-search "%%" txt)) 0)
      (setq txt (strcat (substr txt 1 posto_pos) (substr txt (+ posto_pos 4))))
      (setq ima nil)
      ) ;_  if
    ) ;_  while
  ) ;_  defun

(DEFUN GetPointFromUserUCStoWCS (pnt ucs_base_pnt ucs_direction_pnt ucs_angle / pnttrans_w)
  (vl-cmdf "ucs" "3p" ucs_base_pnt ucs_direction_pnt "")
  (vl-cmdf "ucs" "z" ucs_angle)
  (setq pnttrans_w (trans pnt 1 0))
  (vl-cmdf "ucs" "")
  (setq a (list (car pnttrans_w) (cadr pnttrans_w) (caddr pnttrans_w)))
  ) ;_  DEFUN




                                        ;**************************************************

(DEFUN lm:ssget (MSG PARAMS / SEL)      ;thanx Lee
  (PRINC MSG)
  (SETVAR 'NOMUTT 1)
  (SETQ SEL (VL-CATCH-ALL-APPLY 'SSGET PARAMS))
  (SETVAR 'NOMUTT 0)
  (IF (NOT (VL-CATCH-ALL-ERROR-P SEL))
    SEL
    ) ;_ _ IF
  ) ;_ _ DEFUN

;|«Visual LISP© Format Options»
(120 2 40 1 T " " 100 9 0 0 0 nil T nil T)
;*** DO NOT add text below the comment! ***|;

 

 

Hello. If anyone can help , I'm gong crazy cause I can't get it to loop after selecting some points and pressing SPACE I get 'bad argument type: 2D/3D point: nil' and not looping back to where I wrote in lisp... 

Share this post


Link to post
Share on other sites
devitg

Please upload the sample.dwg where to apply it 

Share this post


Link to post
Share on other sites
Tomislav
1 hour ago, devitg said:

Please upload the sample.dwg where to apply it 

here it is, it's for transferring points from section view to real life coordinates or relative to alignment

OS_STAC_i_PROFILI_tutor.dwg

Share this post


Link to post
Share on other sites

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
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  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...