generate X & Y coordinates into table

July 16, 2008

I am confused, I can't get it to work as it was

Something don't work in 2005? Try to copy code one more time. I want to know which moment it goes to error.

ASMI, could you please put a header in your programmes with your name and the date and time of the latest version? Then in years to come, we can remember the author of these very useful routines. Thank you

I will to publish this program in my website, there is headers with describtion and dates of latest version. This is temp version only.

Now works ok?

I should to test it in 2005

July 16, 2008

OK, I just copied TabOrd2 again, and after the prompt "Select LwPoliline" and Please Wait... I got a table at 0,0 and no vertex numbering.

July 16, 2008

********* Edited **********

Yes it will to work in 2005. I don't know in how version appears proprerties 'RepeatTopLabels' and 'BreakSpacing' but you can to remove comments from lines:

;;;(vla-put-RepeatTopLabels vlaTab :vlax-true)

;;;(vla-put-BreakSpacing vlaTab (* 3 tHt))

for column headings in tables divided to sevral columns (not in 2005 - 2006 I think).

(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 actDoc
	tPt1 tPt2 cAng tiPt oSnp *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)
   (if oSnp(setvar "OSMODE" oSnp))
   (if mSp(vla-EndUndoMark actDoc))
   (princ)
   ); end of *error*

 (defun Alph_Num(Counter / lLst cRes)
 (setq 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"))
 (if(<= 1.0(setq cRes(/ Counter 26.0)))
    (strcat(itoa(fix cRes))
   (nth(- Counter(* 26(fix cRes)))lLst))
    (nth Counter lLst)
   ); end if
 ); end of Alph_Num

 (if
   (and
     (setq cPl(entsel "\nSelect LwPoliline > "))
     (= "LWPOLYLINE"(car(Extract_DXF_Values(car cPl)0)))
     ); end and
(progn
  (princ "\nPlease Wait... \n")
  (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)))
	r 2 lCnt 0
	tLst '((1 0 "Point")(1 1 "X")(1 2 "Y")(1 3 "Radius"))
	actDoc(vla-get-ActiveDocument
	       (vlax-get-acad-object))
	mSp(vla-get-ModelSpace actDoc)
	tHt(getvar "TEXTSIZE")
	    ); end setq
    (setvar "CMDECHO" 0)
    (setq oSnp(getvar "OSMODE"))
    (vla-StartUndoMark actDoc)
    (foreach vert ptLst
      (setq vert(trans vert 0 1)
	    tLst(append tLst
		  (list(list r 0(Alph_Num lCnt))
		  (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)(* 20 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-put-VertCellMargin vlaTab (* 0.75 tHt))
  (vla-put-Height vlaTab(* 1.75(/(length tLst)4)))
  (vla-SetColumnWidth vlaTab 0 (* 10 tHt))
  (vla-SetColumnWidth vlaTab 3 (* 12 tHt))
;;;	  (vla-put-RepeatTopLabels vlaTab :vlax-true)
;;;	  (vla-put-BreakSpacing vlaTab (* 3 tHt))
  (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 tPt1(vlax-curve-GetPointAtParam vlaPl
		  (- lCnt 0.0000001))
	    tPt2(vlax-curve-GetPointAtParam vlaPl
		  (+ lCnt 0.0000001))
	    iPt(polar v(+(* pi 0.5)(if(minusp
		(setq cAng(angle tPt1(if tPt2 tPt2
		   (polar tPt1(* 0.5 pi)0.0000001)))))
		cAng(- cAng)))(* 2 tHt))
	    ); end setq
      ); end if
    (setvar "OSMODE" 0)
    (setq cTxt(vla-AddText mSp(Alph_Num lCnt)
	       (vlax-3d-point iPt) tHt)
	  tiPt(vla-get-InsertionPoint cTxt)
	  lCnt(1+ lCnt)
	  ); end setq
    (vla-put-Alignment cTxt 10)
    (vla-put-TextAlignmentPoint cTxt tiPt)
    (setq oldCol(getvar "CECOLOR"))
    (setvar "CECOLOR" "1")
    (command "_.circle" v (/ tHt 3))
    (setvar "CECOLOR" oldCol)
    ); end foreach
  (setvar "OSMODE" oSnp)
  (setvar "CMDECHO" 1)
  (vla-EndUndoMark actDoc)
  ); end progn
    (princ "\n<!> It isn't LwPolyline! Quit. <!> ")
   ); end if
   (gc)
   (princ)
   ); end of c:tabord

