« previous next »
Pages: [1] |   Go Down

Author Topic: Recall last input  (Read 2224 times)

0 Members and 1 Guest are viewing this topic.

milanp

  • Newt
  • Posts: 35
Recall last input
« on: November 05, 2018, 02:03:51 PM »
Can somebody help me with this code. The default value is 1000 and everything works properly, but I would like to be offered the last entered value. Do you have any suggestions for modification? Thanks  :roll:


Code: [Select]
(defun C:skarpe (/ Gornja Donja Pitanje Razmera Razmera_totaal count p1 p2 boja)

 (command "layer" "make" "Skarpe" "color" "8" "Skarpe" "")

  (defun IS-ON-PL? (ENAME PKT /)
    (vl-catch-all-apply
      'vlax-curve-getdistatpoint
      (list
        ENAME
        PKT
        ) ;_ end of list
      ) ;_ end of vlax-curve-getDistAtPoint
    PKT
    ) ;_ end defun

(vl-load-com)

(initget "1000 500 2500")
(setq Pitanje (cond ((getreal (strcat "\n Odaberi Razmeru 1:[1000/500/2500] <"(itoa (cond (Pitanje)((setq Pitanje 1000))))">: ")))(Pitanje)))
(if (= Pitanje 1000)
    (setq Razmera 1)) 
(if (= Pitanje 500)
    (setq Razmera 0.5))
(if (= Pitanje 2500)
(setq Razmera 2.5))
  (if (and (setq Gornja (car (entsel "\nSelektuj gornju povrsinu: ")))
           (setq Donja (car (entsel "\nSelektuj donju povrsinu: "))) 
           (setq boja 256))
    (progn
      (setq Razmera_totaal 0)
      (setq count 0)
      (setq p1 (vlax-curve-getStartPoint
                 (vlax-ename->vla-object Gornja)
                 ) ;_ end of vlax-curve-getStartPoint
            ) ;_ end of setq
      (while p1
        (if (equal (/ count 2.0) (fix (/ count 2.0)) 0.001)
          (setq p2
                 (vlax-curve-getClosestPointTo
                   (vlax-ename->vla-object Donja)
                   p1
                   ) ;_ end of vlax-curve-getClosestPointTo
                ) ;_ end of setq
          (setq
            p2 (MAPCAR '(LAMBDA (x) (/ x 2))
                       (MAPCAR '+
                               p1
                               (vlax-curve-getClosestPointTo
                                 (vlax-ename->vla-object Donja)
                                 p1
                                 ) ;_ end of vlax-curve-getClosestPointTo
                               ) ;_ end of MAPCAR
                       ) ;_ end of MAPCAR
            ) ;_ end of setq
          ) ;_ end of if
        (entmake
          (list '(0 . "LINE")
                (cons 10 p1)
                (cons 11 p2)
                ;'(62 . 1) ; standaard boja
                (cons 62 boja) ; boja dia dialog instellen

          ) ;_ end of list
        ) ;_ end of entmake
        (if
          (setq p1 (IS-ON-PL?
                     (vlax-ename->vla-object Gornja)
                     (vlax-curve-getpointatdist
                       (vlax-ename->vla-object Gornja)
                       (setq Razmera_totaal (+ Razmera_totaal Razmera))
                       ) ;_ end of vlax-curve-getpointatdist
                     ) ;_ end of IS-ON-PL?
                ) ;_ end of setq
           p1
           ) ;_ end of if
        (setq count (1+ count))
        ) ;_ end of while
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun

Logged

ronjonp

  • Needs a day job
  • Posts: 7529
Re: Recall last input
« Reply #1 on: November 05, 2018, 03:35:48 PM »
Give this a try:
Code - Auto/Visual Lisp: [Select]
  1. (defun c:skarpe (/ gornja donja pitanje razmera razmera_totaal count p1 p2 boja)
  2.   (command "layer" "make" "Skarpe" "color" "8" "Skarpe" "")
  3.   (defun is-on-pl? (ename pkt /)
  4.     (vl-catch-all-apply
  6.       (list ename pkt) ;_ end of list
  7.     ) ;_ end of vlax-curve-getDistAtPoint
  8.     pkt
  9.   ) ;_ end defun
  11.   ;; Get or set default
  12.   (setq pitanje (cond ((getenv "skarpe"))
  13.                       ((setenv "skarpe" "1000"))
  14.                 )
  15.   )
  16.   (initget "1000 500 2500")
  17.   (setq pitanje (cond ((getkword (strcat "\n Odaberi Razmeru 1:[1000/500/2500] <" pitanje ">: ")))
  18.                       (pitanje)
  19.                 )
  20.   )
  21.   (setq razmera (/ (atof pitanje) 1000.))
  22.   (if (and (setq gornja (car (entsel "\nSelektuj gornju povrsinu: ")))
  23.            (setq donja (car (entsel "\nSelektuj donju povrsinu: ")))
  24.            (setq boja 256)
  25.       )
  26.     (progn
  27. ;; Write default
  28.       (setenv "skarpe" pitanje)
  29.            (setq razmera_totaal 0)
  30.            (setq count 0)
  31.            (setq p1 (vlax-curve-getstartpoint (vlax-ename->vla-object gornja)) ;_ end of vlax-curve-getStartPoint
  32.            ) ;_ end of setq
  33.            (while p1
  34.              (if (equal (/ count 2.0) (fix (/ count 2.0)) 0.001)
  35.                (setq p2 (vlax-curve-getclosestpointto (vlax-ename->vla-object donja) p1) ;_ end of vlax-curve-getClosestPointTo
  36.                ) ;_ end of setq
  37.                (setq
  38.                  p2 (mapcar '(lambda (x) (/ x 2))
  39.                             (mapcar '+
  40.                                     p1
  41.                                     (vlax-curve-getclosestpointto (vlax-ename->vla-object donja) p1) ;_ end of vlax-curve-getClosestPointTo
  42.                             ) ;_ end of MAPCAR
  43.                     ) ;_ end of MAPCAR
  44.                ) ;_ end of setq
  45.              ) ;_ end of if
  46.              (entmake (list '(0 . "LINE")
  47.                             (cons 10 p1)
  48.                             (cons 11 p2) ;'(62 . 1) ; standaard boja
  49.                             (cons 62 boja) ; boja dia dialog instellen
  50.                       ) ;_ end of list
  51.              ) ;_ end of entmake
  52.              (if (setq p1 (is-on-pl? (vlax-ename->vla-object gornja)
  53.                                      (vlax-curve-getpointatdist
  54.                                        (vlax-ename->vla-object gornja)
  55.                                        (setq razmera_totaal (+ razmera_totaal razmera))
  56.                                      ) ;_ end of vlax-curve-getpointatdist
  57.                           ) ;_ end of IS-ON-PL?
  58.                  ) ;_ end of setq
  59.                p1
  60.              ) ;_ end of if
  61.              (setq count (1+ count))
  62.            ) ;_ end of while
  63.     ) ;_ end of progn
  64.   ) ;_ end of if
  65. ) ;_ end of defun
Logged

Windows 11 x64 - AutoCAD /C3D 2023
Custom Build PC

ribarm

  • Gator
  • Posts: 3272
  • Marko Ribar, architect
Re: Recall last input
« Reply #2 on: November 05, 2018, 03:40:06 PM »
Ovo treba ovako - po mom misljenju... Ali ova sub funkcija i nije potrebna - vidi poslednju liniju ukupne rutine (setq p1 (getpointatdist ... ))
;;(IS-ON-PL? ENAME PKT) => PKT - point is on curve or nil - point isn't on curve
  (defun IS-ON-PL? (ENAME PKT)
    (if (vlax-curve-getdistatpoint ENAME PKT)
      PKT
    )
  )

Ovo je uredu... Ali Pitanje varijabla treba da bude globalna, znaci izbaci je iz prve linije (defun C:skarpe (/ Gornja Donja Pitanje Razmera Razmera_total count p1 p2 boja)
  (setq Pitanje
    (cond
      ( (getint
          (strcat "\n Odaberi Razmeru 1:[1000/500/2500] <"
            (itoa
              (cond
                (Pitanje)
                ( (setq Pitanje 1000) )
              )
            )">: "
          )
        )
      )
      (Pitanje)
    )
  )

Ovo treba ovako - po mom misljenju - treba check-irati da li je pored pick-ovanja entitet kriva - curve...
  (if (and (setq Gornja (car (entsel "\nSelektuj gornju povrsinu: ")))
           (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartpoint (list Gornja))))
           (setq Donja (car (entsel "\nSelektuj donju povrsinu: ")))
           (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartpoint (list Donja))))
           (setq boja 256))

Dovoljno je :
      (setq p1 (vlax-curve-getStartPoint
                 Gornja
                 ;;; (vlax-ename->vla-object Gornja) - nepotrebna koverzija ename->vla-object - vlax-curve-xxx funkcije rade brze i efikasnije sa ename argumentom
               ) ;_ end of vlax-curve-getStartPoint
      ) ;_ end of setq

Znaci otprilike ovako bi izgledala kompletna rutina po mom misljenju koliko toliko kvalitetnija...

Code: [Select]
(defun c:skarpe ( / Gornja Donja Razmera Razmera_total count p1 p2 boja )

  (vl-load-com)

  (vl-cmdf "_.LAYER" "_M" "Skarpe" "_C" "8" "Skarpe" "")

  (initget "1000 500 2500")
  (setq Pitanje
    (cond
      ( (getint
          (strcat "\n Odaberi Razmeru 1:[1000/500/2500] <"
            (itoa
              (cond
                (Pitanje)
                ( (setq Pitanje 1000) )
              )
            )">: "
          )
        )
      )
      (Pitanje)
    )
  )
  (cond
    ( (= Pitanje 1000)
      (setq Razmera 1)
    )
    ( (= Pitanje 500)
      (setq Razmera 0.5)
    )
    ( (= Pitanje 2500)
      (setq Razmera 2.5)
    )
  )
  (if (and (setq Gornja (car (entsel "\nSelektuj gornju povrsinu: ")))
           (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartpoint (list Gornja))))
           (setq Donja (car (entsel "\nSelektuj donju povrsinu: ")))
           (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartpoint (list Donja))))
           (setq boja 256)
      )
    (progn
      (setq Razmera_total 0)
      (setq count 0)
      (setq p1 (vlax-curve-getStartPoint Gornja))
      (while p1
        (if (= (rem count 2) 0)
          (setq p2 (vlax-curve-getClosestPointTo Donja p1))
          (setq p2 (mapcar '(lambda ( x ) (/ x 2)) (mapcar '+ p1 (vlax-curve-getClosestPointTo Donja p1))))
        )
        (entmake
          (list
               '(0 . "LINE")
                (cons 10 p1)
                (cons 11 p2)
                ;'(62 . 1) ; standard boja
                (cons 62 boja) ; boja 256 - ByLayer
          )
        )
        (setq p1 (vlax-curve-getpointatdist Gornja (setq Razmera_total (+ Razmera_total Razmera))))
        (setq count (1+ count))
      )
    )
  )
  (princ)
)

