need help with creating internal lisp that handle defaults for the main lisp

January 11, 2023

Hi.

I have a lisp that ask the user to set a number of default values before executing the code.

I'm looking for a way to put those steps in a sub-lisp inside the main one,and when the lisp start the user is prompt to choose if to continue to the main lisp with the existing defaults or to go to "settings",change them and go back to the main lisp and finish the task.

I've marked where the defaults end with this text: ";;;;;;;;;;;;;;;;;;;;end defaults;;;;;;;;;;;;;;;;"

this is the lisp that I'm trying to modify:

;;------------------------------------ DIMLP.LSP - label lines (Pipes) with detailed layer name---------------------------------;;

;; fixo () 2012 * all rights released
;; edited 3/3/12

;; label lines (Pipes) with layer name

(defun C:DIMLPDET_UPDATE(/ *error* acsp adoc ang curve deriv en mid mp ppt1 ppt2 prex sset txh txt txt1 txt2 txtln txtpt1 insut LAYERNAME offst pipetype pipepn a theMText dcpr RP MinLen)

(vl-load-com)

(setq mspace (vla-get-modelspace 
                 (vla-get-activedocument 
                      (vlax-get-acad-object))))  


    (defun *error* (msg)
      (vla-endundomark (vla-get-activedocument
              (vlax-get-acad-object))
	      )
    (cond ((or (not msg)
	       (member msg '("console break" "Function cancelled" "quit / exit abort"))
	       )
	   )
	  ((princ (strcat "\nError: " msg)))
	  )

    (princ)
    )

  (initget "Current Pipe")
    (if (null (setq YN (getkword "\nChoose Text Layer [Current/Pipe] <Pipe>: ")))
    (setq YN "Pipe")
  )

  (initget "Yes No")
    (if (null (setq Bg (getkword "\nAdd Text Background [Yes/No] <No>: ")))
    (setq Bg "No")
  )

  (setq ht (getreal "\nSet Length factor (If Drawing Units mm-Set 1000, If Drawig Units m-Set 1)<1>: "))
    (if (= ht nil)
      (setq ht (atof "1"))
  )

  (initget "Yes No")
    (if (null (setq RP (getkword "\nRound Pipe Length? [Yes/No] <Yes>: ")))
    (setq RP "Yes")
  )

;  (setq dcpr (getint "\nSet Decimal Precision <0>: "))
;    (if (= dcpr nil)
;      (setq dcpr (atoi "0"))
;  )

  (setq ht (/ 1 ht))

  (setq txh1 (getreal "\nEnter text height<2>: "))
  (if (= txh1 nil)
    (setq txh1 2)
  )

  (setq pipetype (getstring T "\nPipe Type<PVC PIPE>: "))
   (if (= pipetype "")
     (setq pipetype "PVC PIPE")
   )

  (setq MinLen (getreal "\nSet Min. Length To Calc<5.0>: "))
  (if (= MinLen nil)
    (setq MinLen 5)
  )
  (setq a (substr " " 1 1))
  (setq pipetype (strcat  pipetype a))
 
;  (setq pipepn (strcase (getstring "\nPipe Type</6>: ")))
;   (if (= pipepn "")
;     (setq pipepn "/6")
;   )

;;;;;;;;;;;;;;;;;;;;end defaults;;;;;;;;;;;;;;;;

(setq offst (/ txh1 2)) 
(setq insut (getvar "insunits"))
 
(setq adoc (vla-get-activedocument
              (vlax-get-acad-object))
      acsp (vla-get-block(vla-get-activelayout adoc)))
  

  (vla-startundomark adoc )
  
  (setq txh txh1

    
      prex (getvar "dimdec")

      )
  
(while (not sset)
  
    (setq sset (ssget '((0 . "*LINE")))
	  
	  )
  )
  
(while (setq en (ssname sset 0))
  
  (setq curve (vlax-ename->vla-object en))
  
  ;;(setq txt1 (rtos (vla-get-length curve) 2 2))

  (setq txtln (if (= (getvar "measurement") 0)
	      
	      (rtos (vla-get-length curve) 3 2)
	      
	      (rtos (vla-get-length curve) 2 2))
                 )

  (setq txtln (atof txtln))

(if (> txtln MinLen) ;; start if minimum length
 (progn  ;; start progn minimum length

(if (= RP "Yes")
 (progn
      (if 
          (< 0.5 (rem txtln 1))
            (setq txtln (+ txtln 1))
      )
    (setq txtln (fix txtln))
    (setq txtln (rtos (* txtln ht) 2 0))
  )
 (setq txtln (rtos (* txtln ht) 2 2))
)

  (setq LAYERNAME (vla-get-layer curve)) 
  (setq mid (/ (abs (- (vlax-curve-getendparam curve)
                           (vlax-curve-getstartparam curve))) 2.)
	
	mp (vlax-curve-getpointatparam curve mid)

	deriv  (vlax-curve-getfirstderiv
		 curve
		 (vlax-curve-getparamatpoint curve mp))
	)

  (if (zerop (cadr deriv))
    (setq ang 0)
    (setq ang (- (/ pi 2) (atan (/ (car deriv) (cadr deriv)))))
    )

    (if (< (/ pi 2) ang (* pi 1.5))
    (setq ang (+ pi ang))
    )
;;;  (setq ppt1 (polar mp (+ ang (/ pi 2)) (* txh 0.5))
;;;	)
  (setq ppt1 (polar mp (+ ang (/ pi 2)) offst)
	)



  (setq txtpt1  (vlax-3d-point (trans ppt1 1 0)))

;;;  (setq txt1 (vla-addtext acsp txt txtpt1 txh))

  ;(setq txt (strcat LAYERNAME pipepn))
  (setq txt (strcat LAYERNAME " L=" (strcat txtln "m")))
  (setq txt (vl-string-subst pipetype "P_" txt))
  (setq txt (vl-string-subst "/" "-" txt))

(setq theMText (vla-AddMText mspace txtpt1 (atof "0") txt))
(vla-put-AttachmentPoint theMText acBottomCenter)
;;(vla-put-alignment theMText acAlignmentBottomCenter)
;;(vla-put-textalignmentpoint theMText txtpt1)
;;(vla-put-insertionpoint theMText (vla-get-textalignmentpoint theMText))
(vla-put-rotation theMText ang)
(vla-put-Height theMText txh)


(if (= Bg "Yes")
	(progn
              		(vla-put-backgroundfill theMText :vlax-true)
		(setq dxf_ent (entget (entlast)))
		(entmod (append dxf_ent '((90 . 1) (63 . 254) (45 . 1.1) (441 . 0))))
	)
)

 (if (= YN "Pipe")
    (vlax-put-property theMText 'layer LAYERNAME)
 )



  ;(setq txt1 (vla-addtext acsp txt txtpt1 txh))
 
  ;(vla-put-alignment txt1 acAlignmentBottomCenter)
  
  ;(vla-put-textalignmentpoint txt1 txtpt1)
  
  ;(vla-put-insertionpoint txt1 (vla-get-textalignmentpoint txt1))
  
 ; (vla-put-rotation txt1 ang)

 ;(if (= YN "Pipe")
;     (vlax-put-property txt1 'layer LAYERNAME)
;  )

);; end progn minimum length
);; end if minimum length             
(ssdel en sset)

  )

  (*error* nil)
 
  (princ)
  )
(princ "\n\t---\tStart command with \"DIMLPDET\"\t---")
(princ)
(or (vl-load-com)
    (princ))
;;------------------------------------ code end ----------------------------------;;

thanks,

aridzv.

Edited January 11, 2023 by aridzv

January 12, 2023

So you could do this with an if statement

(if.. user wants defaults

(progn

do stuff

)

... continue

but that isn't what you were asking.

You can just write a LISP within a LISP and it should work: Usually these sub routines are defined at the top of the LISP

(defun Lisp1 ( / )

(defun LISP2 ( / )

do stuff 2

) ; end LISP 2

Do stuff

Call LISP2

Do more stuff

) ; end

As an example

(defun c:MyLISP ( / A B C)
  (defun LISPA ( Z / D) ; define LISPA
    (Princ Z)           ; Do stuff
    (setq D "\nDone LISPA")
    D                   ; return D
  )

  (setq A "Running LISPA")
  (setq B (LISPA A))   ; run LISPA, set B to be what LISPA returns (not necessary if it doesn't do that)
  (princ B)

  (setq A "\nDoing it again")
  (setq B (LISPA A))
  (princ B)

  (princ)

) ; End MyLISP

Edited January 12, 2023 by Steven P

January 12, 2023

You could try this:

I made a bunch of global variables. They get set to the default.

COMMAND sadv runs a function that asks you to set the values.

You can run this once if you want. Those values are remembered as long as the file is open.

;;------------------------------------ DIMLP.LSP - label lines (Pipes) with detailed layer name---------------------------------;;

;; fixo () 2012 * all rights released
;; edited 3/3/12

;; label lines (Pipes) with layer name


;;;;;;;;;;;;;;;;;;;;;
;; global variables, defaults

(setq globalvar_YN "Pipe")
(setq globalvar_Bg "No")
(setq globalvar_ht (atof "1"))
(setq globalvar_RP "Yes")
(setq globalvar_txh1 2)
(setq globalvar_MinLen 5)
	(setq a (substr " " 1 1))
(setq globalvar_pipetype "PVC PIPE")	
(setq globalvar_pipetype (strcat  globalvar_pipetype a))

	
;; setq a bunch of global variables, as variables.
(defun setDefaults	( / YN Bg ht RP txh1 MinLen pipetype)
	  (initget "Current Pipe")
	  (if (null (setq YN (getkword "\nChoose Text Layer [Current/Pipe] <Pipe>: ")))
		(setq YN "Pipe")
	  )

	  (initget "Yes No")
	  (if (null (setq Bg (getkword "\nAdd Text Background [Yes/No] <No>: ")))
		(setq Bg "No")
	  )

	  (setq ht (getreal "\nSet Length factor (If Drawing Units mm-Set 1000, If Drawig Units m-Set 1)<1>: "))
		(if (= ht nil)
		  (setq ht (atof "1"))
	  )

	  (initget "Yes No")
		(if (null (setq RP (getkword "\nRound Pipe Length? [Yes/No] <Yes>: ")))
		(setq RP "Yes")
	  )

	;  (setq dcpr (getint "\nSet Decimal Precision <0>: "))
	;    (if (= dcpr nil)
	;      (setq dcpr (atoi "0"))
	;  )

	  (setq ht (/ 1 ht))

	  (setq txh1 (getreal "\nEnter text height<2>: "))
	  (if (= txh1 nil)
		(setq txh1 2)
	  )

	  (setq pipetype (getstring T "\nPipe Type<PVC PIPE>: "))
	   (if (= pipetype "")
		 (setq pipetype "PVC PIPE")
	   )

	  (setq MinLen (getreal "\nSet Min. Length To Calc<5.0>: "))
	  (if (= MinLen nil)
		(setq MinLen 5)
	  )
	  (setq a (substr " " 1 1))
	  (setq pipetype (strcat  pipetype a))
	 
	;  (setq pipepn (strcase (getstring "\nPipe Type</6>: ")))
	;   (if (= pipepn "")
	;     (setq pipepn "/6")
	;   )
	
	;; copy these default values to global vars
	(setq globalvar_YN YN)
	(setq globalvar_Bg Bg)
	(setq globalvar_ht ht)
	(setq globalvar_RP RP)
	(setq globalvar_txh1 txh1)
	(setq globalvar_MinLen MinLen)
	(setq globalvar_pipetype pipetype)

	
)

(defun c:sadv ( / )
	(setDefaults)
	(princ)
)

(defun C:DIMLPDET_UPDATE(/ *error* acsp adoc ang curve deriv en mid mp ppt1 ppt2 prex sset txh txt txt1 txt2 txtln txtpt1 insut LAYERNAME offst pipetype pipepn a theMText dcpr RP MinLen)

(vl-load-com)

(setq mspace (vla-get-modelspace 
                 (vla-get-activedocument 
                      (vlax-get-acad-object))))  


    (defun *error* (msg)
		(vla-endundomark (vla-get-activedocument
              (vlax-get-acad-object))
	    )
		(cond ((or (not msg)
			   (member msg '("console break" "Function cancelled" "quit / exit abort"))
			   )
			)
			((princ (strcat "\nError: " msg)))
		)
	   (princ)
    )

	;; copy the global vars values to local vars defaults
	(setq YN globalvar_YN)
	(setq Bg globalvar_Bg)
	(setq ht globalvar_ht)
	(setq RP globalvar_RP)
	(setq txh1 globalvar_txh1)
	(setq MinLen globalvar_MinLen)
	(setq pipetype globalvar_pipetype)


;;;;;;;;;;;;;;;;;;;;end defaults;;;;;;;;;;;;;;;;

	(setq offst (/ txh1 2)) 
	(setq insut (getvar "insunits"))
 
	(setq adoc (vla-get-activedocument
              (vlax-get-acad-object))
      acsp (vla-get-block(vla-get-activelayout adoc)))
  

  (vla-startundomark adoc )
  
  (setq txh txh1

    
      prex (getvar "dimdec")

      )
  
	(while (not sset)
		(setq sset (ssget '((0 . "*LINE"))))
	)
  
(while (setq en (ssname sset 0))
  
  (setq curve (vlax-ename->vla-object en))
  
  ;;(setq txt1 (rtos (vla-get-length curve) 2 2))

  (setq txtln (if (= (getvar "measurement") 0)
	      
	      (rtos (vla-get-length curve) 3 2)
	      
	      (rtos (vla-get-length curve) 2 2))
                 )

  (setq txtln (atof txtln))

(if (> txtln MinLen) ;; start if minimum length
 (progn  ;; start progn minimum length

(if (= RP "Yes")
 (progn
      (if 
          (< 0.5 (rem txtln 1))
            (setq txtln (+ txtln 1))
      )
    (setq txtln (fix txtln))
    (setq txtln (rtos (* txtln ht) 2 0))
  )
 (setq txtln (rtos (* txtln ht) 2 2))
)

  (setq LAYERNAME (vla-get-layer curve)) 
  (setq mid (/ (abs (- (vlax-curve-getendparam curve)
                           (vlax-curve-getstartparam curve))) 2.)
	
	mp (vlax-curve-getpointatparam curve mid)

	deriv  (vlax-curve-getfirstderiv
		 curve
		 (vlax-curve-getparamatpoint curve mp))
	)

  (if (zerop (cadr deriv))
    (setq ang 0)
    (setq ang (- (/ pi 2) (atan (/ (car deriv) (cadr deriv)))))
    )

    (if (< (/ pi 2) ang (* pi 1.5))
    (setq ang (+ pi ang))
    )
;;;  (setq ppt1 (polar mp (+ ang (/ pi 2)) (* txh 0.5))
;;;	)
  (setq ppt1 (polar mp (+ ang (/ pi 2)) offst)
	)



  (setq txtpt1  (vlax-3d-point (trans ppt1 1 0)))

;;;  (setq txt1 (vla-addtext acsp txt txtpt1 txh))

  ;(setq txt (strcat LAYERNAME pipepn))
  (setq txt (strcat LAYERNAME " L=" (strcat txtln "m")))
  (setq txt (vl-string-subst pipetype "P_" txt))
  (setq txt (vl-string-subst "/" "-" txt))

(setq theMText (vla-AddMText mspace txtpt1 (atof "0") txt))
(vla-put-AttachmentPoint theMText acBottomCenter)
;;(vla-put-alignment theMText acAlignmentBottomCenter)
;;(vla-put-textalignmentpoint theMText txtpt1)
;;(vla-put-insertionpoint theMText (vla-get-textalignmentpoint theMText))
(vla-put-rotation theMText ang)
(vla-put-Height theMText txh)


(if (= Bg "Yes")
	(progn
        (vla-put-backgroundfill theMText :vlax-true)
		(setq dxf_ent (entget (entlast)))
		(entmod (append dxf_ent '((90 . 1) (63 . 254) (45 . 1.1) (441 . 0))))
	)
)

 (if (= YN "Pipe")
    (vlax-put-property theMText 'layer LAYERNAME)
 )



  ;(setq txt1 (vla-addtext acsp txt txtpt1 txh))
 
  ;(vla-put-alignment txt1 acAlignmentBottomCenter)
  
  ;(vla-put-textalignmentpoint txt1 txtpt1)
  
  ;(vla-put-insertionpoint txt1 (vla-get-textalignmentpoint txt1))
  
 ; (vla-put-rotation txt1 ang)

 ;(if (= YN "Pipe")
;     (vlax-put-property txt1 'layer LAYERNAME)
;  )

);; end progn minimum length
);; end if minimum length             
(ssdel en sset)

  )

  (*error* nil)
 
  (princ)
  )
(princ "\n\t---\tStart command with \"DIMLPDET\"\t---")
(princ)
(or (vl-load-com)
    (princ))
;;------------------------------------ code end ----------------------------------;;

January 12, 2023

@Emmanuel Delay

the second one is BRILLIANT!!

thanks!!

January 12, 2023

@Emmanuel Delay

one small thing:

in the "global variables, defaults" part I've changed the text size default from fixed 2 to the current draing textsize var:

(setq globalvar_txh1 (getvar "TEXTSIZE"))
;;(setq globalvar_txh1 2)

January 12, 2023

One minor thing.

(setq globalvar_ht (atof "1")) = (setq globalvar_ht 1)

Also wouldn't hurt to put a decimal point on the variables with numbers especially if your going to use them in calculations.

(setq globalvar_ht 1.0)

Example:

(defun C:test (/ x)
  (setq x 100) ;integer
  (setq x (/ x 6))
  (princ x)
  (prompt (strcat "\n" (rtos x 2 5) "\n"))
  (setq x 100.0) ;double
  (setq x (/ x 6))
  (princ x)
  (princ)
)

Edited January 12, 2023 by mhupp

January 13, 2023

@mhupp

your last comment raise an issue that bugs me for some time:

1. when seting a var with number (like you wrote above - (setq x 100) ;integer) - lisp recodnize it as int and not as string, and the same for "setq x 100.0) ;double" - it is recodnized as real and not string?

2. what is the type of system variables when returned from acad (when using "(getvar TEXTSIZE)" for example)?

are they real (since they accept decimal values)?

Edited January 13, 2023 by aridzv

January 13, 2023

(setq x "100")  ;string
(setq x 100)    ;integer
(setq x 100.0)  ;double or real number

math with two integers will only produce an integer

(/ 3 2) = 1

math with an integer and real will produce a real number

(/ 3 2.0) = 1.5

Why I called it double

Quote

Real numbers are stored in double-precision floating-point format, providing at least 14 significant digits of precision. Note that AutoLISP does not show you all the significant digits.

2. Most system variables are stored as real numbers it just depends on what variable it is. like cmdecho is either 1 or 0 on/off so that is just an integer.

but textsize is stored as a real number.

Edited January 13, 2023 by mhupp

January 13, 2023

so is this correct?

(setq aa (getvar "TEXTSIZE")) ;; aa is a real number?
(setq bb (getvar "cmdecho")) ;; bb is int?

Edited January 13, 2023 by aridzv

January 13, 2023

Might be different in other software but in BricsCAD yes. you can always test with (type variable)

(defun C:test (/ aa bb)
  (setvar 'textsize 2)
  (setq aa (getvar "TEXTSIZE")) ;; aa is a real number?
  (setq bb (getvar "cmdecho")) ;; bb is int
  (prompt "\naa is ")
  (princ (type aa))
  (prompt "\nbb is ")
  (princ (type bb))
)

Sign In

need help with creating internal lisp that handle defaults for the main lisp

Recommended Posts

aridzv

Steven P

Emmanuel Delay

aridzv

aridzv

mhupp

aridzv

mhupp

aridzv

mhupp

Join the conversation

Tutorials

Forums

Activity