Arc Segmenting with Lines to Center

[eric_monceaux]

So I have been searching the forums for a LISP that can divide an arc while adding mortar joints.

 

The cast stone company I work for manufactures window surrounds and when I draw them, they have to be seperated into equal lengths with a 1/4" mortar joint. Currently what I do is use the DIVIDE command, then a little MLINE macro I wrote drawing an MLINE from the arc node to the center point of said arc.

 

Back in 2006 a CADTutor.net member (CAB) and again in 2009 (SteveK) helped me in converting a qbasic formula into a LISP that I use for horizontal and vertical pieces, and I was wanting to see if something like that could be created for arc pieces as well.

 

I have attached an example of a window surround.

Window Surround.dwg

Stone Segments.LSP

Edited May 23, 2012 by eric_monceaux
Added LISP routine CAB and SteveK helped me with.

[eric_monceaux]

Also for background, here are the two posts I was referring to for the original development of the LISP.

 

http://www.cadtutor.net/forum/showthread.php?40973-LISP-to-divide-to-certain-length&p=275781#post275781.

 

http://www.cadtutor.net/forum/showthread.php?6712-Turn-a-QBASIC-formula-into-an-LISP-function&p=38968#post38968

[BIGAL]

If you take the total arc length put a rule what is maximum stone length user ? then get a number of blocks you should be able to work out arc length = no of joints + block length. Once you have this worked out its pretty easy to convert arclength to chords and draw stone blocks.

 

Say something like 4 blocks = block length 23" is this ok NO try 5 then draw blocks.

 

Arclength=rad*theta so can work out lengths etc simple maths chords are simple formula also if not sure just google circular formulas.

[irneb]

No real need to do curve calculations. Let the vlax-curve-* functions do that for you. Here's a sample:

(vl-load-com)

(setq *SegmentPath:Gap* 0.
     *SegmentPath:GapStart* t
     *SegmentPath:GapEnd* t
     *SegmentPath:MaxLength* 10.)

(defun c:SegmentPath  (/ en space len pos dist)
 (setq space (apply (if (> (getvar 'cvport) 1)
                      'vla-get-ModelSpace
                      'vla-get-PaperSpace)
                    (list (vla-get-ActiveDocument (vlax-get-acad-object)))))
 (while (progn (princ (strcat "\nGap Size: "
                              (rtos *SegmentPath:Gap*)
                              "; Max Length: "
                              (rtos *SegmentPath:MaxLength*)
                              "; "
                              (if *SegmentPath:GapStart*
                                "Gap at start; "
                                "")
                              (if *SegmentPath:GapEnd*
                                "Gap at end; "
                                "")))
               (initget "Gap Max Start End")
               (setq en (entsel "\nPick Path [Gap/Max/Start/End]: ")))
   (cond ((eq en "Gap")
          (if (setq en (getdist (strcat "\nEnter gap size <" (rtos *SegmentPath:Gap*) ": ")))
            (setq *SegmentPath:Gap* en)))
         ((eq en "Max")
          (if (setq en (getdist (strcat "\nEnter max length <" (rtos *SegmentPath:MaxLength*) ": ")))
            (setq *SegmentPath:MaxLength* en)))
         ((eq en "Start") (setq *SegmentPath:GapStart* (not *SegmentPath:GapStart*)))
         ((eq en "End") (setq *SegmentPath:GapEnd* (not *SegmentPath:GapEnd*)))
         (t
          (setq en  (car en)
                len (vlax-curve-getDistAtParam en (vlax-curve-getEndParam en))
                pos 0.)
          (if *SegmentPath:GapStart*
            (setq pos *SegmentPath:Gap*)
            (setq len (+ len *SegmentPath:Gap*)))
          (if *SegmentPath:GapEnd*
            (setq len (- len *SegmentPath:Gap*)))
          (setq dist (/ len (1+ (fix (/ len (+ *SegmentPath:Gap* *SegmentPath:MaxLength*))))))
          (while (< pos len)
            (vla-AddLine
              space
              (vlax-3d-point (vlax-curve-getPointAtDist en pos))
              (vlax-3d-point (vlax-curve-getPointAtDist en (+ pos (- dist *SegmentPath:Gap*)))))
            (setq pos (+ pos dist))))))
 (princ))

It works on anything, not just arcs, but even polylines / splines.

 

One prob though, the length is the length along the curve. Not the straight line length. For that you'd need to temporarily create a circle with radius length, then find the intersection along the curve.

[fixo]

Try this code just for arc segment:

 
;;__________________________________________Amort.lsp________________________________________________;;
(vl-load-com)
;; get bulge radius
;; math by Juergen Menzi
(defun get-radii (p1 p2 bulge)
(abs (/ (distance p1 p2) 2 (sin (/ (* 4 (atan (abs bulge))) 2))
)
)
)
;;--------------------------------------;;
(defun ang-tangent (curve pnt)
(angle
'(0 0 0)
(trans
(vlax-curve-getFirstDeriv
curve
(vlax-curve-getParamAtPoint curve (trans (vlax-curve-getClosestPointTo curve pnt) 1 0))
)
0 1 T 
)
)
)
;;--------------------------------------;;
(defun get-segments (en pnt / par)
(setq par (vlax-curve-getParamAtPoint
en
(vlax-curve-getClosestPointTo en pnt))
)
(list (vlax-curve-getPointAtParam en (fix par))
(vlax-curve-getPointAtParam en (1+ (fix par)))
)
)
;;----------------------- main part ----------------------------;;
(defun C:Amort(/ *error* adoc ang clay curve da en gap i joint leg num p1 p1e p2 par pe1 pe2 pn ps1 ps2 rad segs sset step stleg th)
(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)))
)
(setvar "nomutt" 0)
(if clay (setvar "clayer" clay))
(princ)
)

