generate X & Y coordinates into table

[The Courage Dog]

I working on urban planning drawings where i work on huge numbers of villas everyday. All the property limit of villas are POLYLINE. I'am taking X & Y coordianteseach of corner of the polyline (villa) one by one & pasting it into table (see the image) ...i know this is a very slow method. Is anybody down there who has the code to make this automatic...i mean by just clicking the POLYLINE & it will automatically gets all the X & Y coordinates (i mean all the corners) & put it automatically on the TABLE.

your help is very much appreciated.

Thanks.

[fixo]

Give that a try

~'J'~

[The Courage Dog]

thanks Fixo, i'll try it.

[The Courage Dog]

Give that a try

~'J'~

I try your code & it didn't work. there's an error saying: ; error: AutoCAD.Application: AcRxClassName entry is not in the system registry

what does it mean?

[SEANT]

I’m not sure about the source of the error but I can say, once that issue is sorted out, you will be quite pleased with the performance of the routine. Nice work Fixo.

[fixo]

I try your code & it didn't work. there's an error saying: ; error: AutoCAD.Application: AcRxClassName entry is not in the system registry

what does it mean?

What the Acad version you uses?
Guess the problem is with 'AutoCAD.AcCmColor' object
Try other helper function instead:

(defun add-table-style (adoc / ;|acmcol|; adoc clsname keyname newstyleobj tbldict tblstylename)
  
  (setq	tbldict
	 (vla-item
	   (vla-get-dictionaries
	     (vla-get-database adoc)
	   )
	   "Acad_TableStyle"
	 )
  )
  (setq	keyname	     "NewStyle"
	clsname    "AcDbTableStyle"
	tblstylename "Coordinates" ;change name
  )
  (setq	newstyleobj
	 (vlax-invoke tbldict 'Addobject keyname clsname)
  )
  (vlax-put newstyleobj 'TitleSuppressed :vlax-false)
  (vlax-put newstyleobj 'HeaderSuppressed :vlax-false)
;;;  (setq	acmcol (vla-GetInterfaceObject
;;;		 (vlax-get-acad-object)
;;;		 (strcat "AutoCAD.AcCmColor." (itoa (atoi (getvar "acadver"))))
;;;	       )
;;;  )
;;;  (vlax-put acmcol 'Colorindex 24)
  (vlax-put newstyleobj 'Name TblStyleName)
  (vlax-put newstyleobj 'Description "Coordinates Table")
  (vlax-put newstyleobj 'BitFlags 1)
  (vlax-put newstyleobj 'HorzCellMargin 0.06)
  (vlax-put newstyleobj 'VertCellMargin 0.06)

;;;  (vlax-invoke newstyleobj 'SetColor acDataRow acmcol)
  (vlax-invoke newstyleobj
	    'SetBackgroundColorNone
	    acDataRow
	    :vlax-false
  )
  (vlax-invoke newstyleobj 'SetTextStyle acDataRow "Standard")
;;;  (vlax-invoke newstyleobj 'SetTextHeight acTitleRow 0.25)
  (vlax-invoke newstyleobj 'SetTextHeight acHeaderRow 0.2)
  (vlax-invoke newstyleobj 'SetTextHeight acDataRow 0.18)
  (vlax-invoke newstyleobj 'SetGridVisibility acVertInside acDataRow
	    :vlax-true)
  (vlax-invoke newstyleobj
	    'SetAlignment
	    acDataRow
	    acMiddleCenter
  )
  (vla-update newstyleobj)
;;;  (vlax-release-object acmcol)
  ;| ETC |;
  (princ)
)

~'J'~

[fixo]

I’m not sure about the source of the error but I can say, once that issue is sorted out, you will be quite pleased with the performance of the routine. Nice work Fixo.

Hi, SEANT
Thanks for the kind words
Happy computing

~'J'~

[ASMI]

> The Courage Dog

I have not forgotten about you. Simply it has borrowed 2 hours of time per quiet conditions. But quiet conditions was not. I feel that on this site is time to take holiday... Another one, text size depends on TEXTSIZE sysem variable (and table dimensions also):

(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 '("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")
		r 2 lCnt 0
		tLst '((1 0 "Point")(1 1 "X")(1 2 "Y")(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

[ASMI]

In code above was one bug. Now it works ok.

[The Courage Dog]

you are a real genius, this code is fantastic....this is exactly what i'm lookingfor.....thanks Asmi.

Thanks to you also Mr. Fixo