HTH., M.R.
« Last Edit: November 06, 2018, 01:15:56 AM by ribarm »
Logged
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

milanp

  • Newt
  • Posts: 35
Re: Recall last input
« Reply #3 on: November 05, 2018, 04:08:34 PM »
I tried the lisp that ronjonp attached and everything works perfectly! Thanks a lot!

Marko hvala na detaljnom objasnjenju. Probao sam da ubacim tvoje resenje, ali nesto ne funkcionise kako treba. Radilo je sve ok, ali kad sam manuelno uneo vrednost (500) funkcija je u narednoj iteraciji prestala sa radom i vise nije htela da se pokrene (error: bad argument type: fixnump: 500.0).  Hvala jos jednom na pomoci. Pozdav!
Logged

Lee Mac

  • Seagull
  • Posts: 12913
  • London, England
Re: Recall last input
« Reply #4 on: November 05, 2018, 04:49:32 PM »
If you simply remove 'Pitanje' from the list of declared local variables, your original code would have remembered the last entered value within the current drawing session.
Logged

ribarm

  • Gator
  • Posts: 3272
  • Marko Ribar, architect
Re: Recall last input
« Reply #5 on: November 05, 2018, 11:22:06 PM »
Quote from: milanp on November 05, 2018, 04:08:34 PM
Marko hvala na detaljnom objasnjenju. Probao sam da ubacim tvoje resenje, ali nesto ne funkcionise kako treba. Radilo je sve ok, ali kad sam manuelno uneo vrednost (500) funkcija je u narednoj iteraciji prestala sa radom i vise nije htela da se pokrene (error: bad argument type: fixnump: 500.0).  Hvala jos jednom na pomoci. Pozdav!

Pa zar ti to ne ukazuje da treba da koristis (getint) umesto (getreal), jer kasnije imas funkciju (itoa) - integer to ascii... Evo ispravio sam moju reviziju. Nadam se da je sada u redu... Inace kao sto Lee rece, pod uslovom da je sve ispravno bilo napisano, samo bi trebalo da se izbaci varijabla "Pitanje" iz lokalizacije...
Logged
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

milanp

  • Newt
  • Posts: 35
Re: Recall last input
« Reply #6 on: November 06, 2018, 05:22:17 PM »
Radi sve super. Hvala na ispravci
Logged
Pages: [1] |   Go Up
« previous next »