Polylines dimensions export to excel

[milivojekrstanovic]

Any news?

[pbejse]

milivojekrstanovic.

I hadmt a chance to play around with your file yet. but at first glance. you may want to convert entitites on "AAB-Bar" to polylines not fudge the drawing scale. i noticed 600 drawing units is annotated as 300

So automating the length would give you different results. depending on the scale you use
Make it a habit not to re-scale the drawing , otherwise we may need an additional variable jsut for scale

Also I would suggest you put the horizontal bars at the bottom on a diffrent layer

I may have something for you in the next few days. I'll admit i'm still thinking of an approach to best work with your requirement

[devitg.89838]

You have LT cad , no lisp allowed to be used on it

[marko_ribar]

Code tested, you can play with it meanwhile :

(defun c:plseglen ( / *adoc ss itmn coords pt ptl seg segd pta ptb ptab txt txta ) (vl-load-com)
  (setq *adoc (vla-get-activedocument (vlax-get-acad-object)))
  (if (ssget '((0 . "LWPOLYLINE")))
    (progn
      (setq itmn 0)
      (vlax-for itm (setq ss (vla-get-activeselectionset *adoc))
        (setq itmn (1+ itmn))
        (princ (strcat "\n\nPolyline number " (itoa itmn) " length :\t"
          (rtos (vlax-curve-getdistatparam itm (vlax-curve-getendparam itm)) 2 2)
               )
        )
        (setq coords (vlax-safearray->list (vlax-variant-value (vla-get-coordinates itm))))
        (repeat (/ (length coords) 2)
          (setq pt (list (car coords) (cadr coords)))
          (setq coords (cddr coords))
          (setq ptl (cons pt ptl))
        )
        (setq ptl (reverse ptl))
        (setq seg 0)
        (repeat (- (length ptl) 1)
          (setq seg (1+ seg))
          (princ (strcat "\nSegment number " (itoa seg) " from point ")) (princ (setq pta (nth (- seg 1) ptl))) (princ " to point ") (princ (setq ptb (nth seg ptl))) (princ " length : ")
          (princ (setq segd (rtos (- (vlax-curve-getdistatpoint itm (nth seg ptl)) (vlax-curve-getdistatpoint itm (nth (- seg 1) ptl))) 2 2)))
          (setq ptab (vlax-curve-getpointatparam itm (+ (vlax-curve-getparamatpoint itm pta) (/ (- (vlax-curve-getparamatpoint itm ptb) (vlax-curve-getparamatpoint itm pta)) 2))))
          (setq txt (entmakex (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbText") (cons 10 ptab) (cons 40 (/ (getvar 'viewsize) 100)) (cons 1 segd) (cons 50 (angle pta ptb)) (cons 41 1.0) (cons 51 0.0) (cons 71 0) (cons 72 0) (list 210 0.0 0.0 1.0) (cons 100 "AcDbText") (cons 73 0)) ))
	  (setq txta (vlax-ename->vla-object txt))
	  (vla-put-alignment txta acAlignmentMiddleCenter)
	  (entmod (subst (cons 11 ptab) (assoc 11 (entget txt)) (entget txt)))
        )
	(if (= (vla-get-closed itm) :vlax-true)
	  (progn
          (setq seg (1+ seg))
          (princ (strcat "\nSegment number " (itoa seg) " from point ")) (princ (setq pta (last ptl))) (princ " to point ") (princ (setq ptb (vlax-curve-getendpoint itm))) (princ " length : ")
          (princ (setq segd (rtos (- (vlax-curve-getdistatparam itm (vlax-curve-getendparam itm)) (vlax-curve-getdistatpoint itm (last ptl))) 2 2)))
          (setq ptab (vlax-curve-getpointatparam itm (+ (vlax-curve-getparamatpoint itm pta) (/ (- (vlax-curve-getendparam itm) (vlax-curve-getparamatpoint itm pta)) 2))))
          (setq txt (entmakex (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbText") (cons 10 ptab) (cons 40 (/ (getvar 'viewsize) 100)) (cons 1 segd) (cons 50 (angle pta ptb)) (cons 41 1.0) (cons 51 0.0) (cons 71 0) (cons 72 0) (list 210 0.0 0.0 1.0) (cons 100 "AcDbText") (cons 73 0)) ))
	  (setq txta (vlax-ename->vla-object txt))
	  (vla-put-alignment txta acAlignmentMiddleCenter)
	  (entmod (subst (cons 11 ptab) (assoc 11 (entget txt)) (entget txt)))
          )
	)
	(setq ptl nil)
      )
      (vla-delete ss)
    )
  )
  (textpage)
(princ)
)

M.R.

[juan_d_villarreal]

I'll admit i'm still thinking of an approach to best work with your requirement

Pbejse, here's a q&d one you can start with, using Gile's xdata routines.

[peter]

I assume you are talking about rebar.

Are these 3d or 2d bars?

Is it in US or SI?

Do you need bar minimum radius information?

I would suggest theoretical vertex to vertex and theta and phi angles at bend locations. (just theta for 2d)

AM I understanding your question?

Peter

[pbejse]

Pbejse, here's a q&d one you can start with, using Gile's xdata routines.

Cool beans juan_d_villarreal.
This would be very useful, Only thing we need now is understand how the OP assigns value for each column:

Shape Code:
Appears to be constant for every type: i.e L-shape, rectangular, so a popup_list would work

BarMark / Number of Member; Conforms to
popup_list

Type:
Toggle (maybe)

Total number/ Total length:
Selection

Bars in Each / Date prepared / prepared by / Revision number /
edit_box

Vertical / Links
Layer

[peter]

Here is one way.

Peter

(defun C:Rebar (/ intCount 
                  lstReturn
                  objSelection
                  ssSelections
                  strCSVFilename
               )
 (if (setq ssSelections (ssget (list (cons 0 "LWPOLYLINE,POLYLINE"))))
  (repeat (setq intCount (sslength ssSelections))
   (setq intCount     (1- intCount)
         objSelection (vlax-ename->vla-object 
                       (ssname ssSelections intCount))
         lstReturn    (cons (getsegments (getverticies objSelection)) lstReturn)
   )   
  )  
 )
 (if lstReturn
  (progn
   (setq strCSVFilename (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".csv"))
   (listtocsvfile strCSVFilename
                  lstReturn
                  ","
   )
   (getstring "\nPress Enter: ")
   (startapp "C:\\Program Files\\Microsoft Office\\Office12\\EXCEL.EXE" (strcat "\"" strCSVFilename "\""))       
  ) 
 )
)


(defun GetVerticies (objPline / intParam lstVerticies)
 (repeat (1+ (setq intParam (fix (vlax-curve-getendparam objPline))))
  (setq lstVerticies (cons (vlax-curve-getpointatparam objPline (float intParam)) lstVerticies))
  (setq intParam (1- intParam))
 )
 lstVerticies 
)

(defun GetSegments (lstVerticies)
 (mapcar 'distance 
         (reverse (cdr (reverse lstVerticies))) 
         (cdr lstVerticies) 
 )
)

(defun GetAngles (lstVerticies)
 (mapcar '(lambda (X Y)(* 180 (/ (angle X Y) pi)))
          (reverse (cdr (reverse lstVerticies))) 
          (cdr lstVerticies) 
 )
)

;Export a list of sublists of strings to a text file

(defun ListTOCSVFile (strFilename lstOfSublists strChar / strText strText2)
 (setq z (open strFileName "w"))
 (foreach lstSubList lstOfSublists 
  (setq strText (nth 0 lstSubList))
  (if (= (type strText) 'INT) (setq strText (itoa strText)))
  (if (= (type strText) 'REAL)(setq strText (rtos strText 2)))
  (if (cdr lstSubList)
   (if (= (type (cdr lstSublist)) 'LIST)
    (foreach strText2 (cdr lstSubList)
     (if (= (type strText2) 'INT) (setq strText2 (itoa strText2)))
     (if (= (type strText2) 'REAL)(setq strText2 (rtos strText2 2)))
     (setq strText (strcat strText strChar strText2))
    )
    (progn
     (setq strText2 (cdr lstSubList))
     (if (= (type strText2) 'INT) (setq strText2 (itoa strText2)))
     (if (= (type strText2) 'REAL)(setq strText2 (rtos strText2 2)))
     (setq strText (strcat strText strChar strText2))
    )
   )
  )
  (if strText (write-line strText z))
 )
 (close z)

 (princ)
)

[marko_ribar]

Just to check length of all segments of 2dpolyline, you can also use this c:autoaldim routine also posted on www.theswamp.org

(defun nor*dst (pt1 pt2 dst)
  (polar pt1 (- (angle pt1 pt2) (/ PI 2)) dst)
)

(defun nor ( v )
  (polar '(0 0 0) (+ (angle '(0 0 0) v) (/ PI 2)) 1.0)
)

(defun mid ( a b )
  (mapcar '(lambda (x y) (/ (+ x y) 2.0)) a b)
)

(defun cent ( p1 p2 p3 / mp1p2 mp1p3 mp2p3 p1p2 p1p3 p2p3 np1p2 np1p3 np2p3 pnp1p2 pnp1p3 pnp2p3 o1 o2 o3 o )
  (setq mp1p2 (mid p1 p2))
  (setq mp1p3 (mid p1 p3))
  (setq mp2p3 (mid p2 p3))
  (setq p1p2 (mapcar '- p2 p1))
  (setq p1p3 (mapcar '- p3 p1))
  (setq p2p3 (mapcar '- p3 p2))
  (setq np1p2 (nor p1p2))
  (setq np1p3 (nor p1p3))
  (setq np2p3 (nor p2p3))
  (setq pnp1p2 (mapcar '+ mp1p2 np1p2))
  (setq pnp1p3 (mapcar '+ mp1p3 np1p3))
  (setq pnp2p3 (mapcar '+ mp2p3 np2p3))
  (setq o1 (inters mp1p2 pnp1p2 mp1p3 pnp1p3 nil))
  (setq o2 (inters mp1p2 pnp1p2 mp2p3 pnp2p3 nil))
  (setq o3 (inters mp2p3 pnp2p3 mp1p3 pnp1p3 nil))
  (if (and (equal o1 o2 1e-6) (equal o1 o3 1e-6) (equal o2 o3 1e-6)) (setq o o1) )
  o
)

(defun c:autoaldim ( / osm g pt1 pt2 sss k ent plpts m n cen dst txt txta ss ptab ce ptabn enta ) (vl-load-com)
  (prompt "\nSelect polylines or lines objects for automatic aligned dimensioning")
  (setq osm (getvar 'osmode))
  (setvar 'osmode 0)
  (setq sss (ssget '((0 . "LWPOLYLINE,LINE"))))
  (setq k (sslength sss))
  (setq cen (getvar 'viewctr))
  (setq txt (entmakex (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText") '(1 . "0.0") (cons 10 cen) (cons 40 (/ (getvar 'viewsize) 50)) )))
  (setq txta (vlax-ename->vla-object txt))
  (setq ss (ssget "_L"))
  (prompt "\nPress any key to enter offset distance manually")
  (while (= (sslength ss) 1)
    (setq g (grread T))
    (if (= (car g) 3) (progn (vla-erase txta) (ssdel txt ss)))
    (if (= (car g) 2) (progn (setq dst (getdist "\nInput offset distance for aligned dimensions <2 points or number> : ")) (vla-erase txta) (ssdel txt ss)))
    (if (= (car g) 5) (progn (setq dst (distance cen (cadr g))) (vla-put-textstring txta dst)))
  )
  (while (>= k 1)
    (setq ent (ssname sss (setq k (1- k))))
    (if (eq (cdr (assoc 0 (entget ent))) "LINE")
      (command "_.dimaligned" (setq pt1 (cdr (assoc 10 (entget ent)))) (setq pt2 (cdr (assoc 11 (entget ent)))) (nor*dst pt1 pt2 dst) )
    )
    (if (eq (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
      (progn
      (setq enta (vlax-ename->vla-object ent))
      (setq plpts (mapcar '(lambda (x) (cdr x)) (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent)) ))
      (setq m -1)
      (repeat (- (length plpts) 1)
        (setq m (1+ m))
        (setq n (1+ m))
        (if (and (/= (ssget "_C" (mid (nth m plpts) (nth n plpts)) (mid (nth m plpts) (nth n plpts))) nil) (eq ent (ssname (ssget "_C" (mid (nth m plpts) (nth n plpts)) (mid (nth m plpts) (nth n plpts))) 0)))
        (command "_.dimaligned" (setq pt1 (nth m plpts)) (setq pt2 (nth n plpts)) (nor*dst pt1 pt2 dst) )
        (progn
        (setq ptab (vlax-curve-getpointatparam enta (+ (vlax-curve-getparamatpoint enta (nth m plpts)) (/ (- (vlax-curve-getparamatpoint enta (nth n plpts)) (vlax-curve-getparamatpoint enta (nth m plpts))) 2))))
        (setq ce (cent (if (= (length (nth m plpts)) 2) (append (nth m plpts) (list 0.0)) (nth m plpts)) (if (= (length ptab) 2) (append ptab (list 0.0)) ptab) (if (= (length (nth n plpts)) 2) (append (nth n plpts) (list 0.0)) (nth n plpts))))
        (setq ptabn (polar ptab (angle ce ptab) dst))
        (command "_.dimarc" ptab ptabn)
        )
        )
      )
      (if (and (eq n (- (length plpts) 1)) (eq (cdr (assoc 70 (entget ent))) 1))
        (if (and (/= (ssget "_C" (mid (nth n plpts) (nth 0 plpts)) (mid (nth n plpts) (nth 0 plpts))) nil) (eq ent (ssname (ssget "_C" (mid (nth n plpts) (nth 0 plpts)) (mid (nth n plpts) (nth 0 plpts))) 0)))
        (command "_.dimaligned" (setq pt1 (nth n plpts)) (setq pt2 (nth 0 plpts)) (nor*dst pt1 pt2 dst) )
        (progn
        (setq ptab (vlax-curve-getpointatparam enta (+ (vlax-curve-getparamatpoint enta (nth n plpts)) (/ (- (vlax-curve-getendparam enta) (vlax-curve-getparamatpoint enta (nth n plpts))) 2))))
        (setq ce (cent (if (= (length (nth n plpts)) 2) (append (nth n plpts) (list 0.0)) (nth n plpts)) (if (= (length ptab) 2) (append ptab (list 0.0)) ptab) (if (= (length (nth 0 plpts)) 2) (append (nth 0 plpts) (list 0.0)) (nth 0 plpts))))
        (setq ptabn (polar ptab (angle ce ptab) dst))
        (command "_.dimarc" ptab ptabn)
        )
        )
      )
      )
    )
  )
  (setvar 'osmode osm)
  (princ)
)

M.R.

[marko_ribar]

Peter, I've checked your code and it seems that it don't calculate arcs length... Inspect it for yourself with mine codes...

Regards, M.R.