Create table

July 4, 2012

Hi,

i want a help tp solve my problem

i have a lisp of tabord which is as follows

(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 '("1" "2" "3" "4" "5" "6" "7" "8" "9" "10" "11" "12" "13"
		"14" "15" "16" "17" "18" "19" "20" "21" "22" "23" "24" "25" 

"26" "27" "28" "30" "31" "32" "33" "34" "35" "36" "37" "38" "39" "40" "41" "42" 

"43" "44" "45" "46" "47" "48" "49" "50")
	r 2 lCnt 0
	tLst '((1 0 "Sr. No.")(1 1 "Easting")(1 2 "Northing")(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 4))
		  (list r 2(rtos(cadr vert)2 4))
		  (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 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))
      ); 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<<< 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)))
     (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

i have attached a drawing which has 2 tables

1. which i have drawn from this lisp

2. which i have drawn manually (which is my requirement)

Can anybody help me to change this lisp to draw table according to my requirement.

thanks a lot

Drawing2.dwg

July 6, 2012

Not sure if you've figured this out or not but work is slow today so...

You can output your desired format with 4 minor modifications to the code.

As commented:

1. Modify the "r" variable to account for your new rows

2. Add your desired headers to the "tLst" variable

3. Modify the arguments in your vla-addtable method to account for new rows / columns

4. Use the vla-mergecells method for your desired format

(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 '("1" "2" "3" "4" "5" "6" "7" "8" "9" "10" "11" "12" "13"
  "14" "15" "16" "17" "18" "19" "20" "21" "22" "23" "24" "25" "26" "27" "28" "30" "31" "32" "33" "34" "35" "36" "37" "38" "39" "40" "41" "42" "43" "44" "45" "46" "47" "48" "49" "50")
 r 3 lCnt 0 ; MODIFIED "R" or row to begin adding point data
;ADDED HEADERS
 tLst '((1 0 "Sr. No.")(1 1 "UTM CO-ORDINATES (M)")(1 3 "GEOGRAPHICAL CO-ORDINATES")(2 1 "Easting")(2 2 "Northing")(2 3 "Latitude (N)")(2 4 "Longitude (E)"))
 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 4))
    (list r 2(rtos(cadr vert)2 4))
    (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 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))
      ); end foreach
  (setq vlaTab(vla-AddTable mSp (vlax-3D-point '(0 0 0))
  (+ 2(/(length tLst)4)) 5 (* 4 tHt)(* 24 tHt)));----------------------MODIFIED TO ACCOUNT FOR NEW ROWS / COLUMNS
  (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-mergecells vlatab 1 2 0 0);---------------------------------Added these 3 lines for your desired format
         (vla-mergecells vlaTab 1 1 1 2)
         (vla-mergecells vlaTab 1 1 3 4)
  (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)))
     (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

July 7, 2012

thanks a lot jvillarreal

you really made it easy................

but i have one more query

Now, i have a lisp which converts X,Y coordinates to Geographic coordinates in WGS 1984 Datum

The lisp is as follows

(defun C:GDMS ()

 (setq lonzone (getint "\n Enter Zone:"))

 (initget "N S")
 (setq Hem (getkword "\n Enter the Hemisphere (S/N):"))

 (setq Pnt (Getpoint "\n Specify Point:"))

 (setq Xval (car Pnt))

 (setq Yval (car (cdr Pnt)))

 (if (= Hem "S")
   (setq Y (- 10000000 Yval))
   (setq Y Yval)
 )

 (if (and (or (= Hem "S") (= Hem "N")) (= Yval 0.0))
   (progn
     (setq Y Yval)
     (setq Hem "Equator")
   )
   (progn
     (setq Y Y)
     (Setq Hem Hem)
   )
 )


 (setq b 6356752.3142)

 (setq a 6378137.0)

 (setq X (- 500000.0 Xval))

 (setq e (sqrt (- 1.0 (expt (/ b a) 2.0))))

 (setq k0 0.9996)

 (setq meridional-arc (/ Y k0))

 (setq	mu (/ meridional-arc
      (* a
	 (- 1
	    (/ (expt e 2) 4)
	    (/ (* 3 (expt e 4)) 64)
	    (/ (* 5 (expt e 6)) 256)
	 )
      )
   )
 )

 (setq	e1 (/ (- 1 (expt (- 1 (expt e 2)) 0.5))
      (+ 1 (expt (- 1 (expt e 2)) 0.5))
   )
 )

 (setq j1 (- (/ (* 3 e1) 2) (/ (* 27 (expt e1 3)) 32)))

 (setq j2 (- (/ (* 21 (expt e1 2)) 16) (/ (* 55 (expt e1 4)) 32)))

 (setq j3 (/ (* 151 (expt e1 3)) 96))

 (setq j4 (/ (* 1097 (expt e1 4)) 512))

 (setq	footprint-latitude
 (+ mu
    (* j1 (sin (* 2.0 mu)))
    (* j2 (sin (* 4.0 mu)))
    (* j3 (sin (* 6.0 mu)))
    (* j4 (sin (* 8.0 mu)))
 )
 )

 (setq eprime2 (/ (* e e) (- 1.0 (* e e))))

 (setq c1 (* eprime2 (expt (cos footprint-latitude) 2)))

 (setq	t1 (expt (/ (sin footprint-latitude) (cos footprint-latitude))
	 2
   )
 )

 (setq	r1 (/ (* a (- 1 (expt e 2)))
      (expt (- 1
	       (* (expt e 2)
		  (expt (sin footprint-latitude) 2)
	       )
	    )
	    1.5
      )
   )
 )

 (setq	n1 (/ a
      (expt (- 1
	       (* e
		  e
		  (sin footprint-latitude)
		  (sin footprint-latitude)
	       )
	    )
	    0.5
      )
   )
 )

 (setq d (/ X (* n1 k0)))

 (setq
   q1 (/ (* n1 (/ (sin footprint-latitude) (cos footprint-latitude)))
  r1
      )
 )

 (setq q2 (/ (* d d) 2))

 (setq	q3 (/ (* (- (+ 5
	       (* 3 t1)
	       (* 10 c1)
	    )
	    (* 4 c1 c1)
	    (* 9 eprime2)
	 )
	 (expt d 4)
      )
      24
   )
 )

 (setq	q4 (/ (* (- (+ 61
	       (* 90 t1)
	       (* 298 c1)
	       (* 45 t1 t1)
	    )
	    (* 3 c1 c1)
	    (* 252 eprime2)
	 )
	 (expt d 6)
      )
      720
   )
 )

 (setq q6 (/ (* (+ 1 (* 2 t1) c1) (expt d 3)) 6))

 (setq	q7 (/ (*
	(+ (- (+ (- 5 (* 2 c1)) (* 28 t1)) (* 3 c1 c1))
	   (* 8 eprime2)
	   (* 24 t1 t1)
	)
	(expt d 5)
      )
      120
   )
 )

 (setq zone-cm (- (* 6.0 lonzone) 183.0))

 (setq lat (- footprint-latitude (* q1 (+ (- q2 q3) q4))))

 (setq latitude (* (/ 180 pi) lat))
 (if (> latitude 90.0)
   (setq latitude 90.0)
   (setq latitude latitude)
 )

 (setq latdeg (fix latitude))
 (setq latmins (* (- latitude (fix latitude)) 60))
 (setq latsecs (* (- latmins (fix latmins)) 60))

 (setq long (/ (+ (- d q6) q7) (cos footprint-latitude)))

 (setq longr (* (/ 180 pi) long))

 (setq longitude (- zone-cm longr))

 (if (< longitude 0.0)
   (setq lonhem "W")
   (setq lonhem "E")
 )

 (if (< longitude 0.0)
   (setq longitude (* -1 longitude))
   (setq longitude longitude)
 )

 (setq londeg (fix longitude))
 (setq lonmins (* (- longitude (fix longitude)) 60))
 (setq lonsecs (* (- lonmins (fix lonmins)) 60))

 (princ (strcat "\n Latitude : "
	 (itoa latdeg)
	 "°"
	 (itoa (fix latmins))
	 "'"
	 (rtos latsecs 2 2)
	 "''"
	 Hem
 )
 )
 (princ (strcat "\n Longitude: "
	 (itoa londeg)
	 "°"
	 (itoa (fix lonmins))
	 "'"
	 (rtos lonsecs 2 2)
	 "''"
	 lonhem
 )
 )
 (princ (strcat "\n   Easting: "
	 (rtos Xval 2 3)
	 "\n  Northing: "
	 (rtos Yval 2 3)
 )
 )
 (princ)
)

i want to modify tobard.lsp lisp again filled latitude & longitude in table using this lisp. Is it possible to merge this lisp in tobard.lsp which you have given?

i tried a lot from different ways but didn't find out any results.

i have attached file for the example

I have used Zone - 42 and Hemisphere - N

Drawing2.dwg

July 10, 2012

Share your latest attempt to combine the routines and i will gladly help.

July 10, 2012

Hint:

Modify the GDMS routine to accept the zone, hemisphere and point as arguments :

(defun GDMS ( lonzone hem pnt /  xval yval y b a x e k0 meridional-arc mu e1 j1 j2 j3 j4 footprint-latitude
                        eprime2 c1 t1 r1 n1 q1 q2 q3 q4 q5 q6 q7 zone-cm latitude lat latdeg latmins latsecs long
                        longr longitude longdeg longmins longsecs)

then modify the output to set variables you can use in your tabord routine.

Sign In

Create table

Recommended Posts

satishrajdev

jvillarreal

satishrajdev

jvillarreal

jvillarreal

Join the conversation

Tutorials

Forums

Activity