3d poli to block

[MS13]

I need a lisp tool to do following:

 

Base thing is rectangle - 3d poli. All 4 points are on one plane surface, but all co-ordinates have different xyz

I need a block to put in the center of this rectangle - centroid. If my math is not rusty thing is to average all co-ord, but my rectangle has 5 points: 1st and 5th are the same.

Does not matter what the block looks like, could be a circle or cross, lets say 0.5 unit size (see example)

Block should be put on active layer.

Also name of the block matters.

 

Ideally I can imagine this as a one click on the rectangle, second one on text field and this text become block name

 

File with the example is attached

 

 

Example.dwg

[Emmanuel Delay]

I don't understand.  Your rectangle is perfectly flat, so why use 3D Poly ?

Is it ever not flat?

[MS13]

Because it is being drawn as a 3d poli using 3 points

[Emmanuel Delay]

Okay, never mind my last remark.

 

This should work.  Command BCP  (feel free to rename)

I just take the first 4 points and skip the 5th (or how ever many there are)

 

(defun Insert (pt Nme)
  (entmakex (list (cons 0 "INSERT")
                  (cons 2 Nme)
                  (cons 10 pt))))

;; losely based on https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/3d-polyline-vertices/td-p/1927067
;; BCP for Block in Center of Poly
(defun c:bcp ( / poly mytext vtx elst lst p x y z i)
    (setq lst (list))
    (princ "\nSelect 3D poly: ")
    (setq poly (car (entsel)))
    (princ "\nSelect text containing the blockname: ")
    (setq mytext (car (entsel)))
    
    (setq vtx (entnext poly))
    (setq i 0)
    (setq
      x 0.0
      y 0.0
      z 0.0
    )
    (while (/= (cdr (assoc 0 (setq elst (entget vtx)))) "SEQEND")
        (setq
          lst (cons (setq p (cdr (assoc 10 elst))) lst)
          vtx (entnext vtx)
        )
        (if (< i 4)  ;; let's just skip the last point
          (setq
            x (+ x (nth 0 p))
            y (+ y (nth 1 p))
            z (+ z (nth 2 p))
          )
        )
        (setq i (+ i 1))
    )
    (Insert
       (list (/ x 4.0) (/ y 4.0) (/ z 4.0)  )
       (cdr (assoc 1 (entget mytext)))
    )
)

Edited November 27, 2018 by Emmanuel Delay

[MS13]

Thanks mate, nearly done

 

I think that is going to work, but for now it has a problem. Looks like it does not know what to put in the centre (block definition)

Quote

Select 3D poly:
Select object:
Select text containing the blockname:
Select object: nil

 

In attached file (example.dwg) it works and puts example block where it should be, but when I tried different file I have nil at the end

[ronjonp]

Try this quick mod:

;; losely based on https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/3d-polyline-vertices/td-p/1927067
;; BCP for Block in Center of Poly
(defun c:bcp (/ _mb insert poly mytext vtx elst lst p x y z i)
  (defun _mb (pt nme)
    (cond ((null (tblobjname "block" nme))
	   (entmake (list '(0 . "BLOCK")
			  '(100 . "AcDbEntity")
			  '(67 . 0)
			  '(8 . "0")
			  '(100 . "AcDbBlockReference")
			  (cons 2 nme)
			  '(10 0. 0. 0.)
			  '(70 . 0)
		    )
	   )
	   (entmake '((0 . "CIRCLE")
		      (100 . "AcDbEntity")
		      (67 . 0)
		      (8 . "2")
		      (100 . "AcDbCircle")
		      (10 0. 0. 0.)
		      (40 . 0.056598611433597)
		     )
	   )
	   (entmake '((0 . "LINE")
		      (100 . "AcDbEntity")
		      (67 . 0)
		      (8 . "2")
		      (100 . "AcDbLine")
		      (10 -0.218361786510286 -0.000000000000227 0.)
		      (11 0.218361786510741 -0.000000000000227 0.)
		     )
	   )
	   (entmake '((0 . "LINE")
		      (100 . "AcDbEntity")
		      (67 . 0)
		      (8 . "2")
		      (100 . "AcDbLine")
		      (10 0. -0.218361786510741 0.)
		      (11 0. 0.218361786510286 0.)
		     )
	   )
	   (entmake '((0 . "LINE")
		      (100 . "AcDbEntity")
		      (67 . 0)
		      (8 . "2")
		      (100 . "AcDbLine")
		      (10 -0.15440509999371 -0.154405099993483 0.)
		      (11 0.15440509999371 0.154405099993483 0.)
		     )
	   )
	   (entmake '((0 . "LINE")
		      (100 . "AcDbEntity")
		      (67 . 0)
		      (8 . "2")
		      (100 . "AcDbLine")
		      (10 0.15440509999371 -0.154405099993483 0.)
		      (11 -0.15440509999371 0.154405099993483 0.)
		     )
	   )
	   (entmake '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0")))
	  )
    )
    (entmakex (list (cons 0 "INSERT") (cons 2 nme) (cons 10 pt)))
    (princ)
  )
  (setq lst (list))
  (princ "\nSelect 3D poly: ")
  (setq poly (car (entsel)))
  (princ "\nSelect text containing the blockname: ")
  (setq mytext (car (entsel)))
  (setq vtx (entnext poly))
  (setq i 0)
  (setq	x 0.0
	y 0.0
	z 0.0
  )
  (while (/= (cdr (assoc 0 (setq elst (entget vtx)))) "SEQEND")
    (setq lst (cons (setq p (cdr (assoc 10 elst))) lst)
	  vtx (entnext vtx)
    )
    (if	(< i 4)
      ;; let's just skip the last point
      (setq x (+ x (nth 0 p))
	    y (+ y (nth 1 p))
	    z (+ z (nth 2 p))
      )
    )
    (setq i (+ i 1))
  )
  (_mb (list (/ x 4.0) (/ y 4.0) (/ z 4.0)) (cdr (assoc 1 (entget mytext))))
)

If you have a bunch of these to do I'd grab a selection set then sort text by distance from centroid. Then you could do a drawing in one fell swoop. 

Edited November 27, 2018 by ronjonp

[MS13]

Thanks to Emmanuel and ronjonp

 

Lisp works 

[David Bethel]

or maybe like this:

 

Assumes rectangle shape, plain TEXT

Error traps for entity types, BLOCK Name, Existing BLOCK

Checks for co-planer points

INSERT in WCS

 

 

(defun c:lrect (/ pn ps vn vd tn ts en td tv bn v vl m1 m2)
  (while (not pn)
         (and (princ "\nSelect 1 3DPOLY")
              (setq ps (ssget (list (cons 0 "POLYLINE")
                                    (cons -4 "&")
                                      (cons 70 8))))
              (= (sslength ps) 1)
              (setq pn (ssname ps 0)
                    vn (entnext pn)
                    vd (entget vn))))

  (while (not tn)
         (and (princ "\nSelect TEXT Entity For BLOCK Name")
              (setq ts (ssget (list (cons 0 "TEXT"))))
              (= (sslength ts) 1)
              (setq en (ssname ts 0))
              (setq td (entget en)
                    tv (cdr (assoc 1 td)))
              (cond ((not (snvalid tv))
                     (alert "BLOCK Name Invalid"))
                    ((tblsearch "BLOCK" tv)
                     (alert "BLOCK Name Exists"))
                    (T
                     (setq tn en bn (strcase tv))))))

  (while (= "VERTEX" (cdr (assoc 0 vd)))
         (and (setq v (cdr (assoc 10 vd)))
              (setq vl (cons v vl)))
         (setq vn (entnext vn)
               vd (entget vn)))
  (setq vl (reverse vl))
  (and (>= (length vl) 4)
       (setq m1 (mapcar '(lambda (a b) (* (+ a b) 0.5)) (nth 0 vl) (nth 2 vl)))
       (setq m2 (mapcar '(lambda (a b) (* (+ a b) 0.5)) (nth 1 vl) (nth 3 vl)))
       (equal m1 m2 1e-8))
  (cond ((not (equal m1 m2 1e-8))
         (alert "Points Are Not Coplaner"))
        (T
         (entmake (list (cons 0 "BLOCK")(cons 2 bn)(cons 70 0)(list 10 0 0 0)))
         (entmake (list (cons 0 "CIRCLE")(cons 40 1)(list 10 0 0 0)))
         (entmake (list (cons 0 "ENDBLK")(cons 8 "0")))
         (entmake (list (cons 0 "INSERT")(cons 2 bn)(cons 10 m1)))))
(prin1))

-David