Create table

**satishrajdev** · 4th Jul 2012 01:21 pm

Hi,

i want a help tp solve my problem

i have a lisp of tabord which is as follows

Code:

(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

**jvillarreal** · 6th Jul 2012 05:36 pm

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

Code:

(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

**satishrajdev** · 7th Jul 2012 11:00 am

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

Code:

(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

**jvillarreal** · 10th Jul 2012 04:22 pm

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

**jvillarreal** · 10th Jul 2012 07:08 pm

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

Code:

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

Thread: Create table

Thread Tools

Create table

Similar Threads

The best way to create those 3d Table and Chairs. Help please!

Create table with DCL

Create table for quantities

How to create a Table in AutoCAD?

Create a TABLE using lisp

Bookmarks

Bookmarks

Posting Permissions