Measure with Flip Option

[loudy000]

Hi all, i have a lisp that creates an array of blocks with defined spacing and a lisp that rotate blocks 18 0degrees. They both works great but i want t combine them into one lisp that allows me to choose for which direction the block should be facing.

 

(Defun c:mes (/) 
 (vl-load-com) 
 (setq acadDoc  (vla-get-ActiveDocument (vlax-get-Acad-Object)) 
          mSpace   (vla-get-modelspace acadDoc) 
          entData   (entsel "\nSelect a polyline:") 
          spdata     (car entData) 
          plineHandle (cdr (assoc 5 (entget spData))) 
          plineObj    (vla-handleToObject acadDoc plineHandle) 
          endSpline   (vlax-curve-getEndParam plineObj) 
          pLength     (vlax-curve-getDistAtParam plineObj endSpline) 
          numOfPoints (fix (/ pLength)) 
 ) ;setq 
 (setq count 1) 
 (repeat numOfPoints 
   (setq dist (* 20 count)) 
   (setq pnt1 (vlax-curve-getPointAtDist plineObj dist)) 
   (setq dist2 (+ dist 0.1))  
   ;; get a sample point that is 0.1 ahead of the point that will

   ;;be used for insertion 
   (setq pnt2 (vlax-curve-getPointAtDist plineObj dist2)) 
   ;; get the angle between the insertion point and the sample point 
   (setq ang1 (angle pnt1 pnt2)) 
   (vla-insertblock mspace (vlax-3d-Point pnt1) "Arrow" 1.0 1.0 1.0 ang1) 
   (setq count (+ count 1)) 
 ) ;repeat 
) 

 

 

