How to make the inserted blocks not duplicate ?

[Kvlar]

I have the code to insert block on arrow head dimensions. but the problem is that the blocks that are inserted are always duplicates because the arrowhead dimensions are also duplicates. How to solve this? Maybe someone can help modify the code or someone can provide hints for instructions. 

Thank You

 

This is the code :

;;;Original code from : Jonathan Handojo;;;

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

(defun JH:commonpts (lst fuz / rtn)
  (setq rtn nil)
  (while lst
    (setq tst (car lst)
          lst (cdr lst)
    )
    (if
      (and
        (vl-remove tst lst :test '(lambda (a b) (equal a b fuz)))
        (not (member tst rtn :test '(lambda (a b) (equal a b fuz))))
      )
      (setq rtn (cons tst rtn))
    )
  )
  rtn
)

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

(defun c:test (/ acadobj adoc msp blk fuz ascale rot ss arrpts blkname) 
  (defun DegToRad (x) (* x (/ pi 180)))
  (setq acadobj (vlax-get-acad-object)
        adoc (vla-get-ActiveDocument acadobj)
        msp (vla-get-ModelSpace adoc)
        fuz 1e-4 ; Intersection tolerance
        ascale (getvar "CANNOSCALEVALUE") ; Current annotation scale value
  )
  
  (setq ss (ssget '((0 . "DIMENSION"))))
  
  ;; New code for block selection
  (while (not blkname)
    (setq blk (entsel "\nSelect Block: "))
    (if blk
      (if (eq (cdr (assoc 0 (entget (car blk)))) "INSERT")
        (setq blkname (vla-get-effectivename (vlax-ename->vla-object (car blk))))
        (princ "\nObjects are not blocks")
      )
      (princ "\nNothing Selected")
    )
  )

  (if ss
    (progn
      (setq rot (getreal "\nRotation Angle: "))
      (foreach dim (JH:selset-to-list ss)
        (setq arrpts (JH:getarrowpt dim))
        (if (tblsearch "BLOCK" blkname)
          (foreach pt arrpts
            (vla-InsertBlock msp (apply 'vlax-3d-point pt) blkname 1 1 1 (DegToRad rot))
          )
        )
      )
    )
  )
)
(vl-load-com)

 

[devitg]

@Kvlar Please upload your sample.dwg , you use to apply such lisp

 

[BIGAL]

You can set a block as a arrowhead, you can overwrite the arrowhead. I don't have anything of the top of my head. Like Devitg post a dwg with the block. The other way is make a dimension style.

 

[Kvlar]

10 hours ago, devitg said:

@Kvlar Please upload your sample.dwg , you use to apply such lisp

 

This is an example of a DWG file where I want to use this code. I want to insert blocks on each arrow head dimension but without duplicate object blocks

 

 

File DWG - Cad Tutor.dwg

[Kvlar]

2 hours ago, BIGAL said:

You can set a block as a arrowhead, you can overwrite the arrowhead. I don't have anything of the top of my head. Like Devitg post a dwg with the block. The other way is make a dimension style.

 

hi, Bigal, I think this will be difficult to apply to my problem, because the block I inserted has an attribute

[BIGAL]

There is a property for arrow of "none" for the arrow.

 

There may be a better way to do this but if you do DIM OV Dimblk "None" select existing dim.

 

 

 

[Kvlar]

 

4 hours ago, BIGAL said:

Ada properti untuk panah "tidak ada" untuk panah.

 

Mungkin ada cara yang lebih baik untuk melakukan ini tetapi jika Anda melakukan DIM OV Dimblk "Tidak Ada" pilih redup yang ada.

 

 

 

Instead of doing that, it looks like I would prefer to add a function to delete duplicate blocks. Thank you for your suggestions guys.

[BIGAL]

I am using Bricscad V20 and can not set the arrow block via lisp else would have provided something, some one else will do for you.

[Kvlar]

1 hour ago, BIGAL said:

I am using Bricscad V20 and can not set the arrow block via lisp else would have provided something, some one else will do for you.

I hope so. Thank you Bigal