generate X & Y coordinates into table

[ASMI]

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

[eldon]

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.

[ASMI]

********* 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

[eldon]

It works perfectly!

[eldon]

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

[ASMI]

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.

[guyzen2004]

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.

[ASMI]

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

[The Courage Dog]

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

[ASMI]

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.

[ASMI]

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:

[daveyboyd]

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

[ASMI]

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

[daveyboyd]

Champion

[ASMI]

> daveyboyd

 

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

[daveyboyd]

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

[Rockmaster]

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/

[ASMI]

Is it JavaScript?

[Rockmaster]

No, it uses Python.

[oliver]

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