Automatic Block Insert at two dimensions Intersection Point

[AbdRF]

Hello
I am really struggling with this task of block placement.So I need help from you guys for auto block placement at the intersection point of two dimensions.Dimensions can be linear or aligned and the block is dynamic in nature.


Please refer the attched .dwg file and image for exact details.
Auto_Block_Cadtutor.dwg
Thanks in advance

Edited March 12, 2020 by AbdRF

[Jonathan Handojo]

Hi there,

 

So by intersection, you mean at the point where the two extended points meet up? Or like any kind of intersection where even the dimension lines and arrows intersect?

[AbdRF]

25 minutes ago, Jonathan Handojo said:

Hi there,

 

So by intersection, you mean at the point where the two extended points meet up? Or like any kind of intersection where even the dimension lines and arrows intersect?

@Jonathan Handojo
I mean where two ticks/arrows of the dimensions intersect only.(see the image below)



Please also refer the attached dwg. Thanks
  

Edited March 12, 2020 by AbdRF
faulty Image

[Jonathan Handojo]

I would recommend you draw all the dimensions first (rotated or aligned), then upon executing the command, select all the dimensions, and AutoLISP will determine all common intersecting points.

 

Here's my solution for you:

 

;; Get arrowhead location for the dimension --> Jonathan Handojo
;; dim - dimension entity
;; Returns a list of two points denoting the arrowhead location

(defun JH:getarrowpt  (dim / dimang pt1 pt2 pt3 pt4)
  (setq dimang (angle
		 (setq pt1 (cdr (assoc 10 (entget dim))))
		 (setq pt2 (cdr (assoc 11 (entget dim))))
		 )
	)
  (list
    (inters pt1 pt2
	    (setq pt3 (cdr (assoc 13 (entget dim))))
	    (polar pt3 (+ (* 0.5 pi) dimang) 1)
	    nil
	    )
    (inters pt1 pt2
	    (setq pt4 (cdr (assoc 14 (entget dim))))
	    (polar pt4 (+ (* 0.5 pi) dimang) 1)
	    nil
	    )
    )
  )

;; Gets a list of duplicated points with a certain fuzz in a list of points
;; lst - list of points to check for
;; fuz - tolerance between points
;; Returns a list of duplicate points

(defun JH:commonpts (lst fuz / tst rtn)
  (while lst
    (setq tst (car lst)
	  lst (cdr lst)
	  )
    (if
      (and
	(vl-some
	  '(lambda (x)
	     (equal tst x fuz)
	     )
	  lst
	  )
	(not
	  (vl-some
	    '(lambda (x)
	       (equal tst x fuz)
	       )
	    rtn
	    )
	  )
	)
      (setq rtn (cons tst rtn))
      )
    )
  (reverse rtn)
  )

;; ------------------------------------------- ;;

(defun JH:selset-to-list (selset / lst iter) ; Returns all entities within a selection set into a list.
  (setq iter 0)
  (repeat (sslength selset)
    (setq lst (cons (ssname selset iter) lst)
	  iter (1+ iter))
    )
  (reverse lst)
  )

;; ------------------------------------------- ;;