(setq adoc (vla-get-activedocument
(vlax-get-acad-object)))
(vla-startundomark adoc )
(setq clay (getvar "clayer"))
(setvar "clayer" "Mortar");<-- must be exist
(or *num* (setq *num* 4));<-- hard coded
(setq gap 0.25);<-- hard coded
(setvar "nomutt" 0)
(princ "\nSelect Shortest Arc Segment")
(setvar "nomutt" 1)
(if (setq sset (ssget "_:S:E" '((0 . "*LINE"))))

(progn
(setvar "nomutt" 0)
(setq en (ssname sset 0))
(initget 6)
(setq num (getint (strcat "\nEnter the number of segments <" (rtos *num* 2 0) ">: ")))
(cond (num) ((setq num 4)))
(setq curve (vlax-ename->vla-object en))
(setvar "osmode" 512)
(setq p1 (getpoint "\nPick point on shortest arc segment: "))
(setvar "osmode" 128)
(setq p2 (getpoint p1 "\nPick point on longest arc segment: "))
(setq joint (distance p1 p2))
(setq p1e (vlax-curve-getclosestpointto curve p1))
(setq par (fix (vlax-curve-getParamAtPoint
curve
(vlax-curve-getclosestpointto curve p1e)))
)
;; get segment points
(setq segs (get-segments curve p1e))
;; get radius of an arc
(setq rad (get-radii (car segs) (cadr segs) (vla-getbulge curve par)))
;; get angle between gap points
(setq da (* (atan (/ (/ gap 2) (sqrt (- (expt rad 2.0) (expt (/ gap 2.0) 2.0)))))2.0))
;; swap gap value
(setq th (* da rad))
;; get the start length of segment
(setq stleg (vlax-curve-getdistatparam curve par))
;; get arc length
(setq leg (- (vlax-curve-getdistatparam curve (1+ par))
(vlax-curve-getdistatparam curve par))
)
(setq step (/ leg num))
(setq i 1)
(repeat (1- num)
(setq pn (vlax-curve-getpointatdist curve (+ stleg (* i step)))
pn (vlax-curve-getclosestpointto curve pn))

(setq ang (ang-tangent curve pn))

(setq ps1 (vlax-curve-getpointatdist curve (- (vlax-curve-getdistatpoint curve pn) (/ th 2)))
ps2 (vlax-curve-getpointatdist curve (+ (vlax-curve-getdistatpoint curve pn) (/ th 2))))

(setq pe1 (polar ps1 (- ang (/ pi 2)) joint)
pe2 (polar ps2 (- ang (/ pi 2)) joint))
(command "_.line" "_non" ps1 "_non" pe1 "")
(command "_.line" "_non" ps2 "_non" pe2 "")

(setq i (1+ i)))

)

)
( *error* nil)
(princ)
)

 

~'J'~

[eric_monceaux]

Ok. Sorry for my extremely late reply. It has been busy!

 

fixo: Thank you very much for your LISP. It is very close to what I need, but there was one thing I cannot figure out how to correct. After the LISP is completed, It clears out all OSNAPS except PER. Can you guide me on how to fix that?

 

irneb: What I like about your routine is that you can set your gap and add a gap to the beginning and end of the division. Is there a way that you can change the Start and Stop gap to be half of what the user inputted Gap number? (i.e. 0.25/2). I like that yours is adjustable to a max dimension. That would come in handy for the Stone Segments.LSP I initially submitted.

 

So, if I could actually understand both of these routines, I would merge them together and then it would be great.

1. Mortar Joints drawn in.

2. The ability to set a max ceiling distance and gap diistance.

3. The option to include half the gap dimension at the start and end of the arch.

 

Thanks so much for your help guys. If either of you can steer me in the right direction to combine these LISPS that would be great, and if not, they will still be helpful!

[BIGAL]

Re osnaps pretty simple the variable osmode holds current snap value so

 

At start of code do
(setq oldsnap (getvar "osmode"))

at end of code do
(setvar "osmode" oldsnap)

[eric_monceaux]

@BIGAL That worked. Thanks!

 

Oddly enough, when I loaded the AMORT.LSP today into a new drawing, the program would initialize but after "Select Longest Arc Segment:" the program terminates with no error report... I was able to get it to work yesterday, in a different drawing. The only change I actually made to the LSP is the "Select (long/short) Arc Segment:" was verbally backwards. Also I added a SETVAR for turning osnaps back on. Am I missing something?

 

;;__________________________________________Amort.lsp________________________________________________;;
(vl-load-com)
;; get bulge radius
;; math by Juergen Menzi
(defun get-radii (p1 p2 bulge)
(abs (/ (distance p1 p2) 2 (sin (/ (* 4 (atan (abs bulge))) 2))
)
)
)
;;--------------------------------------;;
(defun ang-tangent (curve pnt)
(angle
'(0 0 0)
(trans
(vlax-curve-getFirstDeriv
curve
(vlax-curve-getParamAtPoint curve (trans (vlax-curve-getClosestPointTo curve pnt) 1 0))
)
0 1 T 
)
)
)
;;--------------------------------------;;
(defun get-segments (en pnt / par)
(setq par (vlax-curve-getParamAtPoint
en
(vlax-curve-getClosestPointTo en pnt))
)
(list (vlax-curve-getPointAtParam en (fix par))
(vlax-curve-getPointAtParam en (1+ (fix par)))
)
)
;;----------------------- main part ----------------------------;;
(defun C:Amort(/ *error* adoc ang clay curve da en gap i joint leg num p1 p1e p2 par pe1 pe2 pn ps1 ps2 rad segs 

sset step stleg th)
(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)))
)
(setvar "nomutt" 0)
(if clay (setvar "clayer" clay))
(princ)
)

