Jump to content

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

aridzv

By aridzv
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

aridzv Community Regular

aridzv

Posted
Posted (edited)

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 by aridzv
Link to comment
Share on other sites
Steven P Grand Master

Steven P

Posted
Posted (edited)

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 by Steven P
  • Like 1
Link to comment
Share on other sites
Emmanuel Delay Proficient

Emmanuel Delay

Posted
Posted

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

 

  • Like 1
  • Thanks 1
Link to comment
Share on other sites
aridzv Community Regular

aridzv

Posted
  • Author
Posted

@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)

 

  • Like 1
Link to comment
Share on other sites
mhupp Grand Master

mhupp

Posted
Posted (edited)

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 by mhupp
  • Like 1
Link to comment
Share on other sites
aridzv Community Regular

aridzv

Posted
  • Author
Posted (edited)

@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 by aridzv
Link to comment
Share on other sites
mhupp Grand Master

mhupp

Posted
Posted (edited) 
(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 by mhupp
  • Thanks 1
Link to comment
Share on other sites
aridzv Community Regular

aridzv

Posted
  • Author
Posted (edited)

so is this correct? 

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

 

Edited by aridzv
  • Like 1
Link to comment
Share on other sites
mhupp Grand Master

mhupp

Posted
Posted

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

 

image.png.ed4db39f8ac845caf602cb75f036f56e.png

  • Thanks 1
Link to comment
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
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  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.

×
 Share
Go to topic listing
×
×
  • Create New...