I made a few minor changes to allow for more flexibility:
-The original arc portion of the code could fail if the provided point was the same distance from the center of the arc as the radius, but not actually on the arc. Choosing (1,0) on the attached drawing would have given a result indicating that we are on the arc. I modified the program to check to see if the point is within the included angle of the arc.
-The original program also had an issue with closed polylines that did not have the start/stop point repeated at the end of the DXF code. Choosing any point (other than (1,0)) on the bottom line would result in a nil value with the original program. I included a check for closed polylines to add the endpoint if necessary.
-One cosmetic change: I included the 10 DXF code in front of the start and end points for the result. They were initially stripped.
(defun c:Test (/ Sel Pt Pobj EntData Ptype PtList VertexPt PtListIndex StWd EndWd PolyList OldIndex StPos cnt
tmpList ShouldClose)
(defun ChangeOldStyle (Ent / Pent cnt EntData PolyInfoList StPos StPt ShouldClose)
(setq Pent Ent)
(setq cnt 0)
(while
(and
(setq Ent (entnext Ent))
(setq EntData (entget Ent))
(= (cdr (assoc 0 EntData)) "VERTEX")
)
(setq PolyInfoList
(append
PolyInfoList
(list (assoc 10 EntData))
(list (assoc 40 EntData))
(list (assoc 41 EntData))
(list (assoc 42 EntData))
)
)
(if (equal cnt 0)
(setq StPt (cdr (assoc 10 EntData)))
)
(setq cnt (1+ cnt))
)
PolyInfoList
)
;-----------------------------------------------------------
; -- Function CalcBulge
; Returns the geometric informations from a polyarc.
; Copyright:
; ©2001 MENZI ENGINEERING GmbH, Switzerland
; Arguments [Typ]:
; Vx1 = Start vertex of p'arc [LIST]
; Vx2 = End vertex of p'arc [LIST]
; Blg = Bulge [REAL]
; Return [Typ]:
; > '(CenterPoint Radius IncludedAngle) [LIST]
; Notes:
; IncludedAngle in radians
;
(defun CalcBulge (Vx1 Vx2 Blg / ArcRad CenDir HlfAng)
(setq HlfAng (* 2 (atan Blg))
CenDir ((if (< Blg 0) - +) (- (angle Vx1 Vx2) HlfAng) (/ pi 2))
ArcRad (abs (/ (/ (distance Vx1 Vx2) 2.0) (sin HlfAng)))
)
(list
(polar Vx1 CenDir ArcRad)
ArcRad
(* HlfAng 2.0) ; removed absolute to give included angle direction
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if
(and
(setq Sel (entsel "\n Select polyline: "))
(setq Pt (getpoint "\n Select point on polyline: "))
(setq EntData (entget (car Sel)))
(wcmatch (setq Ptype (cdr (assoc 0 EntData))) "*POLYLINE")
(setq cnt -4)
)
(progn
(if (= Ptype "POLYLINE")
(setq PtList (ChangeOldStyle (car Sel)))
(progn
;;; (setq PtList
;;; (vl-remove-if-not
;;; '(lambda (x)
;;; (vl-position (car x) '(10 42 40 41))
;;; )
;;; EntData
;;; )
;;; )
(foreach x EntData
(if (member (car x) '(10 42 40 41))
(setq PtList (cons x PtList))
)
)
;added test for closed polylines
(if (and
(= (rem (cdr (assoc 70 EntData)) 2) 1)
(not (equal (nth 3 PtList) (last PtList)))
)
(setq Ptlist (cons (last PtList) PtList)
Ptlist (cons (cons 40 0) PtList)
Ptlist (cons (cons 41 0) PtList)
Ptlist (cons (cons 42 0) PtList)
)
)
(setq ptList (reverse PtList))
)
)
(if PtList
(while
(and
(< cnt (length PtList))
(setq cnt (+ 4 cnt))
(not tmpList)
)
(if
(and
(< cnt (length PtList))
(setq StPt (cdr (nth cnt PtList)))
(setq EndPt (cdr (nth (+ 4 cnt) PtList)))
(setq bulge (cdr (nth (+ 3 cnt) PtList)))
(if (equal bulge 0.0 0.00001)
(and
(or
(equal (angle StPt EndPt) (angle StPt Pt) 0.0001)
(equal (angle EndPt StPt) (angle StPt Pt) 0.0001)
)
(equal (distance StPt EndPt) (+ (distance StPt Pt) (distance Pt EndPt)) 0.0001)
)
(and
(setq arcdata (calcbulge stpt endpt bulge))
(equal (distance pt (car arcdata)) (cadr arcdata) 0.0001)
(setq startang (angle (car arcdata) StPt)) ;added test for included angle
(setq ptang (angle (car arcdata) Pt))
(setq negptang (- ptang (* 2 3.14159265)))
(or
(and
(>= startang ptang)
(<= (+ startang (caddr arcdata)) ptang)
)
(and
(>= startang negptang)
(<= (+ startang (caddr arcdata)) negptang)
)
)
)
)
)
;inserted 10 DXF code in front of start and end points
(setq tmpList (list (cons 10 StPt) (nth (1+ cnt) PtList) (nth (+ 2 cnt) PtList) (nth (+ 3 cnt) PtList) (cons 10 EndPt)))
)
)
)
)
)
tmpList
)
Once again, thanks for your help.
