nerdy stuff - help in optimizing lisp that dimensions room

[Anonymous]

Hi guys:

I am a lisp newbie and just pieced together the following code to help me put room dimensions in multiple rooms. This only works for feet and inches drawings. I was wondering if there is a way to optimize this code... just as a way of learning something new. The curent code works perfectly for my requirements.

Thanks for all the help you can provide.

Best regards,

Akshay

(defun round (num prec) ;; routine to round up or down a number based on precision levels
  (* prec
     (if (minusp num)
       (fix (- (/ num prec) 0.5))
       (fix (+ (/ num prec) 0.5))
     )
  )
)

(defun my-getstring (msg);; routine to not accept a null response for a get string function
(while
(eq ""
(setq response
(vl-string-trim " "
(getstring T msg)
)
)
)
(princ "\nInvalid respose,")
)
response
)

;; below is the main routine. 
(defun c:rmdim(/ *error* var val uvar uval resp ent hpent pt1 pt2 rmname hor ver horft verft horin verin dimtxt)
(defun *error* ( msg )
    (mapcar 'setvar var val)
    (mapcar 'setvar uvar uval)
        (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
            (princ (strcat "\nError: " msg))
        );end if
);end defun error
    (setq var '(cmdecho attreq)
          val  (mapcar 'getvar var)
          uvar '(clayer textsize textstyle)
          uval (mapcar 'getvar uvar)
     ); end setq
(initget "Yes No")
(setq resp (cond ( (getkword "\nDo you want to match text to an entity in drawing?<N>") )( "No" ))) 
(cond
((= resp "No") (princ "\nUsing current text attributes"))
((= resp "Yes") 
    (while
        (not
            (and
                (setq
                    ent (car (entsel "\nPick the text style to match"))
                    hpent (if ent (entget ent))
                ); end setq
                (OR (= (cdr (assoc 0 hpent)) "MTEXT") (= (cdr (assoc 0 hpent)) "TEXT"))
                (= (cdr (assoc 70 (tblsearch "layer" (cdr (assoc 8 hpent))))) 0); on Unlocked Layer
            ); end and
        ); end not
        (prompt "\nNothing selected, or it is not a Text object -- ")
    ); end while
        (progn
            (setvar "clayer" (cdr (assoc 8 hpent)))
            (setvar    "textstyle" (cdr (assoc 7 hpent)))
            (setvar    "textsize" (cdr (assoc 40 hpent)))
            
        );close progn
)
);end cond
(while
 (setq pt1 (getpoint "\nPick first corner:"))
 (setq pt2 (getcorner pt1 "\nPick second corner:"))
 (setq rmname (my-getstring "\nRoom Name: "))
 (setq hor (abs (- (car pt1) (car pt2))))
 (setq ver (abs (- (cadr pt1) (cadr pt2))))
 (setq horft (fix (/ hor 12)))
 (setq verft (fix (/ ver 12)))
 (setq horin (round (rem hor 12) 1))
 (setq verin (round (rem ver 12) 1))
 (if (= horin 12) (progn
            (setq horin 0)
            (setq horft (+ horft 1))
          );end progn
 );endif
 (if (= verin 12) (progn
            (setq verin 0)
            (setq verft (+ verft 1))
          );end progn
 );endif
 (setq dimtxt (strcat rmname "\n" (itoa horft) "'-" (itoa horin) (chr 34) " X " (itoa verft) "'-" (itoa verin) (chr 34)))
 (entmake 
    (list  
        '(0  . "MTEXT")
        (CONS 100 "AcDbEntity")
        (CONS 100 "AcDbMText")
        (CONS 10 pt1)
        (CONS 7 (getvar "textstyle"))
        '(71 . 5)
        (CONS 1 dimtxt)
        ) ;_  end list
    ) ;_  end entmake
(command "move" (entlast) "" pt1 pause)
);end while
(mapcar 'setvar uvar uval)
);end defun rmdim

[ВeekeeCZ]

Just a small observation... Always turn off osnap when you're using command... you can get unexpected results...

(command "move" (entlast) "" "_none" pt1 pause)

(getkword "\nDo you want to match text to an entity in drawing? [Yes/No] <No>: ")  ; common format

(wcmatch (cdr (assoc 0 hpent)) "*TEXT")  ; to replace the OR function

[Anonymous]

Thanks BeeKeeCZ! Will keep that in mind going forward 🙂

[hmsilva]

Should not use 'ver' as a variable, it's a protected symbol...

Henrique

[paullimapa]

I would also place these two functions round & my-getsring making them local only to your defined function c:rmdim and not globally accessible:

(defun round (num prec) ;; routine to round up or down a number based on precision levels
  (* prec
     (if (minusp num)
       (fix (- (/ num prec) 0.5))
       (fix (+ (/ num prec) 0.5))
     )
  )
)

(defun my-getstring (msg);; routine to not accept a null response for a get string function
(while
(eq ""
(setq response
(vl-string-trim " "
(getstring T msg)
)
)
)
(princ "\nInvalid respose,")
)
response
)

Area Object Link | Attribute Modifier | Dwg Setup | Feet-Inch Calculator
Layer Apps | List on Steroids | VP Zoom Scales | Exchange App Store

[Anonymous]

Hi Pli:

the my-getstring works very well with other interactive lisps that I am working on. Any particular reason to make them local to this specific routine?

Also, how do i make them local?

-Akshay

[paullimapa]

O, if you're sharing my-getstring function with others, then there's no need to make it local only to this function.  In the case of making functions globally available to other routines, you may want to adopt a naming convention that will be specific to your lisp coding so that it won't conflict with other 3rd party functions.  In your case, perhaps anything starting with these 3 characters "my-" would work.

As to making a function local, just place it inside your (defun c:rmdim code. A good example is the *error* function which is placed within (defun c:rmdim

(defun *error* ( msg )
(mapcar 'setvar var val)
(mapcar 'setvar uvar uval)
(if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
(princ (strcat "\nError: " msg))
);end if
);end defun error

Then to complete the process declare it within the parentesis as shown in your code:(defun c:rmdim(/ *error* .

Area Object Link | Attribute Modifier | Dwg Setup | Feet-Inch Calculator
Layer Apps | List on Steroids | VP Zoom Scales | Exchange App Store

[ВeekeeCZ]

... one more. Why this (if) construction?

 (while
       (not
	 (and
	   (setq
	     ent (car (entsel "\nPick the text style to match"))
	     hpent (if ent (entget ent))
	     ); end setq

Just let the AND function do its work or use the (initget) function.

(while (not (and (setq ent (car (entsel "\nPick the text style to match: ")))
		 (setq hpent (entget ent))
		 (wcmatch (cdr (assoc 0 hpent)) "*TEXT")
		 ...

(while (not (and (not (initget 1))
		 (setq ent (car (entsel "\nPick the text style to match: "))
		       hpent (entget ent))
		 (wcmatch (cdr (assoc 0 hpent)) "*TEXT")
		 ...

[Anonymous]

Got it... the initget function makes more sense. Thanks once again!