(defun c:putblk ( / *error* activeundo acadobj adoc arrpt blk DegToRad fuz msp rot ss)
  (defun *error* ( msg )
    (vla-EndUndoMark adoc)
    (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*exit*"))
      (princ (strcat "Error: " msg))
      )
    )
  (defun DegToRad (x) (* x (/ pi 180)))
  (setq acadobj (vlax-get-acad-object)
        adoc (vla-get-ActiveDocument acadobj)
        msp (vla-get-ModelSpace adoc)
        activeundo nil)
  (if (= 0 (logand 8 (getvar "UNDOCTL"))) (vla-StartUndoMark adoc) (setq activeundo T))

  (setq ss (ssget '((0 . "DIMENSION")))
	blk "Tem_Sense" ; <--- Block name to insert
	fuz 1e-4	; <--- Intersection tolerance
	)
  
  (if ss
    (progn
      (setq arrpt (apply 'append (mapcar 'JH:getarrowpt (JH:selset-to-list ss)))
	    rot (progn (initget 1) (getreal "\nSpecify rotation in degrees: "))
	    )
      (if (tblsearch "BLOCK" blk)
	(mapcar '(lambda (x)
		   (vla-InsertBlock msp (apply 'vlax-3d-point x) blk 1 1 1 (DegToRad rot))
		   )
		(JH:commonpts arrpt fuz)
		)
	)
      )
    )
  (if activeundo nil (vla-EndUndoMark adoc))
  (princ)
  )

 

Edited March 12, 2020 by Jonathan Handojo

[AbdRF]

On 3/12/2020 at 5:59 PM, Jonathan Handojo said:

I would recommend you draw all the dimensions first (rotated or aligned), then upon executing the command, select all the dimensions, and AutoLISP will determine all common intersecting points.

 

Here's my solution for you:

 

;; Get arrowhead location for the dimension --> Jonathan Handojo
;; dim - dimension entity
;; Returns a list of two points denoting the arrowhead location

(defun JH:getarrowpt  (dim / dimang pt1 pt2 pt3 pt4)
  (setq dimang (angle
		 (setq pt1 (cdr (assoc 10 (entget dim))))
		 (setq pt2 (cdr (assoc 11 (entget dim))))
		 )
	)
  (list
    (inters pt1 pt2
	    (setq pt3 (cdr (assoc 13 (entget dim))))
	    (polar pt3 (+ (* 0.5 pi) dimang) 1)
	    nil
	    )
    (inters pt1 pt2
	    (setq pt4 (cdr (assoc 14 (entget dim))))
	    (polar pt4 (+ (* 0.5 pi) dimang) 1)
	    nil
	    )
    )
  )

;; Gets a list of duplicated points with a certain fuzz in a list of points
;; lst - list of points to check for
;; fuz - tolerance between points
;; Returns a list of duplicate points

(defun JH:commonpts (lst fuz / tst rtn)
  (while lst
    (setq tst (car lst)
	  lst (cdr lst)
	  )
    (if
      (and
	(vl-some
	  '(lambda (x)
	     (equal tst x fuz)
	     )
	  lst
	  )
	(not
	  (vl-some
	    '(lambda (x)
	       (equal tst x fuz)
	       )
	    rtn
	    )
	  )
	)
      (setq rtn (cons tst rtn))
      )
    )
  (reverse rtn)
  )

;; ------------------------------------------- ;;

(defun JH:selset-to-list (selset / lst iter) ; Returns all entities within a selection set into a list.
  (setq iter 0)
  (repeat (sslength selset)
    (setq lst (cons (ssname selset iter) lst)
	  iter (1+ iter))
    )
  (reverse lst)
  )

;; ------------------------------------------- ;;

(defun c:putblk ( / *error* activeundo acadobj adoc arrpt blk DegToRad fuz msp rot ss)
  (defun *error* ( msg )
    (vla-EndUndoMark adoc)
    (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*exit*"))
      (princ (strcat "Error: " msg))
      )
    )
  (defun DegToRad (x) (* x (/ pi 180)))
  (setq acadobj (vlax-get-acad-object)
        adoc (vla-get-ActiveDocument acadobj)
        msp (vla-get-ModelSpace adoc)
        activeundo nil)
  (if (= 0 (logand 8 (getvar "UNDOCTL"))) (vla-StartUndoMark adoc) (setq activeundo T))

  (setq ss (ssget '((0 . "DIMENSION")))
	blk "Tem_Sense" ; <--- Block name to insert
	fuz 1e-4	; <--- Intersection tolerance
	)
  
  (if ss
    (progn
      (setq arrpt (apply 'append (mapcar 'JH:getarrowpt (JH:selset-to-list ss)))
	    rot (progn (initget 1) (getreal "\nSpecify rotation in degrees: "))
	    )
      (if (tblsearch "BLOCK" blk)
	(mapcar '(lambda (x)
		   (vla-InsertBlock msp (apply 'vlax-3d-point x) blk 1 1 1 (DegToRad rot))
		   )
		(JH:commonpts arrpt fuz)
		)
	)
      )
    )
  (if activeundo nil (vla-EndUndoMark adoc))
  (princ)
  )

 

Thanks @Jonathan Handojo.It is working fine.