code for measure command

[ryan sen]

I m very new to AutoCAD VBA, although I have some knowlege of programming in VB 6.0 and know AutoCAD well enough. Is it possible to do 'measure' command using AutoCAD VBA.

[BIGAL]

You should be able to acces any autocad command

ThisDrawing.SendCommand "measure" & vbCr

 

If you know pick point and distance then add to above with & vbCr

 

It would probably be better though to have a look here for numerous examples of "measuring" (distance along pline) as more than likely you will want something smarter and more complex at a later date.

[ryan sen]

Hi Bigal, I searched for a few codes that sounded similar to 'measure'. I think I would need this kind of a code as given below:

 

(defun div-error (msg)
(if
(vl-position
msg
'("console break"
"Function cancelled"
"quit / exit abort"
)
)
(princ "Error!")
(princ msg)
)
(while (> (getvar "cmdactive") 0) (command))
(command "._undo" "_end")
(command "._u")
(setq *error* olderror)
(princ)
)
(defun divplus (len segm / num lst)
(setq num (fix (/ len segm)))
(setq cnt 0)
(while (<= cnt num)
(setq tmp (* cnt segm))
(setq lst (append lst (list tmp)))
(setq cnt (1+ cnt))
)
(setq delta (- len (last lst)))
(if (/= delta 0.)
(setq lst (append lst (list (+ (last lst) delta))))
lst
)
)
(defun divminus (len segm / lst)
(while (>= len 0.)
(setq lst (append lst (list len)))
(setq len (- len segm))
)
(if (not (zerop (last lst)))
(setq lst (append lst (list 0.0)))
)
lst
)
(vl-load-com)
(prompt "\n *** Type D50 to execute *** \n")
(defun C:d50 (/ *error* acsp adoc ang appd cnt
div-error head len olderror pl
pt pt_list rad step st_list st_num st_txt
tht util
)
(or adoc
(setq adoc
(vla-get-activedocument
(vlax-get-acad-object)
)
)
)
(or appd (setq appd (vla-get-application adoc)))
(or acsp
(setq acsp
(vla-get-block
(vla-get-activelayout adoc)
)
)
)
(or util (setq util (vla-get-utility adoc)))
(command "._undo" "_end")
(command "._undo" "_mark")
(setq olderror *error*)
(setq *error* div-error)
(setq step 50.
head "10+";(getstring T "\nEnter label prefix<10+> :")
tht 2.5;(getreal "\nEnter text height<3.6> :")
rad 1.;(getreal "\nCircle radius <1.2> :")
)
(vla-getentity
util
'pl
'pt
"\nSelect line NEAR OF LINE START to labeling: >>> \n"
)
(if pl
(progn
(setq len (vlax-curve-getdistatparam
pl
(vlax-curve-getendparam pl)
)
)
(if (< (distance (vlax-safearray->list pt)
(vlax-curve-getstartpoint pl)
)
(distance (vlax-safearray->list pt)
(vlax-curve-getendpoint pl)
)
)
(setq pt_list (divplus len step))
(setq pt_list (divminus len step))
)
(setq
pt_list (vl-remove-if
(function not)
(mapcar (function (lambda (x)
(vlax-curve-getpointatdist pl x)
)
)
pt_list
)
)
)
(setq ang (angle (car pt_list)(cadr pt_list))
ang
(cond ((< (/ pi 2) ang (* pi 1.5))(+ pi ang))
(T ang)))
(setq cnt -1)
(repeat (length pt_list)
(setq cnt (1+ cnt))
(setq st_num
(cond ((< cnt 10) (strcat head "0" (itoa cnt)))
(T (strcat head (itoa cnt)))
)
)
(setq st_list (cons st_num st_list))
)
(setq st_list (reverse st_list))
;; following delete if not needs >>>
(mapcar (function (lambda (x)
(vla-addcircle acsp (vlax-3d-point x) rad)
)
)
pt_list
); <<< by suit
(mapcar
(function
(lambda (x y)
(progn
(setq st_txt (vla-addtext acsp x (vlax-3d-point y) tht))
;; following delete if not needs >>>
(vlax-put-property st_txt 'Rotation ang)
(vla-update st_txt); <<< by suit
(vlax-release-object st_txt)
)
)
)
st_list
pt_list
)
(if (not (vlax-object-released-p pl))
(vlax-release-object pl)
)
)
(princ "\nNothing selected try again\n")
)
(vla-zoomextents appd)
(vla-regen adoc acactiveviewport)
(setq *error* olderror
div-error nil
)
(command "._undo" "_end")
(princ)
)
;;;TesT:
;;;(repeat 8 (C:d50))
--------------------------------------------------------------------------------
vBulletin® v3.6.12, Copyright ©2000-2009, Jelsoft Enterprises Ltd.
(defun divminus (len segm / lst)
(while (>= len 0.)
(setq lst (append lst (list len)))
(setq len (- len segm))
)
(if (not (zerop (last lst)))
(setq lst (append lst (list 0.0)))
)
lst
)
(vl-load-com)
(prompt "\n *** Type D50 to execute *** \n")
(defun C:d50 (/ *error* acsp adoc ang appd cnt
div-error head len olderror pl
pt pt_list rad step st_list st_num st_txt
tht util
)
(or adoc
(setq adoc
(vla-get-activedocument
(vlax-get-acad-object)
)
)
)
(or appd (setq appd (vla-get-application adoc)))
(or acsp
(setq acsp
(vla-get-block
(vla-get-activelayout adoc)
)
)
)
(or util (setq util (vla-get-utility adoc)))
(command "._undo" "_end")
(command "._undo" "_mark")
(setq olderror *error*)
(setq *error* div-error)
(setq step 50.
head "10+";(getstring T "\nEnter label prefix<10+> :")
tht 2.5;(getreal "\nEnter text height<3.6> :")
rad 1.;(getreal "\nCircle radius <1.2> :")
)
(vla-getentity
util
'pl
'pt
"\nSelect line NEAR OF LINE START to labeling: >>> \n"
)
(if pl
(progn
(setq len (vlax-curve-getdistatparam
pl
(vlax-curve-getendparam pl)
)
)
(if (< (distance (vlax-safearray->list pt)
(vlax-curve-getstartpoint pl)
)
(distance (vlax-safearray->list pt)
(vlax-curve-getendpoint pl)
)
)
(setq pt_list (divplus len step))
(setq pt_list (divminus len step))
)
(setq
pt_list (vl-remove-if
(function not)
(mapcar (function (lambda (x)
(vlax-curve-getpointatdist pl x)
)
)
pt_list
)
)
)
(setq ang (angle (car pt_list)(cadr pt_list))
ang
(cond ((< (/ pi 2) ang (* pi 1.5))(+ pi ang))
(T ang)))
(setq cnt -1)
(repeat (length pt_list)
(setq cnt (1+ cnt))
(setq st_num
(cond ((< cnt 10) (strcat head "0" (itoa cnt)))
(T (strcat head (itoa cnt)))
)
)
(setq st_list (cons st_num st_list))
)
(setq st_list (reverse st_list))
;; following delete if not needs >>>
(mapcar (function (lambda (x)
(vla-addcircle acsp (vlax-3d-point x) rad)
)
)
pt_list
); <<< by suit
(mapcar
(function
(lambda (x y)
(progn
(setq st_txt (vla-addtext acsp x (vlax-3d-point y) tht))
;; following delete if not needs >>>
(vlax-put-property st_txt 'Rotation ang)
(vla-update st_txt); <<< by suit
(vlax-release-object st_txt)
)
)
)
st_list
pt_list
)
(if (not (vlax-object-released-p pl))
(vlax-release-object pl)
)
)
(princ "\nNothing selected try again\n")
)
(vla-zoomextents appd)
(vla-regen adoc acactiveviewport)
(setq *error* olderror
div-error nil
)
(command "._undo" "_end")
(princ)
)
;;;TesT:
;;;(repeat 8 (C:d50))

 

But, I would need it in VB because Lisp is absolutely Latin to me and I need to modify the above code slightly. Is it possible to do this kind of a thing (as the code above) in VB. Any help would be highly appreicated

 

Ryan

[BIGAL]

Check the recent posts here for "points on a polyline" "divide polyline" words to that effect there are a lot of examples here doing different things both vba and lisp also "batter" I got a program from here calculates points along a pline.

[ryan sen]

Hey Thanks Bigal, I tried to search according to the keywords you suggested and I came across one of your codes:

 

http://www.cadtutor.net/forum/showthread.php?t=28376

 

 

From this what I can understand is, it retrieves all the coordinates of the polyline and the interval decides the no. of blocks that would be inserted inside each segment.

 

Can i modify this code as to use it just like measure command. Where all, will i need to modify.

 

and one more thing, how did you decide those constant values for startang and endang?

 

Thanks a lot !!

Ryan