(defun c:tabord2(/ 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 actDoc
	tPt1 tPt2 cAng tiPt oSnp *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)
     (if oSnp(setvar "OSMODE" oSnp))
     (if mSp(vla-EndUndoMark actDoc))
   (princ)
   ); end of *error*

 (if
   (and
     (setq cPl(entsel "\nSelect LwPoliline > "))
     (= "LWPOLYLINE"(car(Extract_DXF_Values(car cPl)0)))
     ); end and
(progn
  (princ "\nPlease Wait... \n")
  (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)))
	r 2 lCnt 0
	tLst '((1 0 "Point")(1 1 "X")(1 2 "Y")(1 3 "Radius"))
	actDoc(vla-get-ActiveDocument
	       (vlax-get-acad-object))
	mSp(vla-get-ModelSpace actDoc)
	tHt(getvar "TEXTSIZE")
	    ); end setq
    (vla-StartUndoMark actDoc)
    (setvar "CMDECHO" 0)
    (setq oSnp(getvar "OSMODE"))
    (foreach vert ptLst
      (setq vert(trans vert 0 1)
	    tLst(append tLst
		  (list(list r 0(itoa(1+ lCnt)))
		  (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)(* 20 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-put-VertCellMargin vlaTab (* 0.75 tHt))
  (vla-put-Height vlaTab(* 1.75(/(length tLst)4)))
  (vla-SetColumnWidth vlaTab 0 (* 10 tHt))
  (vla-SetColumnWidth vlaTab 3 (* 12 tHt))
;;;	  (vla-put-RepeatTopLabels vlaTab :vlax-true)
;;;	  (vla-put-BreakSpacing vlaTab (* 3 tHt))
  (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 tPt1(vlax-curve-GetPointAtParam vlaPl
		  (- lCnt 0.0000001))
	    tPt2(vlax-curve-GetPointAtParam vlaPl
		  (+ lCnt 0.0000001))
	    iPt(polar v(+(* pi 0.5)(if(minusp
		(setq cAng(angle tPt1(if tPt2 tPt2
		   (polar tPt1(* 0.5 pi)0.0000001)))))
		cAng(- cAng)))(* 2 tHt))
	    ); end setq
      ); end if
    (setvar "OSMODE" 0)
    (setq cTxt(vla-AddText mSp(itoa(1+ lCnt))
	       (vlax-3d-point iPt) tHt)
	  tiPt(vla-get-InsertionPoint cTxt)
	  lCnt(1+ lCnt)
	  ); end setq
    (vla-put-Alignment cTxt 10)
    (vla-put-TextAlignmentPoint cTxt tiPt)
    (setq oldCol(getvar "CECOLOR"))
    (setvar "CECOLOR" "1")
    (command "_.circle" v (/ tHt 3))
    (setvar "CECOLOR" oldCol)
    ); end foreach
  (setvar "OSMODE" oSnp)
  (setvar "CMDECHO" 1)
  (vla-EndUndoMark actDoc)
  ); end progn
    (princ "\n<!> It isn't LwPolyline! Quit. <!> ")
   ); end if
   (gc)
   (princ)
   ); end of c:tabord2

July 16, 2008

It works perfectly!

July 16, 2008

I must have done something wrong the first time. I have just downloaded TabOrd2 again, and it is working perfectly with the numbers.

Sorry for the confusion and extra work

July 16, 2008

I must have done something wrong the first time. I have just downloaded TabOrd2 again, and it is working perfectly with the numbers.

Sorry for the confusion and extra work

In both of codes was two strings incompatale with 2005. I has correct it and it start to work normal.

July 17, 2008

Dear ASMI,

I tried to download the two codes. I tried it but didnt work. Im using 2002 version. Can you make it work in a lower version. Thanks.

July 17, 2008

No it can't to work in lower versions because Table entity (block) missed.

July 17, 2008

No it can't to work in lower versions because Table entity (block) missed.

Hi Asmi, i tried to compile into .fas format the code error message is coming.

