My intention is to convert all arcs-segments in a polyline into continuous segmented lines.
Here's my code. It works, except it can't handle a closed polyline where the last segment has a bulge in it.
Any help or If someone has a better solution using Visual Lisp that I can use, is greatly appreciated.
Regards,
Rakaryan
(defun c:VIS-PARCEL-SEGPOLY ( )
(if (setq ent1 (entsel "\nSelect Polyline: "))
(progn
(setq ename (car ent1))
(setq etype (dxf-code 0 ename))
(setq okboss (member etype '( "POLYLINE" )))
(if okboss
(progn
(setq pblst (getpb-list ename)) ; List of vertex n bulge
(setq lgth (length pblst))
(setq n 0)
(setq vrtx_lst '())
(setq pt1lst (nth n pblst))
(setq ptawal (car pt1lst))
(while (< n (- lgth 1))
(setq pt1lst (nth n pblst)) ; pt1 coordinates & bulge
(setq pt2lst (nth (+ n 1) pblst)) ; pt2 coordinates & bulge
(setq pt1 (car pt1lst)) ; pt1 Coordinates
(setq pt2 (car pt2lst)) ; pt2 Coordinates
(setq bulg1 (cadr pt1lst)) ; pt1 Bulge
;; Calculate Center and Radius of Arc.
(cond ( (= bulg1 0.0) ; No Bulge
(setq vrtx_lst (append vrtx_lst (list pt1)))
)
( (/= bulg1 0.0)
;; Find Radius n Center of Arc
(setq vrtx_lst (append vrtx_lst (list pt1)))
;; Find parameters of ARC
(setq radiucentr (bul2arc pt1 pt2 bulg1))
(setq radiu (car radiucentr))
(setq centr (cadr radiucentr))
(setq chord (distance pt1 pt2))
(setq lc (abs (* radiu 4.0 (atan bulg1))))
;; Notes: (FIX 0.5) = 0
;;
(if (= 0.0 (fix lc))
(setq lc_intgr (/ lc 3))
(setq lc_intgr (* (fix lc) 3))
)
(setq delta_ang (* 2 (asin (/ (* 0.5 chord) radiu))))
(setq d_ang (/ delta_ang lc_intgr))
(setq idx2 1)
(setq cur_ang (* d_ang idx2))
(while (< cur_ang delta_ang)
(if (< bulg1 0.0)
(setq newvrtx (polar centr (- (angle centr pt1) cur_ang) radiu))
(setq newvrtx (polar centr (+ (angle centr pt1) cur_ang) radiu))
)
;; Add new Vertex(es)
(setq vrtx_lst (append vrtx_lst (list newvrtx)))
(setq idx2 (+ idx2 1))
(setq cur_ang (* d_ang idx2))
); end of while
)
); end of cond
(setq n (+ n 1))
); end of while
(setq vrtx_lst (append vrtx_lst (list pt2)))
(if (vlax-curve-isClosed ename) ;; Closed Polyline?
(setq vrtx_lst (append vrtx_lst (list ptawal)))
)
(command "pline")
(foreach n vrtx_lst (command n))
(command)
(command "erase" ename "")
);progn
);end if
);progn
);end if
(princ)
)
;;
;; REINI URBAN & Sergei M. Komarov
;;
;; Function: BUL2ARC º
;; Purpose : Calculates and return Radius R and Centerpoint C of º
;; an ARC Segmen with startpoint P1, endpoint P2 and bulge Bul º
;; Example : º
;;
;; bulge = +-tan(ang/4). *Very important!!!* If the arc segment of a
;; polyline is drawn counterclockwise, the bulge
;; is positive. If it's drawn clockwise - the bulge
;; is negative!
;; +Bulge = left turn
;; -Bulge = right turn
;;
;; angle = 4*atan(abs(bulge))
;; bulge = +-(2*altitude) / chord. (+ CCW, - CW as mentioned above)
;;
(defun BUL2ARC (P1 P2 BUL / a b c h r chord)
(setq chord (distance p1 p2)
h (* chord 0.5 (abs bul))
r (/ (* 0.5 chord)(sin (* 2 (atan (abs bul)))))
b (angle p1 p2)
a (atan (/ (- r h)(* 0.5 chord)))
a (if (> bul 0)(+ a b)(- b a))
c (polar p1 a r)
)
(list r c)
)
;; ----------------------------------------------------------------------------
;;
;; Function: GETVERTS º
;; Purpose : Extracting Polyline Vertices º
;; Extract the start and end point of each line in a polyline º
;; Example : getverts (ename) º
;;
(defun getverts ( en )
(get 10 (cdr (edlgetent en)))
)
;; ----------------------------------------------------------------------------
;;Or let's say you want to get the bulges too,
;;and create list of points and bulges, PB-list, so
;;
;; Function: GETVERTS º
;; Purpose : Extracting Polyline Vertices and Bulges º
;; Example : getpb-list (ename) º
;;
(defun getpb-list ( en )
(get '(10 42) (cdr (edlgetent en)))
)
;; ----------------------------------------------------------------------------
;;Look for those "miraculous" GET and EDLGETENT functions
(defun edlgetent( e / d edl)
(setq d (entget e) edl (list d))
(if (= 1 (get 66 d)) ;; entities follow
(while (/= "SEQEND" (get 0 (setq d (entget (setq e (entnext e))))))
(setq edl (cons d edl))
)
)
(reverse edl) ;; list of entget's Entity Data Lists ;; {without SEQEND in it}
)
;;Now, GET is real tricky. Basically speaking, it's just the
;;regular (cdr (assoc ...), BUT because of some recursion it preserves the list
;;structure of it's argument(s). You may even specify your keys in whatever list
;;structure you want, like (get '(2 10 (40 41 42) 50) list-of-entgets-of blocks),
;;for example.
;;General GET{ key(s) list(s) } function
(defun get (k l)
(if (atom (caar l)) ;; l is ASSOC'able list
(cond ;; use this list
((atom k) ;; k is a key
(cdr(Assoc k l))
)
((and (cdr k)(atom (cdr k))) ;; '(0 . 8) -> ("ENTITY" . "LAYER")
(cons (get (car k) l) (cdr (assoc (cdr k) l)))
)
(T ;; k is a list of smthg - get inside
(mapcar '(lambda(subk)(get subk l)) k)
)
)
;; else - get inside list
(mapcar '(lambda(subl)(get k subl)) l)
)
)
;; ----------------------------------------------------------------------------
;;
;; Function: ACOS ASIN ACSC ASEC ACOT etc etc..[TRIGONOMETRIC FUNCTIONS] º
;; Example : (setq A (ASIN 0.5)) º
;; Return : 0.523598 which is in Radians. º
;;
(defun ACOS (X) ;Inverse cosine
(- (/ pi 2.0) (atan (/ X (sqrt (- 1.0 (* X X))))))
)
(defun ASIN (X) ; Inverse sine
(atan (/ X (sqrt (- 1.0 (* X X)))))
)
(defun ACSC (X) ; Inverse cosecant
(+ (atan (/ 1.0 (sqrt (- (* X X) 1.0)))) (* (/ pi 2.0)
(- (if (< X 0) (- 1.0) (+ 1.0)) 1.0)))
)
(defun ASEC (X) ; Inverse secant
(+ (atan (sqrt (- (* X X) 1.0))) (* (/ pi 2.0)
(- (if (< X 0) (- 1.0) (+ 1.0)) 1.0)))
)
(defun ACOT (X) ; Inverse cotangent
(- (/ pi 2.0) (atan X))
)
(defun SEC (X) ; Secant
(/ 1.0 (cos X))
)
(defun CSC (X) ; Cosecant
(/ 1.0 (sin X))
)
(defun TAN (X) ; Tangent
(/ (sin X) (cos X))
)
(defun COT (X) ; Cotangent
(/ (cos X) (sin X))
)
;;o~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~o
;; FIND DXF GROUP
;;o~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~o
(defun dxf-code (code enm /) (cdr (assoc code (entget enm))))
