;; Modified by Igal Averbuh 2015 (Added two digits accuracy for X

;; and Y coordinates, Easting and Northing changed to X and Y)

(defun c:tabord(/ aCen cAng cCen cPl cRad cReg

fDr it lCnt lLst mSp pCen pT1

pT2 ptLst R tHt tLst vlaPl vlaTab

vLst cTxt oldCol nPl clFlg *error*)

```
``` (vl-load-com)

(defun Extract_DXF_Values(Ent Code)

(mapcar 'cdr

(vl-remove-if-not

'(lambda(a)(=(car a)Code))

(entget Ent)))

); end of

(defun *error*(msg)

(setvar "CMDECHO" 1)

(princ)

); end of *error*

(if

(and

(setq cPl(entsel "\nSelect LwPoliline > "))

(= "LWPOLYLINE"(car(Extract_DXF_Values(car cPl)0)))

); end and

(progn

(setq vlaPl(vlax-ename->vla-object(car cPl))

ptLst(mapcar 'append

(setq vLst(Extract_DXF_Values(car cPl)10))

(mapcar 'list(Extract_DXF_Values(car cPl)42)))

lLst '("A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M"

"N" "O" "P" "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z")

r 2 lCnt 0

tLst '((1 0 "Point")(1 1 "X")(1 2 "Y")(1 3 "Radius"))

mSp(vla-get-ModelSpace

(vla-get-ActiveDocument

(vlax-get-acad-object)))

tHt(getvar "TEXTSIZE")

); end setq

(setvar "CMDECHO" 0)

(foreach vert ptLst

(setq vert(trans vert 0 1)

tLst(append tLst

(list(list r 0 (nth lCnt lLst))

(list r 1(rtos(car vert)2 2))

(list r 2(rtos(cadr vert)2 2))

(list r 3 ""))))

(if(and

(/= 0.0(last vert))

(setq pt1(vlax-curve-GetPointAtParam vlaPl lCnt))

(setq pt2(vlax-curve-GetPointAtParam vlaPl(1+ lCnt)))

); end and

(setq r(1+ r)

cRad(abs(/(distance pt1 pt2)

2(sin(/(* 4(atan(abs(last vert))))2))))

aCen(vlax-curve-GetPointAtParam vlaPl(+ 0.5 lCnt))

fDr(vlax-curve-getFirstDeriv vlaPl

(vlax-curve-getParamAtPoint vlaPl aCen))

pCen(trans

(polar aCen(-(if(minusp(last vert)) pi(* 2 pi))

(atan(/(car fDr)(cadr fDr))))cRad)0 1)

tLst(append tLst(list

(list r 0 "center")

(list r 1(rtos(car pCen)2 2))

(list r 2(rtos(cadr pCen)2 2))

(list r 3(rtos cRad 2 4))))

); end setq

); end if

(setq r(1+ r) lCnt(1+ lCnt))

); end foreach

(setq vlaTab(vla-AddTable mSp (vlax-3D-point '(0 0 0))

(+ 1(/(length tLst)4)) 4 (* 3 tHt)(* 18 tHt)))

(foreach i tLst

(vl-catch-all-apply 'vla-SetText(cons vlaTab i))

(vla-SetCellTextHeight vlaTab(car i)(cadr i)tHt)

(vla-SetCellAlignment vlaTab(car i)(cadr i)acMiddleCenter)

); end foreach

(vla-DeleteRows vlaTab 0 1)

(princ "\n<<>> ")

(command "_.copybase" (trans '(0 0 0)0 1)(entlast) "")

(command "_.erase" (entlast) "")

(command "_.pasteclip" pause)

(if(= :vlax-true(vla-get-Closed vlaPl))

(progn

(setq nPl(vla-Copy vlaPl))

(command "_.region" (entlast) "")

(setq cCen(vlax-get(setq cReg

(vlax-ename->vla-object(entlast)))'Centroid))

(vla-Delete cReg)

(setq clFlg T)

); end progn

); end if

(setq lCnt 0)

(foreach v vLst

(if clFlg

(setq cAng(angle cCen(trans v 0 1))

iPt(polar v cAng (* 2 tHt)))

(setq fDr(vlax-curve-getFirstDeriv vlaPl

(vlax-curve-getParamAtPoint vlaPl v))

iPt(trans

(polar v(-(* 2 pi)(atan(/(car fDr)(cadr fDr))))

(* 2 tHt))0 1)

); end if

); end if

(setq cTxt(vla-AddText mSp(nth lCnt lLst)

(vlax-3d-point iPt) tHt)

lCnt(1+ lCnt)

); end setq

(setq oldCol(getvar "CECOLOR"))

(setvar "CECOLOR" "1")

(command "_.circle" v (/ tHt 3))

(setvar "CECOLOR" oldCol)

); end foreach

(setvar "CMDECHO" 1)

); end progn

(princ "\n It isn't LwPolyline! Quit. ")

); end if

(princ)

); end of c:tabord

(c:tabord)

Advertisements

```
```