Customization - Extracting info from CAD

[Yamishon_Noah]

Hello,

I would like to some customization on DATAEXTRACTION+insert blocks.

Actually I want each vertex coordinate of polyline simply in csv file.

I am doing as below in 2 steps.

step - 1

 Placing circle on each vertex of polyline using below said lisp

(defun c:mkc ( / obj c i x y e)
  (vl-load-com)
  (setq *model-space* (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
  (setq obj (vlax-ename->vla-object (car (entsel))))
  (setq c (vlax-get obj "Coordinates")
        i 0
        e (vla-get-elevation obj)
  )
  (repeat (/ (length c) 2)
    (setq x (nth i c)
          y (nth (1+ i) c)
    )
    (vla-addcircle *model-space* (vlax-3d-point (list x y e)) 1.0)
    (setq i (+ i 2))
  )
  (princ)
)

Step - 2

Using -DATAEXTRACTION I am getting coordinates of drawn circles.

I have to do these for more than 100 drawings every time..!!!!

So here I want to customize step-1 & step-2. is it possible to combine step-1&step-2 together as one lisp?

So When I run combined lisp it has to ask me to select poly line and then it will place circle on each vertex then extract coordinate of each circle (output xls or csv).

[martti.halminen]

Should be reasonably simple.

1. Open a new, empty .csv file for writing before the REPEAT call

2. Write x, y and e to the file after the VLA-ADDCIRCLE call with the relevant .csv separators

3. Close the file after the REPEAT loop finishes.

-- 

[Yamishon_Noah]

I found this, export coordinates of polyline,

but this export to text file, can you change to *.csv file?

(defun vert (/		 filterlist  vla-obj-list
	     lwlist	 2dlist	     ptlist	 vlist1
	     vlist2	 vlist3
	    )
  (vl-load-com)
  (setq	filterlist   (make-filter)
	vla-obj-list (get-objects filterlist)
	lwlist	     (nth 0 vla-obj-list)
	2dlist	     (nth 1 vla-obj-list)
	ptlist	     (nth 2 vla-obj-list)
	vlist1	     nil
	vlist2	     nil
	vlist3	     nil
  ) ;_ end-of setq
  (if lwlist
    (setq vlist1 (make-list lwlist 2))
  ) ;_ end of if
  (if 2dlist
    (setq vlist2 (make-list 2dlist 3))
  ) ;_ end of if
  (if ptlist
    (setq vlist3 (make-list ptlist 3))
  ) ;_ end of if
  (write-text vlist1 vlist2 vlist3)
  (princ)
) ;_ end of vert

(defun make-list (p-list n / i vlist obj coords ca j x y z xy)
  (setq	i (- 1)
	vlist nil
  ) ;_ end of setq
  (repeat (length p-list)
    (setq obj	 (nth (setq i (1+ i)) p-list)
	  coords (vlax-get-property obj "coordinates")
	  ca	 (vlax-variant-value coords)
	  j	 (- 1)
    ) ;_ end-of setq
    (repeat (/ (length (vlax-safearray->list ca)) n)
      (setq x (vlax-safearray-get-element ca (setq j (1+ j))))
      (setq y (vlax-safearray-get-element ca (setq j (1+ j))))
      (if (= n 2)
	(setq xy (list x y))
	(progn
	  (setq z (vlax-safearray-get-element ca (setq j (1+ j))))
	  (setq xy (list x y z))
	) ;_ end of progn
      ) ;_ end of if
      (setq vlist (append vlist (list xy)))
    ) ;_ end-of repeat
  ) ;_ end-of repeat
) ;_ end-of make-list

(defun make-filter (/ filter)
  (setq	filter '((-4 . "<OR")
		 (0 . "LWPOLYLINE")
		 (0 . "POLYLINE")
		 (0 . "POINT")
		 (-4 . "OR>")
		)
  ) ;_ end of setq
) ;_ end of make-filter

(defun get-objects (filter  /	    ss	    k	    lwp-list
		    2dp-list	    pt-list no-ent  obj	    pl
		    2d	    pt
		   )
  (setq no-ent 1)
  (while no-ent
    (setq ss	   (ssget filter)
	  k	   (- 1)
	  lwp-list nil
	  2dp-list nil
	  pt-list  nil
	  obj	   nil
	  pl	   "AcDbPolyline"
	  2d	   "AcDb2dPolyline"
	  pt	   "AcDbPoint"
    ) ;_ end-of setq
    (if	ss
      (progn
	(setq no-ent nil)
	(repeat	(sslength ss)
	  (setq	ent (ssname ss (setq k (1+ k)))
		obj (vlax-ename->vla-object ent)
	  ) ;_ end-of setq
	  (cond
	    ((= (vlax-get-property obj "ObjectName") pl)
	     (setq lwp-list (append lwp-list (list obj)))
	    )
	    ((= (vlax-get-property obj "ObjectName") 2d)
	     (setq 2dp-list (append 2dp-list (list obj)))
	    )
	    ((= (vlax-get-property obj "ObjectName") pt)
	     (setq pt-list (append pt-list (list obj)))
	    )
	  ) ;_ end-of cond
	) ;_ end-of repeat
      ) ;_ end-of progn
      (prompt "\nNo polylines or points selected, try again.")
    ) ;_ end-of if
  ) ;_ end-of while
  (list lwp-list 2dp-list pt-list)
) ;_ end-of get-objects

(defun write-text (vl1 vl2 vl3)
  (setq	fn (getfiled "Text File" "" "txt" 1)) 
  (setq f (close (open fn "w")))
  (setq msg "Points from LW-Polylines")
  (do-points fn vl1 msg 2)
  (setq msg "Points from 2d-Polylines")
  (do-points fn vl2 msg 3)
  (setq msg "Points from Point entities")
  (do-points fn vl3 msg 3)
  (princ)
) ;_ end of write-text

(defun do-points (fn vl msg n)
  (setq f (open fn "a"))
  (write-line msg f)
  (write-line "  x,  y,  z" f)
  (write-line "" f)
  (foreach point vl
    (setq x (nth 0 point)
	  y (nth 1 point)
    ) ;_ end of setq
    (if	(= n 2)
      (setq str (strcat (rtos x) "," (rtos y)))
      (progn
	(setq z (nth 2 point))
	(setq str (strcat (rtos x) "," (rtos y) "," (rtos z)))
      ) ;_ end of progn
    ) ;_ end of if
    (write-line str f)
  ) ;_ end of foreach
  (setq f (close f))
  (princ)
) ;_ end of defun

(defun c:mkp ()
  (vert)
  (princ)
) ;_ end-of defun

(prompt "mk - enter mkp to start ")

[Anonymous]

(defun c:mkc ( / obj c i x y e)
  (vl-load-com)
(defun *error* (msg)
	(if fo
		(progn
			(close fo)
		);prong
	);if
(princ msg)
(princ)
);defun error

  (setq fn (getfiled "File Name" "" "xls" 1))
  (setq fo (open fn "w"))
  (setq *model-space* (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
  (setq obj (vlax-ename->vla-object (car (entsel))))
  (setq c (vlax-get obj "Coordinates")
        i 0
        e (vla-get-elevation obj)
  )
  (repeat (/ (length c) 2)
    (setq x (nth i c)
	  cox (rtos x 2 3)
          y (nth (1+ i) c)
	  coy (rtos y 2 3)
    )
    (vla-addcircle *model-space* (vlax-3d-point (list x y e)) 1.0)
     (setq val (strcat cox"	"coy))
    (write-line val fo)
    (setq i (+ i 2))
  )
  (princ)
(close fo)
(princ)
)

STM

[Yamishon_Noah]

hi, thanks for your reply.

it works very fine... I would like to refine more

refer attached cad file

On each Polyline vertex circles have been placed automatically and coordinates saved .xls --> Good

I want to place a block named "COORD1" on each center of circle or vertex of polyline and the attribute value of that block starts from 1 and it will incremental +1 to another vertex and continues till the polyline end.

can it be done? any lisp routine from above can be made? 

MK

[Anonymous]

(defun c:mkc ( / obj c i x y e)
  (vl-load-com)
(defun *error* (msg)
(setvar "osmode" old-os)
(setvar "attreq" old-attreq)
	(if fo
		(progn
			(close fo)
		);prong
	);if
(princ msg)
(princ)
);defun error

(setq old-os (getvar "osmode"))
(setq old-attreq (getvar "attreq"))

(setvar "osmode" 0)
(setvar "attreq" 1)

  (setq fn (getfiled "File Name" "" "xls" 1))
  (setq fo (open fn "w"))
  (setq *model-space* (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
  (setq obj1 (car (entsel)))
  (setq data (entget obj1))
(setq new-list nil)
(setq n 0)
(repeat (length data)
	(setq item (nth n data))
		(if (and (= 10 (car item)) (not (member item new-list)))
			(progn
				(setq new-list (cons item new-list))
			);progn
		);if
(setq n (1+ n))
);repeat

(setq new-list (reverse new-list))


  (setq obj (vlax-ename->vla-object obj1))
 

	
       (setq  i 0
        e (vla-get-elevation obj)
	n 0
	m 1
      )

  (repeat (length new-list)
    (setq x (cadr (nth i new-list))
	  cox (rtos x 2 3)
          y (caddr (nth i new-list))
	  coy (rtos y 2 3)
    )
	(setq o (rtos m 2 0))
    (vla-addcircle *model-space* (vlax-3d-point (list x y e)) 1.0)
     (setq val (strcat cox"	"coy))
    (write-line val fo)
    (vl-cmdf "-insert" "COORD1" (list x y) "0.5" "0" m)
    (setq i (+ i 1))
    (setq n (1+ n))
    (setq m (1+ m))
  )
  (princ)
(close fo)
(error)
(princ)
)

STM

[Anonymous]

(defun c:mkc ( / obj c i x y e)
  (vl-load-com)
(defun *error* (msg)
(setvar "osmode" old-os)
(setvar "attreq" old-attreq)
	(if fo
		(progn
			(close fo)
		);prong
	);if
(princ msg)
(princ)
);defun error

(setq old-os (getvar "osmode"))
(setq old-attreq (getvar "attreq"))

(setvar "osmode" 0)
(setvar "attreq" 1)

  (setq fn (getfiled "File Name" "" "xls" 1))
  (setq fo (open fn "w"))
  (setq *model-space* (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
  (setq obj1 (car (entsel)))
  (setq data (entget obj1))
(setq new-list nil)
(setq n 0)
(repeat (length data)
	(setq item (nth n data))
		(if (and (= 10 (car item)) (not (member item new-list)))
			(progn
				(setq new-list (cons item new-list))
			);progn
		);if
(setq n (1+ n))
);repeat

(setq new-list (reverse new-list))


  (setq obj (vlax-ename->vla-object obj1))
 

	
       (setq  i 0
        e (vla-get-elevation obj)
	n 0
	m 1
      )

  (repeat (length new-list)
    (setq x (cadr (nth i new-list))
	  cox (rtos x 2 3)
          y (caddr (nth i new-list))
	  coy (rtos y 2 3)
    )
	(setq o (rtos m 2 0))
    (vla-addcircle *model-space* (vlax-3d-point (list x y e)) 1.0)
     (setq val (strcat cox"	"coy))
    (write-line val fo)
    (vl-cmdf "-insert" "COORD1" (list x y) "0.5" "0" m)
    (setq i (+ i 1))
    (setq n (1+ n))
    (setq m (1+ m))
  )
  (princ)
(close fo)
(error)
(princ)
)

[Anonymous]

(defun c:mkc ( / obj c i x y e)
  (vl-load-com)
(defun *error* (msg)
(setvar "osmode" old-os)
(setvar "attreq" old-attreq)
	(if fo
		(progn
			(close fo)
		);prong
	);if
(princ msg)
(princ)
);defun error

(setq old-os (getvar "osmode"))
(setq old-attreq (getvar "attreq"))

(setvar "osmode" 0)
(setvar "attreq" 1)

  (setq fn (getfiled "File Name" "" "xls" 1))
  (setq fo (open fn "w"))
  (setq *model-space* (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
  (setq obj1 (car (entsel)))
  (setq data (entget obj1))
(setq new-list nil)
(setq n 0)
(repeat (length data)
	(setq item (nth n data))
		(if (and (= 10 (car item)) (not (member item new-list)))
			(progn
				(setq new-list (cons item new-list))
			);progn
		);if
(setq n (1+ n))
);repeat

(setq new-list (reverse new-list))


  (setq obj (vlax-ename->vla-object obj1))
        (setq  i 0
        e (vla-get-elevation obj)
	n 0
	m 1
      )

  (repeat (length new-list)
    (setq x (cadr (nth i new-list))
	  cox (rtos x 2 3)
          y (caddr (nth i new-list))
	  coy (rtos y 2 3)
    )
	(setq o (rtos m 2 0))
    (vla-addcircle *model-space* (vlax-3d-point (list x y e)) 1.0)
     (setq val (strcat cox"	"coy))
    (write-line val fo)
    (vl-cmdf "-insert" "COORD1" (list x y) "0.5" "0" m)
    (setq i (+ i 1))
    (setq n (1+ n))
    (setq m (1+ m))
  )
  (princ)
(close fo)
(error)
(princ)
)

STM

[Yamishon_Noah]

@Anonymous thank you so much,

It solved the question but some refining required.

i.e.

Blocks placement on each vertex of polyline instead of calling from excel data can we place directly on CAD? &

Block placing sequence shall be XY of CAD? possible I think... now blocks placed vertex along of polyline

Circle placement not required if blocks pasted directly.

kindly help

Thanks

MK