; (COMPILE-FILES st (R:/CAD_Admin/CAD_Admin_Architecture/Lisp/tabord.lsp))

[Analyzing file "R:/CAD_Admin/CAD_Admin_Architecture/Lisp/tabord.lsp"]

.

[COMPILING R:/CAD_Admin/CAD_Admin_Architecture/Lisp/tabord.lsp]

;;C:TABORD

;EXTRACT_DXF_VALUES

;*ERROR*

;ALPH_NUM

[FASDUMPING object format -> "R:/CAD_Admin/CAD_Admin_Architecture/Lisp/tabord.fas"]

; Compilation complete.

thanks again,

the courage dog

July 17, 2008

Hi Asmi, i tried to compile into .fas format the code error message is coming.

This isn't compile error, this name of standard built-in error handler function *ERROR*. This all is Ok.

July 17, 2008

This is latest version http://www.asmitools.com/Files/Lisps/Tabcord.html with some parameters adjustment. You can change this variables to adjust this program to your goals. Header, Area, Perimeter and Gavity Center rows can be added. New program name is TABCORD.

Adjustment section:

;;;  ****************************************************************
;;;  *************************** ADJUSTMENT *************************
;;;  ****************************************************************

 (setq mType nil) 	; Markups mode. T - digits, NIL - letters
 
 (setq tHt -1.0)    	; Table text size. Positive - absolute,
                       ; negative multiplayer to TEXTSIZE variable
 
 (setq mHt -2.0)	; Markups text size. Positive - absolute,
                       ; negative - multiplayer to TEXTSIZE variable
 
 (setq cAcu 4)    	; Precision of coordinates (from 0 to 

 (setq dHead nil)   	; If T delete table header, if NIL not delete

 (setq hStr "Land # ") ; Standard header (if dHead not equal T)

 (setq hHt -1.25)      ; Header text size. Positive - absolute,
                       ; negative - multiplayer to TEXTSIZE variable
 
 (setq w1 -10.0)       ; 'Point' column width. Positive - absolute,
                       ; negative - multiplayer to TEXTSIZE variable

 (setq w2 -20.0)       ; 'X' and 'Y' colums width. Positive - absolute,
                       ; negative - multiplayer to TEXTSIZE variable

 (setq w3 -12.0)       ; 'Radius' column width. Positive - absolute,
                       ; negative - multiplayer to TEXTSIZE variable
 
 (setq isPer T)	; if T adds perimeter row

 (setq isAre T)        ; if T adds area row

 (setq isGCen T)       ; if T adds center of gravity row

 (setq pMul 0.001)     ; perimeter multiplayer

 (setq aMul 0.000001)  ; area  multiplayer

;;;  ****************************************************************
;;;  ************************* END ADJUSTMENT ***********************
;;;  ****************************************************************

For example:

July 23, 2008

Fantastic tool ASMI well done . . .

. . . is there any way you can convert the code to pick up points on a 3D polyline and give Z values in the table also?

If not no worries

Dave

July 23, 2008

No problem. I can make it at this weekend I think.

July 23, 2008

Champion

July 26, 2008

> daveyboyd

X,Y,Z for 3D-Poly: http://www.asmitools.com/Files/Lisps/3cord.html

July 29, 2008

That is absoultley fantastic ASMI thank you very much. It works a treat!

January 15, 2009

ASMI's code looks great, but if you are looking for another method, you might want to try this:

rockmaster.wordpress.com/2009/01/14/introducing-the-autocad-coordinizer/

January 15, 2009

Is it JavaScript?

January 15, 2009

No, it uses Python.

March 21, 2009

hello..i was impressed about that tabcord...any update about tabcord..the area sign is by acre..not in sq.m..and the decimal 4 not 2..sorry about that but it is very useful to me..as a land surveyor here in Philippines.

thank you.

oliver

Sign In

generate X & Y coordinates into table

Recommended Posts

ASMI

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

fixo

ASMI

Posted Images

eldon

ASMI

eldon

eldon

ASMI

guyzen2004

ASMI

The Courage Dog

ASMI

ASMI

daveyboyd

ASMI

daveyboyd

ASMI

daveyboyd

Rockmaster

ASMI

Rockmaster

oliver

Join the conversation

fixo

ASMI

Tutorials

Forums

Activity