I want full degree mints and second format (DDMMSS) IN TABLE

hiraram_prajapati · ‎08-20-2024

I want full degree mints and second format (DDMMSS)

Please help me and edit my lisp I have attached.

(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 '("START POINT" "IP-01" "IP-02" "IP-03" "IP-04" "IP-05" "IP-06" "IP-07" "IP-08" "IP-09" "IP-10" "IP-11" "IP-12""IP-13" "IP-14" "IP-15" "IP-16" "IP-17" "IP-18" "IP-19" "IP-20" "IP-21" "IP-22" "IP-23" "IP-24" "IP-25" "IP-26" "IP-27" "IP-28" "IP-29" "IP-30" "IP-31" "IP-32" "IP-33" "IP-34" "IP-35" "IP-36" "IP-37" "IP-38" "IP-39" "IP-40" "IP-41" "IP-42" "IP-43" "IP-44" "IP-45" "IP-46" "IP-47" "IP-48" "IP-49" "IP-50" "IP-51" "IP-52" "IP-53" "IP-54" "IP-55" "IP-56" "IP-57" "IP-58" "IP-59" "IP-60" "IP-61" "IP-62" "IP-63" "IP-64" "IP-65" "IP-66" "IP-67" "IP-68" "IP-69" "IP-70" "IP-71" "IP-72" "IP-73" "IP-74" "IP-75" "IP-76" "IP-77" "IP-78" "IP-79" "IP-80" "IP-81" "IP-82" "IP-83" "IP-84" "IP-85" "IP-86" "IP-87" "IP-88" "IP-89" "IP-90" "IP-91" "IP-92" "IP-93" "IP-94" "IP-95" "IP-96" "IP-97" "IP-98" "IP-99" "IP-100" "IP-101" "IP-102" "IP-103" "IP-104" "IP-105" "IP-106" "IP-107" "IP-108" "IP-109" "IP-110")

r 2 lCnt 0

;tLst '((1 0 "Point")(1 1 "EASTING")(1 2 "NORTHING")(1 3 "Radius"))

tLst '((1 0 "Point")(1 1 "EASTING")(1 2 "NORTHING")(1 3 "Radius")(1 4 "Distance")(1 5 "Bend"))

mSp(vla-get-ModelSpace

(vla-get-ActiveDocument

(vlax-get-acad-object)))

tHt(getvar "TEXTSIZE")

); end setq

(setvar "CMDECHO" 0)

(setq prVert nil)

(setq prAng nil)

(setq ct 0)

