Add point at the corner of a region

[Jord_91]

2 minutes ago, Roy_043 said:

You have lost me here. What do you mean by 'the corner'.

Hahaha! What I is that If a made my drawing a whole block will it be easier to add point at the vertex of the top...

[Jord_91]

@Roy_043

It could also be something like point at the same x,y coordinate but at Z elevation 0  (i don't know if something like this is possible) I made a whole command to flatten the 3D into a 2D drawing and add the name of the drawing... But I wasn't able to put point at vertex because it was made of line and I would have need to make an poly line outline and every thing that I have tried wasn't working. 

Sort I could make a block of the drawing then "flatten" it ad the point at the vertex (in a specific layer pre selected) then erase the 2D and insert my 3D and explode it...

Not sure if what i'm saying makes sens and if you could help... 

I'm pretty good with doing simple script with the AutoCad command (I think) but programming and make some lisp is not something I'm good (no one teach me and do not find the time to learn it)... 

 

[Roy_043]

Placing the points on the Z=0 plane actually makes more sense. They can then be used for snapping when arranging these furniture blocks in plan.

Revised code:

(defun KGA_Conv_Pickset_To_ObjectList (ss / i ret)
  (if ss
    (repeat (setq i (sslength ss))
      (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))
    )
  )
)

(defun KGA_Geom_ObjectMiddle (obj / ptBL ptTR)
  (vla-getboundingbox obj 'ptBL 'ptTR)
  (mapcar
    '/
    (mapcar '+ (vlax-safearray->list ptBL) (vlax-safearray->list ptTR))
    '(2.0 2.0 2.0)
  )
)

(defun KGA_List_DuplicateRemoveAllEqual (lst fuzz / ret)
  (mapcar
    '(lambda (a)
      (if
        (vl-every
          '(lambda (b) (not (equal a b fuzz)))
          ret
        )
        (setq ret (cons a ret))
      )
    )
    lst
  )
  (reverse ret)
)

(defun RegionPointList (reg / objLst ptLst) ; Reg as vla-object.
  (setq objLst (vlax-invoke reg 'explode))
  (setq ptLst
    (KGA_List_DuplicateRemoveAllEqual
      (apply
        'append
        (mapcar
          '(lambda (obj)
            (if (vlax-property-available-p obj 'startpoint)
              (list
                (vlax-get obj 'startpoint)
                (vlax-get obj 'endpoint)
              )
            )
          )
          objLst
        )
      )
      1e-8
    )
  )
  (mapcar 'vla-delete objLst)
  ptLst
)

(defun TopRegion (objLst / mid reg tmp)
  (setq reg (car objLst))
  (setq mid (KGA_Geom_ObjectMiddle reg))
  (foreach obj (cdr objLst)
    (if (< (caddr mid) (caddr (setq tmp (KGA_Geom_ObjectMiddle obj))))
      (setq reg obj mid tmp)
    )
  )
  reg
)

(defun c:ProjectTopRegionPoints ( / doc reg spc ss) ; Places a point on the Z=0 projection of every vertex of the 'top' region in modelspace.
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark doc)
  (vla-startundomark doc)
  (if (setq ss (ssget "_X" '((0 . "REGION") (410 . "Model"))))
    (progn
      (setq reg (TopRegion (KGA_Conv_Pickset_To_ObjectList ss)))
      (setq spc (vla-get-modelspace doc))
      (foreach pt (RegionPointList reg)
        (vla-addpoint
          spc
          (vlax-3d-point (list (car pt) (cadr pt) 0.0))
        )
      )
    )
  )
  (vla-endundomark doc)
  (princ)
)

 

Edited February 25, 2019 by Roy_043

[Jord_91]

1 hour ago, Roy_043 said:

Placing the points on the Z=0 plane actually makes more sense. They can then be used for snapping when arranging these furniture blocks in plan.

Revised code:

(defun KGA_Conv_Pickset_To_ObjectList (ss / i ret)
  (if ss
    (repeat (setq i (sslength ss))
      (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))
    )
  )
)

(defun KGA_Geom_ObjectMiddle (obj / ptBL ptTR)
  (vla-getboundingbox obj 'ptBL 'ptTR)
  (mapcar
    '/
    (mapcar '+ (vlax-safearray->list ptBL) (vlax-safearray->list ptTR))
    '(2.0 2.0 2.0)
  )
)

(defun KGA_List_DuplicateRemoveAllEqual (lst fuzz / ret)
  (mapcar
    '(lambda (a)
      (if
        (vl-every
          '(lambda (b) (not (equal a b fuzz)))
          ret
        )
        (setq ret (cons a ret))
      )
    )
    lst
  )
  (reverse ret)
)

(defun RegionPointList (reg / objLst ptLst) ; Reg as vla-object.
  (setq objLst (vlax-invoke reg 'explode))
  (setq ptLst
    (KGA_List_DuplicateRemoveAllEqual
      (apply
        'append
        (mapcar
          '(lambda (obj)
            (if (vlax-property-available-p obj 'startpoint)
              (list
                (vlax-get obj 'startpoint)
                (vlax-get obj 'endpoint)
              )
            )
          )
          objLst
        )
      )
      1e-8
    )
  )
  (mapcar 'vla-delete objLst)
  ptLst
)

(defun TopRegion (objLst / mid reg tmp)
  (setq reg (car objLst))
  (setq mid (KGA_Geom_ObjectMiddle reg))
  (foreach obj (cdr objLst)
    (if (< (caddr mid) (caddr (setq tmp (KGA_Geom_ObjectMiddle obj))))
      (setq reg obj mid tmp)
    )
  )
  reg
)

(defun c:ProjectTopRegionPoints ( / doc reg spc ss) ; Places a point on the Z=0 projection of every vertex of the 'top' region in modelspace.
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark doc)
  (vla-startundomark doc)
  (if (setq ss (ssget "_X" '((0 . "REGION") (410 . "Model"))))
    (progn
      (setq reg (TopRegion (KGA_Conv_Pickset_To_ObjectList ss)))
      (setq spc (vla-get-modelspace doc))
      (foreach pt (RegionPointList reg)
        (vla-addpoint
          spc
          (vlax-3d-point (list (car pt) (cadr pt) 0.0))
        )
      )
    )
  )
  (vla-endundomark doc)
  (princ)
)

 

I’m going to test it on wednesday!!  Do I need to pick the region or will it automatically detect it?

[Roy_043]

The main function (c:ProjectTopRegionPoints) will detect the 'top' region automatically. So it should work from a script.

[Jord_91]

On 2/26/2019 at 3:21 AM, Roy_043 said:

The main function (c:ProjectTopRegionPoints) will detect the 'top' region automatically. So it should work from a script.

You are a Genius! 

Thank you, it's an awesome command and it works perfectly!