get "named" attribute insertion point

August 12, 2021

Let's assume that i have blocks named "block1", "block2", "block3" and every of this blocks has attrib named "NUMERR". It is possible to get insertion point?

Trying to make lisp with will cooperate with addon to rebar drawings. What I have is:

(defun c:bikmopdouble ()
(vl-load-com)
(if (setq ss (ssget '((0 . "INSERT") (2 . "bik_BlkOpPret,bik_BlkOpPretU,bik_BlkOpPretW"))))
    (repeat (setq i (sslength ss))
      (setq ent (ssname ss (setq i (1- i))))

(setq inspoint (cdr (assoc 10 (entget ent))))
(setq x (rtos (car inspoint) 2 3))
(setq y (rtos (cadr inspoint) 2 3))
(setq z (rtos (caddr inspoint) 2 3))
(setq insertion (strcat x "," y "," z))
(command "_.select" ent "")
(vla-sendcommand (vla-get-activedocument (vlax-get-acad-object)) (strcat "bik_mop " insertion " "))
))
  (princ)
)

The addon command bik_mop need the point or last (last added object to database). Thought it need block insertion point and command gives error. So I need block attribut "NUMER" insertion point.

sample_dwg.dwg

Edited August 12, 2021 by zwonko
EDIT: added sample dwg, correct attribute name.

August 12, 2021

Where or what do you need to do with the NUMER XYZ value . ?

August 12, 2021

Yes, the "Numer" attrib is the one inside elipse.

I need to get cordinates (x,y,z) of the "NUMER" attribute insertion point.

Neraly like here (but this is block insertion point, not attribute)

(setq inspoint (cdr (assoc 10 (entget ent))))
(setq x (rtos (car inspoint) 2 3))
(setq y (rtos (cadr inspoint) 2 3))
(setq z (rtos (caddr inspoint) 2 3))
(setq insertion (strcat x "," y "," z))

The thing is that lisp should take this "NUMBER" cordinate points based on block selection (not on attribute clicking like in most lisps which iI found), and the name of the block can be different like here:

(if (setq ss (ssget '((0 . "INSERT") (2 . "bik_BlkOpPret,bik_BlkOpPretU,bik_BlkOpPretW"))))

Other thing to do is withing rebar addon (command bik_mop). This addon is mirroring the whole rebar description (block+eplipse+multileader). This mirror in addon is acctually generating the rebar description once again.

Edited August 12, 2021 by zwonko

August 12, 2021

Please see attached

get att insertion-and BLKREF insertion.dwg

August 12, 2021

respond in the dwg

get att insertion-and BLKREF insertion.dwg

August 12, 2021

please test , it was my error , it is not the ATT insertionpoint, it is the TEXTALIGMENTPOINT

;******************************************************************************************

(DEFUN GETALLATTRIBUTES/OBJ  (OBJSELECTION /)
  (IF (= (TYPE OBJSELECTION) 'ENAME)
    (SETQ OBJSELECTION (VLAX-ENAME->VLA-OBJECT OBJSELECTION))
    )
  (IF (VLAX-PROPERTY-AVAILABLE-P OBJSELECTION "hasattributes")
    (IF (= (VLA-GET-HASATTRIBUTES OBJSELECTION) :VLAX-TRUE)
      (VLAX-SAFEARRAY->LIST
        (VARIANT-VALUE
          (VLA-GETATTRIBUTES OBJSELECTION)
          )
        )
      )
    )
  )
;;..ggk[[gg

;******************************************************************************************

(DEFUN NAMED-ATT-INSERTION  ( /

                             ACAD-OBJ
                             ADOC
                             ATT-NAME
                             ATT-XYZ
                             INSERT-OBJ
                             INSERT-OBJ-ATTS
                             INSERT-OBJ-SS
                             LAY-COLL
                             MODEL
                             SS
                             )


  (VL-LOAD-COM)
  (SETQ ACAD-OBJ (VLAX-GET-ACAD-OBJECT)) ;_ el programa ACAD 
  (SETQ ADOC (VLA-GET-ACTIVEDOCUMENT ACAD-OBJ)) ;_ el DWG que esta abierto-
  (SETQ ATT-NAME "NUMER")


  (IF (SETQ SS (SSGET "_:S+." '((0 . "INSERT") (2 . "bik_BlkOpPret,bik_BlkOpPretU,bik_BlkOpPretW"))))
    (PROGN
      (SETQ INSERT-OBJ-SS (VLA-GET-ACTIVESELECTIONSET ADOC))
      (SETQ INSERT-OBJ (VLA-ITEM INSERT-OBJ-SS 0))

      (SETQ INSERT-OBJ-ATTS (GETALLATTRIBUTES/OBJ INSERT-OBJ))

      ;;(setq atts (nth 0 insert-obj-atts))

      (FOREACH ATTS  INSERT-OBJ-ATTS
        (IF (= (VLA-GET-TAGSTRING ATTS) ATT-NAME)
          (SETQ ATT-XYZ (VLAX-SAFEARRAY->LIST (VLAX-VARIANT-VALUE (VLA-GET-TEXTALIGNMENTpoint   ATTS))))
          ) ; end if
        ) ;end foreach   

      (VLA-ADDCIRCLE MODEL (VLAX-3D-POINT ATT-XYZ) 32)
      )
    )

  )
  
;|«Visual LISP© Format Options»
(200 2 1 0 nil "end of " 100 20 2 2 nil nil T nil T)
;*** DO NOT add text below the comment! ***|;

August 13, 2021

A little gotcha I had to fix in some code, "NUMER" is not equal to "numer" so att will be skipped, added (strcase so fixed the problem. If user changes code may not be aware of this problem.

August 13, 2021

@devitgsorry, but or I'm to "low" to used this code, or something isn't working. Tried to modify somelines but it gives me nothing. Assuming that in the code there is "ssget" it should ask user to select something, but it doesnt. Assuming there is "VLA-ADDCIRCLE" it should add circle and it doesn't.

EIDT1: If I change ssget to get something it giving me

"Error: incorrect type - nil"

EDIT2: OK, spend 3-4 hour to think how it's work and I'm getting some progress. I will try later again. The problem in the code by devitag is only with vla-addcircle. (for now, becouse I will try to make it to work with my addon and blocks selection set, not only one block)

EDIT3: I can't do it to work on multi selection.... And that was the point now i have something similiar to addon command but diference is in the type of selection only. If i select more than one block it do "bik_mop" addon command only to one.

Edited August 13, 2021 by zwonko

August 14, 2021

Always post your code its the only way to work out what is wrong.

VLA-ADDCIRCLE has 3 parts currentspace VL-3dpoint and radius, the 1st and 2nd must be VL objects. Maybe look at (command a bit slower but if only a few will not see any difference or use entmake.

August 14, 2021

Ok, that code works for single selection:

;******************************************************************************************

(DEFUN GETALLATTRIBUTES/OBJ  (OBJSELECTION /)
  (IF (= (TYPE OBJSELECTION) 'ENAME)
    (SETQ OBJSELECTION (VLAX-ENAME->VLA-OBJECT OBJSELECTION))
    )
  (IF (VLAX-PROPERTY-AVAILABLE-P OBJSELECTION "hasattributes")
    (IF (= (VLA-GET-HASATTRIBUTES OBJSELECTION) :VLAX-TRUE)
      (VLAX-SAFEARRAY->LIST
        (VARIANT-VALUE
          (VLA-GETATTRIBUTES OBJSELECTION)
          )
        )
      )
    )
  )
;;..ggk[[gg

;******************************************************************************************

(DEFUN C:NAMED-ATT-INSERTION  ( /

                             ACAD-OBJ
                             ADOC
                             ATT-NAME
                             ATT-XYZ
                             INSERT-OBJ
                             INSERT-OBJ-ATTS
                             INSERT-OBJ-SS
                             LAY-COLL
                             MODEL
                             SS
                             )


  (VL-LOAD-COM)
  (SETQ ACAD-OBJ (VLAX-GET-ACAD-OBJECT)) ;_ el programa ACAD 
  (SETQ ADOC (VLA-GET-ACTIVEDOCUMENT ACAD-OBJ)) ;_ el DWG que esta abierto-
  (SETQ ATT-NAME "NUMER")

;;;;MODED LINES;;;;
;;;;;  (IF (SETQ SS (SSGET "_:S+." '((0 . "INSERT") (2 . "bik_BlkOpPret,bik_BlkOpPretU,bik_BlkOpPretW"))))  ;;THAT ONE NOT WORKING FOR SINGLE SELECTION
(IF (SETQ SS (SSGET "_+.:S" '((0 . "INSERT") (2 . "bik_BlkOpPret,bik_BlkOpPretU,bik_BlkOpPretW"))))   ;;:TAHT ONE WORK FOR SINGLE SELECTION
    (PROGN
      (SETQ INSERT-OBJ-SS (VLA-GET-ACTIVESELECTIONSET ADOC))
      (SETQ INSERT-OBJ (VLA-ITEM INSERT-OBJ-SS 0))

      (SETQ INSERT-OBJ-ATTS (GETALLATTRIBUTES/OBJ INSERT-OBJ))

      ;;(setq atts (nth 0 insert-obj-atts))

      (FOREACH ATTS  INSERT-OBJ-ATTS
        (IF (= (VLA-GET-TAGSTRING ATTS) ATT-NAME)
          (SETQ ATT-XYZ (VLAX-SAFEARRAY->LIST (VLAX-VARIANT-VALUE (VLA-GET-TEXTALIGNMENTpoint   ATTS))))
          ) ; end if
        ) ;end foreach   


;;;;;;CHANGED HERE;;;;;;;;
 ;;;;;;;;     (VLA-ADDCIRCLE MODEL (VLAX-3D-POINT ATT-XYZ) 32)  ;;; 
(print ATT-XYZ)
(setq x (rtos (car ATT-XYZ) 2 3))
(setq y (rtos (cadr ATT-XYZ) 2 3))
(setq z (rtos (caddr ATT-XYZ) 2 3))
(setq insertion (strcat x "," y "," z))
(vla-sendcommand (vla-get-activedocument (vlax-get-acad-object)) (strcat "bik_mop " insertion " "))
;;;;;;CHANGED HERE;;;;;;;;

      )
    )

  )
  
;|«Visual LISP© Format Options»
(200 2 1 0 nil "end of " 100 20 2 2 nil nil T nil T)
;*** DO NOT add text below the comment! ***|;

For multi I've try to add:

;;;;;FOR MULTI SELECTION AND REPEAT;;;;;
(if (setq sssel (ssget '((0 . "INSERT") (2 . "bik_BlkOpPret,bik_BlkOpPretU,bik_BlkOpPretW"))))
    (repeat (setq i (sslength sssel))
      (setq ss (ssname sssel (setq i (1- i))))

And thats not working. The FULL CODE is here:

;******************************************************************************************

(DEFUN GETALLATTRIBUTES/OBJ  (OBJSELECTION /)
  (IF (= (TYPE OBJSELECTION) 'ENAME)
    (SETQ OBJSELECTION (VLAX-ENAME->VLA-OBJECT OBJSELECTION))
    )
  (IF (VLAX-PROPERTY-AVAILABLE-P OBJSELECTION "hasattributes")
    (IF (= (VLA-GET-HASATTRIBUTES OBJSELECTION) :VLAX-TRUE)
      (VLAX-SAFEARRAY->LIST
        (VARIANT-VALUE
          (VLA-GETATTRIBUTES OBJSELECTION)
          )
        )
      )
    )
  )
;;..ggk[[gg

;******************************************************************************************

(DEFUN C:NAMED-ATT-INSERTION  ( /

                             ACAD-OBJ
                             ADOC
                             ATT-NAME
                             ATT-XYZ
                             INSERT-OBJ
                             INSERT-OBJ-ATTS
                             INSERT-OBJ-SS
                             LAY-COLL
                             MODEL
                             SS
                             )


  (VL-LOAD-COM)
  (SETQ ACAD-OBJ (VLAX-GET-ACAD-OBJECT)) ;_ el programa ACAD 
  (SETQ ADOC (VLA-GET-ACTIVEDOCUMENT ACAD-OBJ)) ;_ el DWG que esta abierto-
  (SETQ ATT-NAME "NUMER")

;;;;MODED LINE TO WORK WITH SINGLE SELECTION;;;;
;;;;;  (IF (SETQ SS (SSGET "_:S+." '((0 . "INSERT") (2 . "bik_BlkOpPret,bik_BlkOpPretU,bik_BlkOpPretW")))) ;;that one is not working
;;;(IF (SETQ SS (SSGET "_+.:S" '((0 . "INSERT") (2 . "bik_BlkOpPret,bik_BlkOpPretU,bik_BlkOpPretW")))) ;;;for single selection it works

;;;;;ADDED FOR MULTI SELECTION AND REPEAT;;;;;
(if (setq sssel (ssget '((0 . "INSERT") (2 . "bik_BlkOpPret,bik_BlkOpPretU,bik_BlkOpPretW"))))
    (repeat (setq i (sslength sssel))
      (setq ss (ssname sssel (setq i (1- i))))



    (PROGN
     ;;;;; (SETQ INSERT-OBJ-SS (VLA-GET-ACTIVESELECTIONSET ADOC)) ;;;; I THINK THAT THIS SHOULD BE LINE TO CHANGE :/
     ;;;;(SETQ INSERT-OBJ-SS (vlax-ename->vla-object ss))  ;;; MY TRY
     ;;; (SETQ INSERT-OBJ-SS SS)  ;;; MY TRY
     ;;;;(SETQ INSERT-OBJ-SS (vlax-ename->vla-object ss))  ;;; MY TRY
	(SETQ INSERT-OBJ-SS (VLA-GET-ACTIVESELECTIONSET ADOC))   ;;;BACK TO ORGINAL ONE
(princ "working")
     ;;;;;(SETQ INSERT-OBJ (VLA-ITEM INSERT-OBJ-SS 0)) ;;;; I THINK THAT THIS SHOULD BE LINE TO CHANGE :/
     ;;; (SETQ INSERT-OBJ (VLA-ITEM INSERT-OBJ-SS SS)) ;;; MY TRY
     ;;;(SETQ INSERT-OBJ (VLA-ITEM INSERT-OBJ-SS (vlax-ename->vla-object ss))) ;;; MY TRY
     ;;;; (SETQ INSERT-OBJ (VLA-ITEM INSERT-OBJ-SS 0))
	(SETQ INSERT-OBJ (VLA-ITEM INSERT-OBJ-SS 0)) ;;;BACK TO ORGINAL ONE
(princ "working")

      (SETQ INSERT-OBJ-ATTS (GETALLATTRIBUTES/OBJ INSERT-OBJ))
(princ "working")

      ;;(setq atts (nth 0 insert-obj-atts))

      (FOREACH ATTS  INSERT-OBJ-ATTS
        (IF (= (VLA-GET-TAGSTRING ATTS) ATT-NAME)
          (SETQ ATT-XYZ (VLAX-SAFEARRAY->LIST (VLAX-VARIANT-VALUE (VLA-GET-TEXTALIGNMENTpoint   ATTS))))
         ) ; end if
        ) ;end foreach  ;;;END FOR EACH ATTRIBUTE CHECK 


;;;;;;CHANGED HERE;;;;;;;;
;;;;;;;;     (VLA-ADDCIRCLE MODEL (VLAX-3D-POINT ATT-XYZ) 32)
(print ATT-XYZ)
(setq x (rtos (car ATT-XYZ) 2 3))
(setq y (rtos (cadr ATT-XYZ) 2 3))
(setq z (rtos (caddr ATT-XYZ) 2 3))
(setq insertion (strcat x "," y "," z))
(command "_.select" ent "")
(vla-sendcommand (vla-get-activedocument (vlax-get-acad-object)) (strcat "bik_mop " insertion " "))
;;;;;;CHANGED HERE;;;;;;;;

) ;;; END REPEAT FOR MULTI




      )
    )

  )
  
;|«Visual LISP© Format Options»
(200 2 1 0 nil "end of " 100 20 2 2 nil nil T nil T)
;*** DO NOT add text below the comment! ***|;

In this code if I select 3 blocks I've get:

Select objects: 
Specify opposite corner: 
3 found,Filtered out 6, 3 groups
Select objects: 
workingworkingworking
(5617.0 959.031 0.0) workingworkingworking
(5617.0 959.031 0.0) workingworkingworking
(5617.0 959.031 0.0) nil
Command: bik_mop

Select description to mirror: 5617.001,959.031,0

Select description multileader: bik_mop
Invalid selection!
Needs a point or Window/Last/Crossing/Box/ALL/Fence/WPolygon/CPolygon/Group/Add/Remove/Multiple/Previous/Undo/AUto/SIngle

So there is two errors.

1) first - lisp is catching the same insertion point (attribute insertion point) - not from the three blocks with I've selected

2) second is worst becouse "bik_mop" command simetimes requires/sometimes not require select description multileader -and I don't know why. Multileder is easy to select by block insertion point (code in first post) but... how to get lisp to get to know that sometimes multileder selection is needed, sometimes not

August 14, 2021

Did go further:

;******************************************************************************************

(DEFUN GETALLATTRIBUTES/OBJ  (OBJSELECTION /)
  (IF (= (TYPE OBJSELECTION) 'ENAME)
    (SETQ OBJSELECTION (VLAX-ENAME->VLA-OBJECT OBJSELECTION))
    )
  (IF (VLAX-PROPERTY-AVAILABLE-P OBJSELECTION "hasattributes")
    (IF (= (VLA-GET-HASATTRIBUTES OBJSELECTION) :VLAX-TRUE)
      (VLAX-SAFEARRAY->LIST
        (VARIANT-VALUE
          (VLA-GETATTRIBUTES OBJSELECTION)
          )
        )
      )
    )
  )
;;..ggk[[gg

;******************************************************************************************

(DEFUN C:NAMED-ATT-INSERTION  ( /

                             ACAD-OBJ
                             ADOC
                             ATT-NAME
                             ATT-XYZ
                             INSERT-OBJ
                             INSERT-OBJ-ATTS
                             INSERT-OBJ-SS
                             LAY-COLL
                             MODEL
                             SS
                             )


  (VL-LOAD-COM)
  (SETQ ACAD-OBJ (VLAX-GET-ACAD-OBJECT)) ;_ el programa ACAD 
  (SETQ ADOC (VLA-GET-ACTIVEDOCUMENT ACAD-OBJ)) ;_ el DWG que esta abierto-
  (SETQ ATT-NAME "NUMER")

;;;;MODED LINE TO WORK WITH SINGLE SELECTION;;;;
;;;;;  (IF (SETQ SS (SSGET "_:S+." '((0 . "INSERT") (2 . "bik_BlkOpPret,bik_BlkOpPretU,bik_BlkOpPretW")))) ;;that one is not working
;;;(IF (SETQ SS (SSGET "_+.:S" '((0 . "INSERT") (2 . "bik_BlkOpPret,bik_BlkOpPretU,bik_BlkOpPretW")))) ;;;for single selection it works

;;;;;ADDED FOR MULTI SELECTION AND REPEAT;;;;;
(if (setq sssel (ssget '((0 . "INSERT") (2 . "bik_BlkOpPret,bik_BlkOpPretU,bik_BlkOpPretW"))))
    (repeat (setq i (sslength sssel))
      (setq ent (ssname sssel (setq i (1- i))))




    (PROGN
     ;;;;; (SETQ INSERT-OBJ-SS (VLA-GET-ACTIVESELECTIONSET ADOC)) ;;;; I THINK THAT THIS SHOULD BE LINE TO CHANGE :/
     ;;;;(SETQ INSERT-OBJ-SS (vlax-ename->vla-object ss))  ;;; MY TRY
     ;;; (SETQ INSERT-OBJ-SS SS)  ;;; MY TRY
     ;;;;(SETQ INSERT-OBJ-SS (vlax-ename->vla-object ss))  ;;; MY TRY
(command "_select" ent "")
	(SETQ INSERT-OBJ-SS (VLA-GET-ACTIVESELECTIONSET ADOC))   ;;;BACK TO ORGINAL ONE
(princ "working")
     ;;;;;(SETQ INSERT-OBJ (VLA-ITEM INSERT-OBJ-SS 0)) ;;;; I THINK THAT THIS SHOULD BE LINE TO CHANGE :/
     ;;; (SETQ INSERT-OBJ (VLA-ITEM INSERT-OBJ-SS SS)) ;;; MY TRY
     ;;;(SETQ INSERT-OBJ (VLA-ITEM INSERT-OBJ-SS (vlax-ename->vla-object ss))) ;;; MY TRY
     ;;;; (SETQ INSERT-OBJ (VLA-ITEM INSERT-OBJ-SS 0))
	(SETQ INSERT-OBJ (VLA-ITEM INSERT-OBJ-SS 0)) ;;;BACK TO ORGINAL ONE
(princ "working")

      (SETQ INSERT-OBJ-ATTS (GETALLATTRIBUTES/OBJ INSERT-OBJ))
(princ "working")

      ;;(setq atts (nth 0 insert-obj-atts))

      (FOREACH ATTS  INSERT-OBJ-ATTS
        (IF (= (VLA-GET-TAGSTRING ATTS) ATT-NAME)
          (SETQ ATT-XYZ (VLAX-SAFEARRAY->LIST (VLAX-VARIANT-VALUE (VLA-GET-TEXTALIGNMENTpoint   ATTS))))
         ) ; end if
        ) ;end foreach  ;;;END FOR EACH ATTRIBUTE CHECK 


;;;;;;CHANGED HERE;;;;;;;;
;;;;;;;;     (VLA-ADDCIRCLE MODEL (VLAX-3D-POINT ATT-XYZ) 32)
(print ATT-XYZ)
(setq x (rtos (car ATT-XYZ) 2 3))
(setq y (rtos (cadr ATT-XYZ) 2 3))
(setq z (rtos (caddr ATT-XYZ) 2 3))
(setq insertion (strcat x "," y "," z))
(command "_.zoom" "c" insertion "")
(command "_.zoom" "s" 0.6 "")
(vla-sendcommand (vla-get-activedocument (vlax-get-acad-object)) (strcat "bik_mop " insertion " "))
;;;;;;CHANGED HERE;;;;;;;;

) ;;; END REPEAT FOR MULTI




      )
    )

  )
  
;|«Visual LISP© Format Options»
(200 2 1 0 nil "end of " 100 20 2 2 nil nil T nil T)
;*** DO NOT add text below the comment! ***|;

its nearly working. Need to do some changes to work perfectly .

1)Don't know why lisp is zooming only one center. Should do like jumping zoom from one center point to another.

2)sometimes the "point" form lisp missed click. Its becouse of pickbox is too small . So need to add lines to get current pickbox size, change it, and back change it (tryied but it is not working)

3) lisp should isolate selected object, endisolate, and like this every selected object (lisp sometimes is missclicking because pickbox is too big and there are object close to pickbox). Also it requires to change the selection set to block and multileaders

Edited August 14, 2021 by zwonko

August 14, 2021

My addcircle was only for test where the XYZ value is

My ssget , was to test at one and only Insert.

All my work was to get the ATT TAG insertion point , and after try an error I got that the XYZ value was the TEXTALIGMENTPOINT.

August 14, 2021

if you have the ATT-XYZ , you can use ( setq INSERTION ATT-XYZ)

(print ATT-XYZ)
;You do not need the 3 lines 
;(setq x (rtos (car ATT-XYZ) 2 3))
;(setq y (rtos (cadr ATT-XYZ) 2 3))
;(setq z (rtos (caddr ATT-XYZ) 2 3))
(setq insertion ATT-XYZ))
(command "_.zoom" "c" insertion "")
(command "_.zoom" "s" 0.6 "")
(vla-sendcommand (vla-get-activedocument (vlax-get-acad-object)) (strcat "bik_mop " insertion " "))
;;;;;;CHANGED HERE;;;;;;;;

August 14, 2021

Thank You @devitg. You did great job. Never thought it will be so hard (so long and hard code).

I wilk check setq insertion but probably i did it like this but it wasn't working cause of strcat

Now for me is most importamt to make it zoom like I wan't

Edited August 14, 2021 by zwonko

August 14, 2021

Hi, heres my attempt:

(defun C:test ( / attName zoomScaleFactor LM:ViewportExtents acApp acDoc SS i zm tH pL )
  
  (setq attName "NUMER")
  (setq zoomScaleFactor 10)
  
  ;; Viewport Extents  -  Lee Mac
  ;; Returns two WCS points describing the lower-left and upper-right corners of the active viewport.
  (defun LM:ViewportExtents ( / c h v )
    (setq 
      c (trans (getvar 'viewctr) 1 0)
      h (/ (getvar 'viewsize) 2.0)
      v (list (* h (apply '/ (getvar 'screensize))) h)
    )
    (list (mapcar '- c v) (mapcar '+ c v))
  )
  (setq acDoc (vla-get-ActiveDocument (setq acApp (vlax-get-acad-object))))
  
  (if (setq SS (ssget '((0 . "INSERT")(2 . "bik_BlkOpPret,bik_BlkOpPretU,bik_BlkOpPretW")(66 . 1))))
    (progn 
      (repeat (setq i (sslength SS))
        (vl-some
          '(lambda (att)
            (if (= (vlax-get att 'TagString) attName)
              (progn 
                (or tH (setq tH (vlax-get att 'Height)))
                (setq pL 
                  (cons 
                    ( (lambda (s) (substr s 2 (strlen s)))
                      (apply 'strcat (mapcar '(lambda (x) (strcat "," (rtos x 2 3))) (vlax-get att 'TextAlignmentPoint)))
                    )
                    pL
                  )
                )
              )
            )
          )
          (vlax-invoke (vlax-ename->vla-object (ssname SS (setq i (1- i)))) 'GetAttributes)
        )
      ); repeat 
      (setq zm (LM:ViewportExtents))
      (foreach p pL 
        (command "._circle" "_non" p "32") ; comment when required 
        ; (command "._delay" 300) ; for testing purposes - in order to adjust the 'zoomScaleFactor'
        (vla-ZoomCenter acApp (vlax-3D-point (read (vl-list->string (subst 32 44 (vl-string->list (strcat "(" p ")")))))) (* zoomScaleFactor tH))
        ; (vla-SendCommand acDoc (strcat "bik_mop " p " ")) ; uncomment when required
      ); foreach 
      (apply 'vla-ZoomWindow (cons (vlax-get-acad-object) (mapcar '(lambda (p) (vlax-3D-point (append p '(0.0)))) zm)))
    ); progn 
  ); if 
  (princ)
); defun 
(vl-load-com) (princ)

August 14, 2021

Thank You @Grrr

For bik_mop somehow is better to send zoom command. So the code for me is:

(defun C:bikmopfunction ( / attName zoomScaleFactor LM:ViewportExtents acApp acDoc SS i zm tH pL )
  
  (setq attName "NUMER")
  ;;(setq attName "PRZEKROJ")
  (setq zoomScaleFactor 200)
  ;;(setq zoomScaleFactor 4)
(setvar "pickbox" 22)

  
  ;; Viewport Extents  -  Lee Mac
  ;; Returns two WCS points describing the lower-left and upper-right corners of the active viewport.
  (defun LM:ViewportExtents ( / c h v )
    (setq 
      c (trans (getvar 'viewctr) 1 0)
      h (/ (getvar 'viewsize) 2.0)
      v (list (* h (apply '/ (getvar 'screensize))) h)
    )
    (list (mapcar '- c v) (mapcar '+ c v))
  )
  (setq acDoc (vla-get-ActiveDocument (setq acApp (vlax-get-acad-object))))
  
  (if (setq SS (ssget '((0 . "INSERT")(2 . "bik_BlkOpPret,bik_BlkOpPretU,bik_BlkOpPretW")(66 . 1))))
    (progn 
      (repeat (setq i (sslength SS))
        (vl-some
          '(lambda (att)
            (if (= (vlax-get att 'TagString) attName)
              (progn 
                (or tH (setq tH (vlax-get att 'Height)))
                (setq pL 
                  (cons 
                    ( (lambda (s) (substr s 2 (strlen s)))
                      (apply 'strcat (mapcar '(lambda (x) (strcat "," (rtos x 2 3))) (vlax-get att 'TextAlignmentPoint)))
                      ;;;(apply 'strcat (mapcar '(lambda (x) (strcat "," (rtos x 2 3))) (vlax-get att 'InsertionPoint)))
                    )
                    pL
                  )
                )
              )
            )
          )
          (vlax-invoke (vlax-ename->vla-object (ssname SS (setq i (1- i)))) 'GetAttributes)
        )
      ); repeat 
      (setq zm (LM:ViewportExtents))
      (foreach p pL 
      ;;  (command "._circle" "_non" p "32") ; comment when required 
         (command "._delay" 300) ; for testing purposes - in order to adjust the 'zoomScaleFactor'
       ;;;(vla-ZoomCenter acApp (vlax-3D-point (read (vl-list->string (subst 32 44 (vl-string->list (strcat "(" p ")")))))) (* zoomScaleFactor tH))
         (vla-SendCommand acDoc (strcat "_zoom " "c " p " " (rtos zoomScaleFactor 2 3) " ")) ; uncomment when required
         (vla-SendCommand acDoc (strcat "bik_mop " p " ")) ; uncomment when required
      ); foreach 
      (apply 'vla-ZoomWindow (cons (vlax-get-acad-object) (mapcar '(lambda (p) (vlax-3D-point (append p '(0.0)))) zm)))
    ); progn 
  ); if 
  (princ)
); defun 
(vl-load-com) (princ)

Also need to add bigger pickbox. Don't know why I can't get the pickbox back to my, normal one. Even if i add some lines on the end the pickbox is changed too fast. But I've added change back to other lisp witch I use:

(defun c:myautosnap ()
 (SETVAR "ORTHOMODE" 0)
  (setvar "POLARMODE" 6)
  (setvar "osmode" 4223)
  (setvar "autosnap" 63)
  (setvar "POLARANG" (angtof "45"))
  (setvar "pickbox" 9)
); end defun

get "named" attribute insertion point

Recommended Posts

zwonko

Link to comment

Share on other sites

devitg

Link to comment

Share on other sites

zwonko

Link to comment

Share on other sites

devitg

Link to comment

Share on other sites

zwonko

Link to comment

Share on other sites

devitg

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

zwonko

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

zwonko

Link to comment

Share on other sites

zwonko

Link to comment

Share on other sites

devitg

Link to comment

Share on other sites

devitg

Link to comment

Share on other sites

zwonko

Link to comment

Share on other sites

Grrr

Link to comment

Share on other sites

zwonko

Link to comment

Share on other sites

Join the conversation

Tutorials

Forums

Activity