(foreach vert ptLst

(setq vert(trans vert 0 1))

;;; (if prVert

;;; (progn

;;; (setq vDist (rtos (distance prVert vert) 2 4))

;;;;;; (setq tAng (cvunit (angle prVert vert) "radian" "degree"))

;;;;;; (setq vAng (rtos tAng 2 0))

;;;;;; (if prAng

;;;;;; (progn

;;;;;; (if (> tAng prAng)

;;;;;; (progn

;;;;;; (setq vAng (- tAng prAng))

;;;;;; (if (> vAng 180.0)

;;;;;; (setq vAng (- vAng 180.0))

;;;;;; )

;;;;;; (if (> vAng 90.0)

;;;;;; (setq vAng (- vAng 90.0))

;;;;;; )

;;;;;; (setq vAng (rtos vAng 2 0))

;;;;;; (setq vAng (strcat "LT " vAng "%%d"))

;;;;;; )

;;;;;; (progn

;;;;;; (setq vAng (- prAng tAng))

;;;;;; (if (> vAng 180.0)

;;;;;; (setq vAng (- vAng 180.0))

;;;;;; )

;;;;;; (if (> vAng 90.0)

;;;;;; (setq vAng (- vAng 90.0))

;;;;;; )

;;;;;; (setq vAng (rtos vAng 2 0))

;;;;;; (setq vAng (strcat "RT " vAng "%%d"))

;;;;;; )

;;; )

;;; (progn

;;; (setq vDist "0.0")

;;; (setq vAng "-")

;;; )

;;; (setq prAng tAng)

(if (/= ct 0)

(if (/= ct (- (length ptLst) 1 ))

(progn

(setq p1 (nth (- ct 1) ptLst))

(setq p3 (nth (+ ct 1) ptLst))

(setq vDist (rtos (distance p1 vert) 2 4))

;;EXCEL LOGIC START

;;; (setq dx (- (car vert) (car p1)))

;;; (setq dy (- (car (cdr vert)) (car (cdr p1))))

;;; (setq ang1 (cvunit (angle p1 vert) "radian" "degree"))

;;; (if (> ang1 180.0000001)

;;; (setq ang1 (- ang1 360))

;;; )

;;; (setq ang1 (calculateAngle dx dy ang1))

;;;

;;; (setq dx (- (car p3) (car vert)))

;;; (setq dy (- (car (cdr p3)) (car (cdr vert))))

;;; (setq ang2 (cvunit (angle vert p3) "radian" "degree"))

;;; (if (> ang2 180.000001)

;;; (setq ang2 (- ang2 360))

;;; )

;;; (setq ang2 (calculateAngle dx dy ang2))

;;;

;;; (if (< (- ang2 ang1) 180.0000001)

;;; (setq vang (+ (- ang2 ang1) 180))

;;; (IF (> (- ang2 ang1) 180.0000001)

;;; (setq vang (- (- ang2 ang1) 180))

;;; )

;;;

;;; (if (< vang 180.0000001)

;;; (progn

;;; (if (> vang 90.0000001)

;;; (setq vang (strcat "LT" (rtos (abs (- 180 vang)) 2 0)))

;;; (if (< vang 0.0)

;;; (progn

;;; (setq vang (abs (+ 360 vang)))

;;; (if (> vang 180.0000001)

;;; (setq vang (- vang 180.0))

;;; )

;;; (if (> vang 90.0000001)

;;; (setq vang (- 180 vang))

;;; )

;;; (setq vang (strcat "LT" (rtos vang 2 0)))

;;; )

;;; (setq vang (strcat "LT" (rtos (abs vang) 2 0)))

;;; )

;;; (progn

;;; (if (> vang 90.0000001)

;;; (setq vang (strcat "RT" (rtos (ABS (- 180 vang)) 2 0)))

;;; (setq vang (strcat "RT" (rtos (ABS (- vang 180)) 2 0)))

;;; )

;;EXCEL LOGIC END

(setq ang1 (cvunit (angle p1 vert) "radian" "degree"))

;;;

(setq ang2 (cvunit (angle vert p3) "radian" "degree"))

(IF (= ang1 0.00)

(if (> ang2 180.000001)

(setq ang1 360.0)

)

(if (= ang2 0.00)

(if (> ang1 180.00001)

(setq ang2 360.00)

)

;;; (IF (= ang2 360)

;;; (setq ang2 0.0)

;;; )

(if (> ang2 ang1)

(progn

(if (> ang1 270.0000001)

(setq ang1 (- ang1 360))

)

(if (> ang2 270.00000001)

(setq ang2 (- ang2 360))

)

(setq vAng (abs (- ang2 ang1)))

(if (>= vAng 270.00000001)

(setq vAng (abs (- vAng 360.0)))

)

(if (>= vAng 180.000000001)

(setq vAng (- vAng 180.0))

)

(if (> vAng 90.000001)

(setq vAng (- vAng 90.0))

)

(setq vAng (rtos vAng 2 0))

(setq vAng (strcat "LT " vAng "%%d"))

)

(progn

(if (> ang1 270.0000000001)

(setq ang1 (- ang1 360))

)

(if (> ang2 270.00000001)

(setq ang2 (- ang2 360))

)

(setq vAng (abs(- ang1 ang2)))

(if (>= vAng 270.000000001)

(setq vAng (abs (- vAng 360.0)))

)

(if (>= vAng 180.0000000001)

(setq vAng (- vAng 180.0))

)

(if (> vAng 90.000001)

(setq vAng (- vAng 90.0))

)

(setq vAng (rtos vAng 2 0))

(setq vAng (strcat "RT " vAng "%%d"))

)

(progn

(setq p1 (nth (- ct 1) ptLst))

(setq vDist (rtos (distance p1 vert) 2 4))

(setq vAng "-")

)

(progn

(setq vDist "0.000")

(setq vAng "-")

)

(setq tLst(append tLst

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

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

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

(list r 3 "")

(list r 4 vDist)

(list r 5 vAng))))

(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 4))

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

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

); end setq

); end if

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

(setq prVert vert)

(setq ct (1+ ct))

); end foreach

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

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

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

(+ 1(/(length tLst)6)) 6 (* 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<<< Place Table >>> ")

(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)))

(progn

(setq fDr(vlax-curve-getFirstDeriv vlaPl (vlax-curve-getParamAtPoint vlaPl v)))

(if (or (= (car fDr) 0) (= (cadr fDr) 0))

(setq iPt(trans (polar v (- (* 2 pi) (atan (* 5 tHt))) (* 2 tHt))0 1))

(setq iPt(trans (polar v (- (* 2 pi) (atan (/ (car fDr) (cadr fDr)))) (* 2 tHt))0 1))

)

); end Progn

); 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

(defun calculateAngle (dx dy ang)

(setq retVal 0)

(If (and (< dx 0) (>= dy 0))

(setq retVal (- ang 450))

(if (and (>= dx 0) (>= dy 0))

(setq retVal (- ang 90))

(if (and (< dx 0) (< dy 0))

(setq retVal (- ang 90))

(if (and (>= dx 0) (< dy 0))

(setq retVal (- ang 90))

)

(abs retVal)

)); end of c:TABORD

Kent1Cooper · ‎08-20-2024

Too much code to wade through in detail [better to attach a file than to include hundreds of lines of code in the Message body, and you should also eliminate the irrelevant commented-out lines], but I think:

Change (rtos) functions involving angles to (angtos) functions [read about those in the AutoLisp Reference]. The first argument after the value to be converted should be 1 to get degrees-minutes-seconds, and the last one should be 4 to go as far as seconds [without decimal places]. The DIMZIN System Variable setting will determine whether trailing zeroes for minutes/seconds will be included.

And you can get a degrees symbol instead of the "d" that (angtos) will supply.

As one example, change this [which occurs more than once]:

(rtos vAng 2 0)

to this:

(vl-string-subst "°" "d" (angtos vAng 1 4))

I'm pretty sure that one is about an angle, but don't know about some others without deeper analysis. But don't change all (rtos) functions -- not all are about angles.

Kent Cooper, AIA

Moshe-A · ‎08-20-2024

@hiraram_prajapati ,

check this correction 😀

enjoy

Moshe

autoid374ceb4990 · ‎08-20-2024

I cannot load your LISP program (ACAD error: extra right paren), but I have attached a file that may help you format the bearing string.

Just load the BRDIST.LSP file and type "BR" to see how it works.

There is a function in the file called "br_dist" that formats the angle.

I wrote this program over 30 years ago, so I hope it works in the newer AutoCADs.

hiraram_prajapati · ‎08-20-2024

Dear Sir,

Thank you for help,

But is changing Easting northing to DDMMSS, I want only in last column as shown in attached snap.

Please try to change in last column not in easting northing.

thanks you

hiraram_prajapati · ‎08-20-2024

I am not able to load your lisp and commands not working, please check and reply.

hiraram_prajapati · ‎08-20-2024

Dear sir,

I have attached Lisp. please load and type Command ""TABORD"".

Please update and sent me.

Thank you in advance.

Moshe-A · ‎08-20-2024

@hiraram_prajapati ,

sorry, as this lisp is touched, it stop working at all 😩

Moshe

Kent1Cooper · ‎08-21-2024

[There is still an extra right parenthesis somewhere.]

Kent Cooper, AIA

komondormrex · ‎08-21-2024

right the last one in original code by op.

komondormrex · ‎08-21-2024

as commander Cooper suggested

(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 '("START POINT" "IP-01" "IP-02" "IP-03" "IP-04" "IP-05" "IP-06" "IP-07" "IP-08" "IP-09" "IP-10" "IP-11" "IP-12""IP-13" "IP-14" "IP-15" "IP-16" "IP-17" "IP-18" "IP-19" "IP-20" "IP-21" "IP-22" "IP-23" "IP-24" "IP-25" "IP-26" "IP-27" "IP-28" "IP-29" "IP-30" "IP-31" "IP-32" "IP-33" "IP-34" "IP-35" "IP-36" "IP-37" "IP-38" "IP-39" "IP-40" "IP-41" "IP-42" "IP-43" "IP-44" "IP-45" "IP-46" "IP-47" "IP-48" "IP-49" "IP-50" "IP-51" "IP-52" "IP-53" "IP-54" "IP-55" "IP-56" "IP-57" "IP-58" "IP-59" "IP-60" "IP-61" "IP-62" "IP-63"	"IP-64" "IP-65" "IP-66" "IP-67" "IP-68" "IP-69" "IP-70" "IP-71" "IP-72" "IP-73" "IP-74" "IP-75" "IP-76" "IP-77" "IP-78" "IP-79" "IP-80" "IP-81" "IP-82" "IP-83" "IP-84" "IP-85" "IP-86" "IP-87" "IP-88" "IP-89" "IP-90" "IP-91" "IP-92" "IP-93" "IP-94" "IP-95" "IP-96" "IP-97" "IP-98" "IP-99" "IP-100" "IP-101" "IP-102" "IP-103" "IP-104" "IP-105" "IP-106" "IP-107" "IP-108" "IP-109" "IP-110")
		r 2 lCnt 0
		;tLst '((1 0 "Point")(1 1 "EASTING")(1 2 "NORTHING")(1 3 "Radius"))
		tLst '((1 0 "Point")(1 1 "EASTING")(1 2 "NORTHING")(1 3 "Radius")(1 4 "Distance")(1 5 "Bend"))
		mSp(vla-get-ModelSpace
		     (vla-get-ActiveDocument
		       (vlax-get-acad-object)))
		tHt(getvar "TEXTSIZE")
		    ); end setq
	    (setvar "CMDECHO" 0)
	    (setq prVert nil)
	    (setq prAng nil)
	    (setq ct 0)
	    (foreach vert ptLst
	      (setq vert(trans vert 0 1))
;;;	      (if prVert
;;;		(progn
;;;		  (setq vDist (rtos (distance prVert vert) 2 4))
;;;;;;		  (setq tAng (cvunit (angle prVert vert) "radian" "degree"))
;;;;;;		  (setq vAng (rtos tAng  2 0))
;;;;;;		  (if prAng
;;;;;;		    (progn
;;;;;;		      (if (> tAng prAng)
;;;;;;			(progn
;;;;;;			  (setq vAng (- tAng prAng))
;;;;;;			  (if (> vAng 180.0)
;;;;;;			    (setq vAng (- vAng 180.0))
;;;;;;			    )
;;;;;;			  (if (> vAng 90.0)
;;;;;;			    (setq vAng (- vAng 90.0))
;;;;;;			    )
;;;;;;			  (setq vAng (rtos vAng 2 0))
;;;;;;			  (setq vAng (strcat "LT " vAng "%%d"))
;;;;;;			  )
;;;;;;			(progn
;;;;;;			  (setq vAng (- prAng tAng))
;;;;;;			  (if (> vAng 180.0)
;;;;;;			    (setq vAng (- vAng 180.0))
;;;;;;			    )
;;;;;;			  (if (> vAng 90.0)
;;;;;;			    (setq vAng (- vAng 90.0))
;;;;;;			    )
;;;;;;			  (setq vAng (rtos vAng 2 0))
;;;;;;			  (setq vAng (strcat "RT " vAng "%%d"))
;;;;;;			  )
;;;;;;			)
;;;;;;		      )
;;;;;;		    )
;;;		  )
;;;		(progn
;;;		  (setq vDist "0.0")
;;;		  (setq vAng "-")
;;;		  )
;;;		)
;;;	      (setq prAng tAng)
	      (if (/= ct 0)
		(if (/= ct (- (length ptLst) 1 ))
		  (progn
		    (setq p1 (nth (- ct 1) ptLst))
		    (setq p3 (nth (+ ct 1) ptLst))
		    (setq vDist (rtos (distance p1 vert) 2 4))
		    ;;EXCEL LOGIC START
;;;		    (setq dx (- (car vert) (car p1)))
;;;		    (setq dy (- (car (cdr vert)) (car (cdr p1))))
;;;		    (setq ang1 (cvunit (angle p1 vert) "radian" "degree"))
;;;		    (if (> ang1 180.0000001)
;;;		      (setq ang1 (- ang1 360))
;;;		      )
;;;		    (setq ang1 (calculateAngle dx dy ang1))
;;;		    
;;;		    (setq dx (- (car p3) (car vert)))
;;;		    (setq dy (- (car (cdr p3)) (car (cdr vert))))
;;;		    (setq ang2 (cvunit (angle vert p3) "radian" "degree"))
;;;		    (if (> ang2 180.000001)
;;;		      (setq ang2 (- ang2 360))
;;;		      )
;;;		    (setq ang2 (calculateAngle dx dy ang2))
;;;
;;;		    (if (< (- ang2 ang1) 180.0000001)
;;;		      (setq vang (+ (- ang2 ang1) 180))
;;;		      (IF (> (- ang2 ang1) 180.0000001)
;;;			(setq vang (- (- ang2 ang1) 180))
;;;			)
;;;		      )
;;;
;;;		    (if (< vang 180.0000001)
;;;		      (progn
;;;			(if (> vang 90.0000001)
;;;			  (setq vang (strcat "LT" (rtos (abs (- 180 vang)) 2 0)))
;;;			  (if (< vang 0.0)
;;;			    (progn
;;;			      (setq vang (abs (+ 360 vang)))
;;;			      (if (> vang 180.0000001)
;;;				(setq vang (- vang 180.0))
;;;				)
;;;			      (if (> vang 90.0000001)
;;;				(setq vang (- 180 vang))
;;;				)
;;;			      (setq vang (strcat "LT" (rtos vang 2 0)))
;;;			      )
;;;			    (setq vang (strcat "LT" (rtos (abs vang) 2 0)))
;;;			    )
;;;			  )
;;;			)
;;;		      (progn
;;;			(if (> vang 90.0000001)
;;;			  (setq vang (strcat "RT" (rtos (ABS (- 180 vang)) 2 0)))
;;;			  (setq vang (strcat "RT" (rtos (ABS (- vang 180)) 2 0)))
;;;			  )
;;;			)
;;;		      )
		    ;;EXCEL LOGIC END
		    
		    (setq ang1 (cvunit (angle p1 vert) "radian" "degree"))
;;;		    
		    
		    
		    (setq ang2 (cvunit (angle vert p3) "radian" "degree"))
		    (IF (= ang1 0.00)
		      (if (> ang2 180.000001)
			(setq ang1 360.0)
			)
		      (if (= ang2 0.00)
			(if (> ang1 180.00001)
			  (setq ang2 360.00)
			  )
			)
		      )
;;;		    (IF (= ang2 360)
;;;		      (setq ang2 0.0)
;;;		      )
		    
		    
		    (if (> ang2 ang1)
			(progn
			  (if (> ang1 270.0000001)
			    (setq ang1 (- ang1 360))
			    )
			  (if (> ang2 270.00000001)
			    (setq ang2 (- ang2 360))
			    )
			  
			  (setq vAng (abs (- ang2 ang1)))
			  (if (>= vAng 270.00000001)
			    (setq vAng (abs (- vAng 360.0)))
			    )
			  (if (>= vAng 180.000000001)
			    (setq vAng (- vAng 180.0))
			    )
			  (if (> vAng 90.000001)
			    (setq vAng (- vAng 90.0))
			    )
			  
			  (setq vAng (vl-string-subst "°" "d" (angtos vAng 1 4)))
			  (setq vAng (strcat "LT " vAng))
			  )
			(progn
			  (if (> ang1 270.0000000001)
			    (setq ang1 (- ang1 360))
			    )
			  (if (> ang2 270.00000001)
			    (setq ang2 (- ang2 360))
			    )
			  (setq vAng (abs(- ang1 ang2)))
			  
			  (if (>= vAng 270.000000001)
			    (setq vAng (abs (- vAng 360.0)))
			    )
			  (if (>= vAng 180.0000000001)
			    (setq vAng (- vAng 180.0))
			    )
			  (if (> vAng 90.000001)
			    (setq vAng (- vAng 90.0))
			    )
			  (setq vAng (vl-string-subst "°" "d" (angtos vAng 1 4)))
			  (setq vAng (strcat "RT " vAng))
			  )
			)
		    )
		  (progn
		    (setq p1 (nth (- ct 1) ptLst))
		    (setq vDist (rtos (distance p1 vert) 2 4))
		    (setq vAng "-")
		    )
		  )
		(progn
		  (setq vDist "0.000")
		  (setq vAng "-")
		  )
		)
	      
	      (setq tLst(append tLst
			  (list(list r 0 (nth lCnt lLst))
			  (list r 1(rtos(car vert)2 4))
			  (list r 2(rtos(cadr vert)2 4))
			  (list r 3 "")
			  (list r 4 vDist)
			  (list r 5 vAng))))
	      (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 4))
			    (list r 2(rtos(cadr pCen)2 4))
			    (list r 3(rtos cRad 2 4))))
		      ); end setq
		); end if
	      (setq r(1+ r) lCnt(1+ lCnt))
	      (setq prVert vert)
	      (setq ct (1+ ct))
	      ); end foreach
;;;	  (setq vlaTab(vla-AddTable mSp (vlax-3D-point '(0 0 0))
;;;			(+ 1(/(length tLst)4)) 4 (* 3 tHt)(* 18 tHt)))
	  (setq vlaTab(vla-AddTable mSp (vlax-3D-point '(0 0 0))
			(+ 1(/(length tLst)6)) 6 (* 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<<< Place Table >>> ")
	  (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)))
	      (progn
		(setq fDr(vlax-curve-getFirstDeriv vlaPl (vlax-curve-getParamAtPoint vlaPl v)))
		(if (or (= (car fDr) 0) (= (cadr fDr) 0))
		  (setq iPt(trans (polar v (- (* 2 pi) (atan (* 5 tHt))) (* 2 tHt))0 1))
		  (setq iPt(trans (polar v (- (* 2 pi) (atan (/ (car fDr) (cadr fDr)))) (* 2 tHt))0 1))
		  )
	     ); end Progn
	      ); 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

(defun calculateAngle (dx dy ang)
  (setq retVal 0)
  (If (and (< dx 0) (>= dy 0))
    (setq retVal (- ang 450))
    (if (and (>= dx 0) (>= dy 0))
      (setq retVal (- ang 90))
      (if (and (< dx 0) (< dy 0))
	(setq retVal (- ang 90))
	(if (and (>= dx 0) (< dy 0))
	  (setq retVal (- ang 90))
	  )
	)
      )
    )
    
  (abs retVal)
  ); end of c:TABORD

john.uhden · ‎08-21-2024

@hiraram_prajapati ,

And if you want the degree character ° then use (chr 176)

John F. Uhden

john.uhden · ‎08-21-2024

@hiraram_prajapati ,

Enter new value for DIMZIN <8>: 1

Command: (angtos ang 1 4)
"13d0'0\""

Command: (vl-string-subst (chr 176) "d" (angtos ang 1 4))
"13°0'0\""

I have a very old one somewhere to double-up the zeros. Here it is...

(defun @angdms (ang dsym n)
   (if (= (type ang) 'REAL)
      (setq ang (angtos ang 1 n) n 1)
      (setq n 1)
   )
   (while (/= (substr ang n 1) "d")(setq n (1+ n)))
   (if (= n 2) (setq ang (strcat "0" ang) n 3))
   (setq ang (strcat (substr ang 1 (1- n)) dsym (substr ang (1+ n))))
   (setq n (+ n (1- (strlen dsym))))
   (if (= (substr ang (+ n 2) 1) "'")
      (setq ang (strcat (substr ang 1 n) "0" (substr ang (1+ n))) n (+ n 3))
      (setq n (+ n 3))
   )
   (if (or (= (substr ang (+ n 2) 1) ".")(= (substr ang (+ n 2) 1) (chr 34)))
      (setq ang (strcat (substr ang 1 n) "0" (substr ang (1+ n))))
   )
   ang
)

As in...

Command: (@angdms ang (chr 176) 4)
"13°00'00\""

John F. Uhden

hiraram_prajapati · ‎08-21-2024

Dear Sir,

DDMMSS Format working fine and working fine, But Degree coming wrong.

What i want i shown in Line in magnet color.

I have attached AutoCAD and Image for your reference and correction.

Thank you, please update.

komondormrex · ‎08-21-2024

check this another one

(defun vectors_angle (vector_1 vector_2 / x1 y1 z1 x2 y2 z2 ccw cos_a sin_a alpha)
  	(mapcar 'set '(x1 y1 z1) (mapcar '- (cadr vector_1) (car vector_1)))
  	(mapcar 'set '(x2 y2 z2) (mapcar '- (cadr vector_2) (car vector_2)))
	(setq ccw (not (minusp (caddr (list (- (* y1 z2) (* z1 y2)) (- (* z1 x2) (* x1 z2)) (- (* x1 y2) (* y1 x2))))))
		  cos_a (/ (+ (* x1 x2) (* y1 y2) (* z1 z2))
				   (* (sqrt (apply '+ (mapcar '(lambda (number) (expt number 2)) (list x1 y1 z1))))
					  (sqrt (apply '+ (mapcar '(lambda (number) (expt number 2)) (list x2 y2 z2))))
				   )
				)
		  sin_a (sqrt (- 1 (expt cos_a 2)))
	)
	(cond
		((zerop cos_a) (cons ccw (* 0.5 pi)))
		((zerop (setq alpha (atan (/ sin_a cos_a)))) (cons nil pi))
		((minusp alpha) (cons ccw (+ pi alpha)))
		(t (cons ccw alpha))
	)
)

(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 '("START POINT" "IP-01" "IP-02" "IP-03" "IP-04" "IP-05" "IP-06" "IP-07" "IP-08" "IP-09" "IP-10" "IP-11" "IP-12""IP-13" "IP-14" "IP-15" "IP-16" "IP-17" "IP-18" "IP-19" "IP-20" "IP-21" "IP-22" "IP-23" "IP-24" "IP-25" "IP-26" "IP-27" "IP-28" "IP-29" "IP-30" "IP-31" "IP-32" "IP-33" "IP-34" "IP-35" "IP-36" "IP-37" "IP-38" "IP-39" "IP-40" "IP-41" "IP-42" "IP-43" "IP-44" "IP-45" "IP-46" "IP-47" "IP-48" "IP-49" "IP-50" "IP-51" "IP-52" "IP-53" "IP-54" "IP-55" "IP-56" "IP-57" "IP-58" "IP-59" "IP-60" "IP-61" "IP-62" "IP-63"	"IP-64" "IP-65" "IP-66" "IP-67" "IP-68" "IP-69" "IP-70" "IP-71" "IP-72" "IP-73" "IP-74" "IP-75" "IP-76" "IP-77" "IP-78" "IP-79" "IP-80" "IP-81" "IP-82" "IP-83" "IP-84" "IP-85" "IP-86" "IP-87" "IP-88" "IP-89" "IP-90" "IP-91" "IP-92" "IP-93" "IP-94" "IP-95" "IP-96" "IP-97" "IP-98" "IP-99" "IP-100" "IP-101" "IP-102" "IP-103" "IP-104" "IP-105" "IP-106" "IP-107" "IP-108" "IP-109" "IP-110")
		r 2 lCnt 0
		;tLst '((1 0 "Point")(1 1 "EASTING")(1 2 "NORTHING")(1 3 "Radius"))
		tLst '((1 0 "Point")(1 1 "EASTING")(1 2 "NORTHING")(1 3 "Radius")(1 4 "Distance")(1 5 "Bend"))
		mSp(vla-get-ModelSpace
		     (vla-get-ActiveDocument
		       (vlax-get-acad-object)))
		tHt(getvar "TEXTSIZE")
	  ); end setq
	    (setvar "CMDECHO" 0)
	    (setq prVert nil)
	    (setq prAng nil)
	    (setq ct 0)
	    (foreach vert ptLst
	      (setq vert(trans vert 0 1))
	      (if (/= ct 0)
		(if (/= ct (- (length ptLst) 1 ))
		  (progn
		    (setq p1 (nth (- ct 1) ptLst))
		    (setq p3 (nth (+ ct 1) ptLst))
		    (setq vDist (rtos (distance p1 vert) 2 4))
		    (setq vAng (vectors_angle (list p1 vert) (list vert p3)))
		    (setq vAng (strcat (if (car vAng) "LT" "RT") (vl-string-subst "°" "d" (angtos (cdr vAng) 1 4))))
		   )
		  (progn
		    (setq p1 (nth (- ct 1) ptLst))
		    (setq vDist (rtos (distance p1 vert) 2 4))
		    (setq vAng "-")
		    )
		  )
		(progn
		  (setq vDist "0.000")
		  (setq vAng "-")
		  )
		)

		(print
	      (setq tLst (append tLst
			  (list(list r 0 (nth lCnt lLst))
			  (list r 1(rtos(car vert)2 4))
			  (list r 2(rtos(cadr vert)2 4))
			  (list r 3 "")
			  (list r 4 vDist)
			  (list r 5 vAng)))
	      ))
	      (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 4))
			    (list r 2(rtos(cadr pCen)2 4))
			    (list r 3(rtos cRad 2 4))))
		      ); end setq
		); end if
	      (setq r(1+ r) lCnt(1+ lCnt))
	      (setq prVert vert)
	      (setq ct (1+ ct))
	      ); end foreach
;;;	  (setq vlaTab(vla-AddTable mSp (vlax-3D-point '(0 0 0))
;;;			(+ 1(/(length tLst)4)) 4 (* 3 tHt)(* 18 tHt)))
	  (setq vlaTab (vla-AddTable mSp (vlax-3D-point '(0 0 0))
			(+ 1(/ (length tLst)6)) 6 (* 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<<< Place Table >>> ")
	  (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)))
	      (progn
		(setq fDr(vlax-curve-getFirstDeriv vlaPl (vlax-curve-getParamAtPoint vlaPl v)))
		(if (or (= (car fDr) 0) (= (cadr fDr) 0))
		  (setq iPt(trans (polar v (- (* 2 pi) (atan (* 5 tHt))) (* 2 tHt))0 1))
		  (setq iPt(trans (polar v (- (* 2 pi) (atan (/ (car fDr) (cadr fDr)))) (* 2 tHt))0 1))
		  )
	     ); end Progn
	      ); 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)
    )

hiraram_prajapati · ‎08-22-2024

Thank you so much help.....
It is working very fine.

Community

I want full degree mints and second format (DDMMSS) IN TABLE

I want full degree mints and second format (DDMMSS) IN TABLE

I want full degree mints and second format (DDMMSS) IN TABLE