I noticed some time ago that a request was made for draing an arc between two circles and then the arc was trimmed from within the circle.
I cam across this routine and and it does just that except it would be nice to select a circle within a block and do the same thing, but when I try it with this routine it does not place the arc in the correct position. The routine is listed below. Can someone assist me?
Thank you..............
(defun C:3PA()
;;;--- Turn the command echo off
(setvar "cmdecho" 1)
;;;--- Save the osnap settings
(setq oldOs(getvar "osmode"))
;;;--- Turn osnaps off
(setvar "osmode" 0)
;;;--- Let the user select the circles
(setq ent1(nentsel "\n Select First Circle: "))
(setq ent2(nentsel "\n Select Second Circle: "))
;;;--- If two entities were selected
(if (and ent1 ent2)
(progn
;;--- Get the entities again using ssget to see if the circle is part of a block
(if(setq eset1(ssget (cadr ent1) (list(cons 0 "INSERT"))))
(progn
(setq blkEn(ssname eset1 0))
(setq blkList(entget blkEn))
(setq InsPt1(cdr(assoc 10 blkList)))
(setq rot1(cdr(assoc 50 blkList)))
)
(setq rot1 0)
)
(if(setq eset2(ssget (cadr ent2) (list(cons 0 "INSERT"))))
(progn
(setq blkEn(ssname eset2 0))
(setq blkList(entget blkEn))
(setq InsPt2(cdr(assoc 10 blkList)))
(setq rot2(cdr(assoc 50 blkList)))
)
(setq rot2 0)
)
;;;--- Get the entity names of the circles
(setq en1(car ent1))
(setq en2(car ent2))
;;;--- Get the DXF group codes from the entities
(setq enlist1(entget en1))
(setq enlist2(entget en2))
;;;--- If both entities selected were circles...
(if(and (= "CIRCLE" (cdr(assoc 0 enlist1)))(= "CIRCLE" (cdr(assoc 0 enlist2))))
(progn
;;;--- Get the center points of the circles
(setq cpt1 (cdr(assoc 10 enlist1)))
(setq cpt2 (cdr(assoc 10 enlist2)))
;;;--- Get the radii of the circles
(setq rad1(cdr(assoc 40 enlist1)))
(setq rad2(cdr(assoc 40 enlist2)))
;;;--- Apply the insertion points if a block was present
(if eset1
(setq cpt1(polar cpt1 (angle (list 0 0) insPt1) (distance (list 0 0) insPt1)))
)
(if eset2
(setq cpt2(polar cpt2 (angle (list 0 0) insPt2) (distance (list 0 0) insPt2)))
)
;;;--- Apply the block rotations
(if(/= 0 rot1)
(setq cpt1(polar insPt1 (+ rot1 (angle insPt1 cpt1)) (distance insPt1 cpt1)))
)
(if (/= 0 rot2)
(setq cpt2(polar insPt2 (+ rot2 (angle insPt2 cpt2)) (distance insPt2 cpt2)))
)
;;;--- Draw the arc temporarily to find it's properties
(command "arc" cpt1 "E" cpt2 "D" pause)
;;;--- Get the entity name of the arc
(setq en(entlast))
;;;--- Get the DXF group codes of the arc
(setq enlist(entget en))
;;;--- Get the center point of the arc
(setq cpt(cdr(assoc 10 enlist)))
;;;--- Delete the arc
(entdel en)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;--- Work on the first circle selected
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;--- Find the distance from the center of the circle to the center of the arc
(setq slp(distance cpt cpt1))
;;;--- The rise should be half of the radius
(setq ris(/ rad1 2.0))
;;;--- Get the run from the rise and slope
(setq run(sqrt(- (* slp slp)(* ris ris))))
;;;--- Get the angle of the triangle
(setq ang(atan(/ ris run)))
;;;--- The arc will bisect the circle twice, get both intersection points
(setq anga(+ ang ang (angle cpt cpt1)))
(setq npta(polar cpt anga slp))
(setq angb(- (angle cpt cpt1) ang ang))
(setq nptb(polar cpt angb slp))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;--- Work on the second circle selected
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;--- Find the distance from the center of the circle to the center of the arc
(setq slp(distance cpt cpt2))
;;;--- The rise should be half of the radius
(setq ris(/ rad2 2.0))
;;;--- Get the run from the rise and slope
(setq run(sqrt(- (* slp slp)(* ris ris))))
;;;--- Get the angle of the triangle
(setq ang(atan(/ ris run)))
;;;--- The arc will bisect the circle twice, get both intersection points
(setq anga(+ ang ang (angle cpt cpt2)))
(setq nptc(polar cpt anga slp))
(setq angb(- (angle cpt cpt2) ang ang))
(setq nptd(polar cpt angb slp))
;;;--- Get the correct intersection points on each circle
(if(< (distance npta nptd)(distance nptb nptc))
(setq pt1 npta pt2 nptd)
(setq pt1 nptb pt2 nptc)
)
;;;--- Check for clockwise counter-clockwise directions
(if (not c:cal)(arxload "geomcal"))
(setq myAng1 (cal "ang(cpt,pt1,pt2)"))
(setq myAng2 (cal "ang(cpt,pt2,pt1)"))
;;;--- Draw the arc
(if(< myang1 myAng2)
(command "arc" "C" cpt pt1 pt2)
(command "arc" "C" cpt pt2 pt1)
)
)
(alert "Select two circles please!")
)
)
(alert "You must select two circles!")
)
(setvar "osmode" oldOs)
(setvar "cmdecho" 1)
(princ)
)
;;===================================================================
;; ^C^Cosmode;16;^C^C-layer;set;E-PWR-CON;;arc;\\\
(defun c:ea ()
(command "osmode" 16)
(command "-layer" "set" "E-PWR-CON" "" "")
(command "arc")
)
(defun c:ea2 (/ usrosm clayer)
(setq usrosm (getvar "osmode")
clayer (getvar "clayer")
)
(setvar "osmode" 16)
(command "-layer" "set" "E-PWR-CON" "" "")
(command "arc" pause pause pause)
(setvar "osmode" usrosm)
(setvar "clayer" clayer)
(princ)
)
(defun c:ea3 (/ usrosm clayer)
(setq usrosm (getvar "osmode")
clayer (getvar "clayer")
)
(setvar "osmode" 16)
(setvar "clayer" "E-PWR-CON")
(command "arc" pause pause pause)
(setvar "osmode" usrosm)
(setvar "clayer" clayer)
(princ)
)
(defun c:ea4 (/ usrosm clayer)
(setq usrosm (getvar "osmode")
clayer (getvar "clayer")
)
(command "_.layer" "M" "E-PWR-CON" "")
(setvar "osmode" 512)
(command "_.arc" pause pause pause)
(setvar "osmode" usrosm)
(setvar "clayer" clayer)
(princ)
)
