Seek a lisp for extract polygon size and text to csv

[skchui6159]

How can I get the polygon size (Width and Length) in mm and Wall Mark to csv?

[ВeekeeCZ · Accepted solution]

Possibly like this. Max distance is set to 500. Not exported entities are marked with a circle.

(vl-load-com)


(defun c:WallExport ( / f s i e d l k g r)

  (if (setq f 500 ;; max distance
	    s (ssget '((0 . "TEXT,LWPOLYLINE"))))
    (repeat (setq i (sslength s))
      (setq e (ssname s (setq i (1- i)))
	    d (entget e))
      
      (if (= "TEXT" (cdr (assoc 0 d)))
	(setq l (cons (cons (cdr (assoc 1 d)) (cdr (assoc 10 d))) l))
	(if (> (cdr (assoc 90 d)) 3)
	  (setq k (cons e k))
	  (setq g (cons (assoc 10 d) g))))))

  (foreach e l
    (setq k (vl-sort k '(lambda (e1 e2) (< (distance (cdr e) (vlax-curve-getclosestpointto e1 (cdr e)))
					   (distance (cdr e) (vlax-curve-getclosestpointto e2 (cdr e)))))))
    (setq c (car k))
    (if (< (distance (cdr e) (vlax-curve-getclosestpointto c (cdr e))) f)
      (setq r (cons (cons (car e) (vl-sort (list (vlax-curve-getdistatparam c 1) (- (vlax-curve-getdistatparam c 2) (vlax-curve-getdistatparam c 1))) '<)) r)
	    k (cdr k))
      (setq g (cons (cons 10 (cdr e)) g))))
  (setq g (append g (mapcar '(lambda (e) (assoc 10 (entget e))) k)))

  (mapcar '(lambda (e) (entmake (list '(0 . "CIRCLE") e (cons 40 f) '(8 . "_ignored")))) g)

  (and r
       (setq f (open (setq p (strcat (getvar "dwgprefix") (getvar "dwgname") "-Export" ".csv")) "w"))
       (foreach e r
	 (write-line (write-line (substr (apply 'strcat (mapcar '(lambda (x) (strcat "," (vl-princ-to-string x)) ) e)) 2)) f))
       (write-line (strcat "Stored at '" p "'")))
  (princ)
  )

[skchui6159]

Thank you very much!😁.And also, a more question. Can a lisp do automatic dim for above polygon like that?

[ВeekeeCZ · Accepted solution]

Possibly like this

(defun c:DimRectang ( / s d i e v)
  
  (if (and (setq s (ssget '((0 . "LWPOLYLINE")  (-4 . ">") (90 . 3.))))
	   (setq d (getdist "\nSpecify offset distance: "))
	   )
    (repeat (setq i (sslength s))
      (setq e (ssname s (setq i (1- i)))
	    v (mapcar '(lambda (x) (trans (getpropertyvalue e "Vertices" x "Position") 0 1)) '(2 3 0)))
      (command "_.dimaligned" "_non" (car v) "_non" (cadr v) "_non" (polar (cadr v) (angle (last v) (cadr v)) d)
	       "_.dimaligned" "_non" (last v) "_non" (cadr v) "_non" (polar (cadr v) (angle (car v) (cadr v)) d))))
  (princ)
  )

[skchui6159]

@ВeekeeCZ Thank you very much! You solve perfectly! Cheer!

[skchui6159]

@ВeekeeCZ Sorry, I also find that sometime the polyline shape may not perfectly to 4 points or more than 4 points, closed like that. Can I also use a lisp before wall export/dimrec solve that problem to 4 point ? If not, is also ok😁. I use lee mac program outline.lsp also can not solve that problem...

[Sea-Haven]

If say you have a 5th point and its aligned correctly then there is code to remove that point so the shape would be 4 corners again. I think Kent Cooper has a solution. If the point has to stay then maybe Kent's code can be used but based on a list of points only. So only end up with a 4 point list.

[skchui6159]

@Sea-Haven No need to keep that points.

[Sea-Haven]

You miss understood the comment to do the dims you need at least 3 Points that are calculated from the rectang shape. The solution I have seen removes say 2 pline segments  and replaces with just one segment, so you would have now a 4 segment pline. . I asked "does the 5th point need to be retained". Others will comment based on your answer.

[skchui6159]

@Sea-Haven  the solution is ok. The 5th point no need to retained.

[Sea-Haven · Accepted solution]

I had problems downloading PLdiet.lsp by Kent Cooper from Cadalyst, I did find another by CadaSchtriumpf.

(defun c:remove-vertex ( / ss objent area_ori vertexlist v_list epoint cnt newlist index indexlist)
 (while (null (setq ss (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))))
 (and (setq
        objent (vlax-ename->vla-object (ssname ss 0))
        area_ori (vla-get-area objent)
        vertexlist (vlax-get objent "Coordinates")
        v_list vertexlist
      )
      (repeat (/ (length v_list) 2)
         (setq 
               epoint (list (car v_list) (cadr v_list))
               cnt     0
               newlist '()
               index   (* 2 (fix (+ 0.5 (vlax-curve-getparamatpoint objent epoint))))
               indexlist (list index (1+ index))
         )
         (foreach ordinate vertexlist
           (if (not (vl-position cnt indexlist))
             (setq newlist (cons ordinate newlist))
           )
           (setq cnt (1+ cnt))
         )
         (not (vl-catch-all-apply 'vlax-put
                (list objent "Coordinates" (reverse newlist))
              )
         )
         (if (equal (vla-get-area objent) area_ori 1E-01); can be 1E-08
          (setq vertexlist (vlax-get objent "Coordinates"))
          (not
            (vl-catch-all-apply 'vlax-put
              (list objent "Coordinates" vertexlist)
            )
          )
         )
        (setq v_list (cddr v_list))
      )
 )
)

You need to run the code before doing the DIM.

[skchui6159]

@Sea-Haven The lisp works great! Thank you very much for your help!😉

[skchui6159]

If the text , and block is inside the polygon, how can extract the polygon size, text and way of Slab (one way or two way) to csv by lisp.

[skchui6159]

Can get the content and dimension (length and width) of the above polygon by the lisp?

[Sea-Haven]

Been discussed many times if you have text inside a closed area you use the text insertion point and use BPOLY then can get all the details of the shape now created. 

; Bit of test code

(setq txtins (cdr (assoc 10 (entget (car (entsel "\nPick text "))))))
(command "bpoly" txtins "")
(setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (entlast)))))
(princ co-ord)

[skchui6159]

Thank you very much! The problem was done. Many Thanks!