(defun c:BlockRot ( / SelSet Counter EntName Obj )
 (princ "Command: Rotate selected Blocks 180 degrees " )
 (if (setq SelSet (ssget '((0 . "INSERT" ))) )
   (progn
     (setq Counter 0 )
     (vl-load-com)
     (while (setq EntName (ssname SelSet Counter ))
       (setq Obj (vlax-ename->vla-Object EntName ) )
       (vlax-put-property Obj "Rotation" (+ (vlax-get Obj "Rotation" ) pi ) )
       (vlax-release-Object Obj )
       (setq Counter (1+ Counter ) )
     )
   )
   (princ ". . no Block selected ! " )
 )
 (princ)
)

[dlanorh]

I have assumed that your arrow block matches the block in the attached drawing.

 

Try the following, minimally tested with the attached block and NO error checking. Should work with arc's lines, splines and lwpolylines

 

(defun c:mes (/ c_doc ms obj e_pt p_len dist i_pt i_param b_ang n_obj o_lst) 
 (vl-load-com) 
 (setq c_doc (vla-get-activedocument (vlax-get-acad-object)) 
       ms (vla-get-modelspace c_doc) 
       obj (vlax-ename->vla-object (car (entsel "\nSelect arc, line, spline or polyline : "))) 
       e_pt (vlax-curve-getendpoint obj) 
       p_len (vlax-curve-getdistatpoint obj e_pt)
       dist 20
 );end_setq 
 (while (< dist p_len) 
   (setq i_pt (vlax-curve-getpointatdist obj dist) 
         i_param (vlax-curve-getparamatpoint obj i_pt)  
         b_ang (angle '(0 0 0) (vlax-curve-getfirstderiv obj i_param)) 
         n_obj (vla-insertblock ms (vlax-3d-point i_pt) "Arrow" 1.0 1.0 1.0 b_ang)
         o_lst (cons n_obj o_lst)
         dist (+ dist 20)
   );end_setq
 );end_while
 (initget "Yes No")
 (if (= (getkword "Flip Arrows? [Y N] : ") "Yes")
   (foreach n_obj o_lst
     (vlax-put-property n_obj 'rotation (+ (vlax-get-property n_obj 'rotation) pi))
   );end_foreach
 );end_if  
);end_defun

my_arrow.dwg

[loudy000]

Brilliant! Thanks mate!

[loudy000]

Hi @dlanorh, just found out i need one more thing please, would it be possible for the code to be like Lee Mac's Centered measure?http://www.lee-mac.com/centeredmeasure.html

with predefied Block name and spacing. Many Thanks.

[BIGAL]

To avoid the "flip line option think about this way pick the left end and arrows always get drawn in correct direction, Ok I know I can hear how do you know which direction the line is, simple you compare the pick point to the end picked and swap start end values if required.

 

 

(setq tp1 (entsel "\nSelect left side near end : "))
(setq tpp1 (entget (car tp1)))
(setq pt1 (cdr (assoc 10 tpp1)))      
(setq pt2 (cdr (assoc 11 tpp1)))      
(setq d1 (distance pt1 pt3))
(setq d2 (distance pt2 pt3))
 (if (> d1 d2)
   (progn 
     (setq temp pt1)
     (setq pt1 pt2)
     (setq pt2 temp)
   )
 )
(setq ang1 (angle pt1 pt2)) 

[loudy000]

Hi Bigal Thank you..but im not sure where to put your code :/

[BIGAL]

The code was posted as an example of a simpler way around asking an extra question, in a suite of software we we adopted this method to save on manual entry, but the code above would mean remove the initget and set "yes or no" rather than make big changes to the code. You have startpoint and endpoint as part of the code, in the case of say a closed pline rectang it gets a lot harder so would just ask pick in or out. Need some time always time poor.

 

Ok found a few minutes tested pline, line, spline, does not work closed pline need an extra check.

 

; original code by Dlanorh  July 2018
; modified by Alan H July 2018
; to use pick an end for in out

(defun c:mes (/ c_doc ms obj e_pt p_len dist i_pt i_param b_ang ent d1 d2 flip isclosed) 
 (vl-load-com) 
 (setq c_doc (vla-get-activedocument (vlax-get-acad-object)) 
       ms (vla-get-modelspace c_doc)
	ent (entsel "\nSelect arc, line, spline or polyline : ")
	pt (cadr ent)
       obj (vlax-ename->vla-object (car ent)) 
       st_pt (vlax-curve-getstartpoint obj)
	e_pt (vlax-curve-getendpoint obj) 
       p_len (vlax-curve-getdistatpoint obj e_pt)
 ) 
(if (not aH:getval1)(load "Getval1"))
(ah:getval1 "Enter spacing" 5 4 "20")
(setq spc (atof val1))
(setq howmany (fix (/ p_len spc)))
(setq dist (- (/ (- p_len (* howmany spc)) 2.0) spc))
(if (= (vla-get-objectname obj) "AcDbPolyline") 
(if (= (vla-get-closed obj) :vlax-true)
 (progn
 (alert "object is closed\n\nneed version 2")
 (exit)
 )
)
)
 
 (setq d1 (distance st_pt pt))
 (setq d2 (distance e_pt pt))
 (if (> d1 d2)
   (setq flip "Yes")
 )
   (repeat (+ howmany 1)
   (setq i_pt (vlax-curve-getpointatdist obj (setq dist (+ dist spc))) 
         i_param (vlax-curve-getparamatpoint obj i_pt)  
         b_ang (angle '(0 0 0) (vlax-curve-getfirstderiv obj i_param))
   )
   (if (= flip "Yes")(setq b_ang (+ pi b_ang)))
   (vla-insertblock ms (vlax-3d-point i_pt) "Arrow" 1.0 1.0 1.0 b_ang)
   
 )
 (princ) ; exit no noise
);end_defun
(c:mes)

 

; Input  Dialog box with variable title
; multiple lines of dcl input supported
; add extra lines if required by copying code defun
; By Alan H 2015

; 1 line dcl
; sample code (ah:getval1 "Enter spacing" 5 4 defualt)
(defun AH:getval1 (title width limit def1 / fo fname)
; you can hard code a directory if you like for dcl file
(setq fo (open (setq fname (vl-filename-mktemp "" "" ".dcl")) "w"))
(write-line "ddgetval : dialog {" fo)
(write-line " : row {" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = "  (chr 34) "key1" (chr 34) ";") fo)
(write-line  (strcat " label = "  (chr 34) title (chr 34) ";"  )   fo)
; these can be replaced with shorter value etc
(write-line (strcat "     edit_width = " (rtos width 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit 2 0) ";" ) fo)
(write-line "   is_enabled = true;" fo)
(write-line "    }" fo)
(write-line "  }" fo)
(write-line "ok_only;}" fo)
(close fo)

(setq dcl_id (load_dialog  fname))
(if (not (new_dialog "ddgetval" dcl_id))
(exit))
(set_tile "key1" (setq val1 def1))
(action_tile "key1" "(setq val1 $value)")
(mode_tile "key1" 3)
(start_dialog)
(done_dialog)
(unload_dialog dcl_id)
; returns the value of val1 as a string
(vl-file-delete fname)
) ; defungetval1

Edited July 31, 2018 by BIGAL

[loudy000]

thanks Bigal, this is great, i think im close to what i intended to do, just making it centered measure is the missing part..many thanks

[BIGAL]

Have another look playing with it now added a bit more save the extra dcl input as Getval1.lsp its a library routine and allows for any input with out hard coding.

 

Centre measure has been added and a dcl for spacing, also still need a think about closed.

Edited July 31, 2018 by BIGAL

[loudy000]

Awesome! But I’m still having issues with orientation, would it be possible to keep the option where the user want to mirror or not?

 

Many thanks.

[BIGAL]

That is the whole idea by picking the correct end it goes in the right direction no need for a mirror. Draw a line, mes, pick left end, mes, pick right end. You will see the two answers appear.

[symoin]

On 7/31/2018 at 6:54 AM, loudy000 said:

 

what if to have block on both sides of the polylines (multiple lines, polylines, arcs etc...)

Edited November 19, 2018 by symoin

[symoin]

On 8/1/2018 at 5:42 AM, BIGAL said:

That is the whole idea by picking the correct end it goes in the right direction no need for a mirror. Draw a line, mes, pick left end, mes, pick right end. You will see the two answers appear.

how about getting the block on both sides, for a polyline with just one selection or on multiple lines with selection or by window or crossings.

[BIGAL]

Both sides add a seperate bit of code, one versus many, again use repeat and walk through the selection as an auto routine will match start point without checking.

 

Final answer may be 3-4 seperate routines.

[symoin]

On 11/27/2018 at 11:54 AM, BIGAL said:

Both sides add a seperate bit of code, one versus many, again use repeat and walk through the selection as an auto routine will match start point without checking.

 

Final answer may be 3-4 seperate routines.

Thanks Bigal