(setq adoc (vla-get-activedocument
(vlax-get-acad-object)))
(vla-startundomark adoc )
(setq clay (getvar "clayer"))
(setvar "clayer" "Mortar");<-- must be exist
(or *num* (setq *num* 4));<-- hard coded
(setq gap 0.25);<-- hard coded
(setvar "nomutt" 0)
(princ "\nSelect Longest Arc Segment")
(setvar "nomutt" 1)
(if (setq sset (ssget "_:S:E" '((0 . "*LINE"))))

(progn
(setvar "nomutt" 0)
(setq en (ssname sset 0))
(initget 6)
(setq num (getint (strcat "\nEnter the number of segments <" (rtos *num* 2 0) ">: ")))
(cond (num) ((setq num 4)))
(setq curve (vlax-ename->vla-object en))
(setvar "osmode" 512)
(setq p1 (getpoint "\nPick point on Longest arc segment: "))
(setvar "osmode" 128)
(setq p2 (getpoint p1 "\nPick point on Shortest arc segment: "))
(setq joint (distance p1 p2))
(setq p1e (vlax-curve-getclosestpointto curve p1))
(setq par (fix (vlax-curve-getParamAtPoint
curve
(vlax-curve-getclosestpointto curve p1e)))
)
;; get segment points
(setq segs (get-segments curve p1e))
;; get radius of an arc
(setq rad (get-radii (car segs) (cadr segs) (vla-getbulge curve par)))
;; get angle between gap points
(setq da (* (atan (/ (/ gap 2) (sqrt (- (expt rad 2.0) (expt (/ gap 2.0) 2.0)))))2.0))
;; swap gap value
(setq th (* da rad))
;; get the start length of segment
(setq stleg (vlax-curve-getdistatparam curve par))
;; get arc length
(setq leg (- (vlax-curve-getdistatparam curve (1+ par))
(vlax-curve-getdistatparam curve par))
)
(setq step (/ leg num))
(setq i 1)
(repeat (1- num)
(setq pn (vlax-curve-getpointatdist curve (+ stleg (* i step)))
pn (vlax-curve-getclosestpointto curve pn))

(setq ang (ang-tangent curve pn))

(setq ps1 (vlax-curve-getpointatdist curve (- (vlax-curve-getdistatpoint curve pn) (/ th 2)))
ps2 (vlax-curve-getpointatdist curve (+ (vlax-curve-getdistatpoint curve pn) (/ th 2))))

(setq pe1 (polar ps1 (- ang (/ pi 2)) joint)
pe2 (polar ps2 (- ang (/ pi 2)) joint))
(command "_.line" "_non" ps1 "_non" pe1 "")
(command "_.line" "_non" ps2 "_non" pe2 "")

(setq i (1+ i)))

)

)
( *error* nil)
(setvar "osmode" 4211)
(princ)
)