zwonko Posted August 12, 2021 Share Posted August 12, 2021 (edited) 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. Quote Link to comment Share on other sites More sharing options...
devitg Posted August 12, 2021 Share Posted August 12, 2021 Where or what do you need to do with the NUMER XYZ value . ? Quote Link to comment Share on other sites More sharing options...
zwonko Posted August 12, 2021 Author Share Posted August 12, 2021 (edited) 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 Quote Link to comment Share on other sites More sharing options...
devitg Posted August 12, 2021 Share Posted August 12, 2021 Please see attached get att insertion-and BLKREF insertion.dwg Quote Link to comment Share on other sites More sharing options...
zwonko Posted August 12, 2021 Author Share Posted August 12, 2021 respond in the dwg get att insertion-and BLKREF insertion.dwg Quote Link to comment Share on other sites More sharing options...
devitg Posted August 12, 2021 Share Posted 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! ***|; 1 Quote Link to comment Share on other sites More sharing options...
BIGAL Posted August 13, 2021 Share Posted 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. Quote Link to comment Share on other sites More sharing options...
zwonko Posted August 13, 2021 Author Share Posted August 13, 2021 (edited) @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 Quote Link to comment Share on other sites More sharing options...
BIGAL Posted August 14, 2021 Share Posted 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. Quote Link to comment Share on other sites More sharing options...
zwonko Posted August 14, 2021 Author Share Posted 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 Quote Link to comment Share on other sites More sharing options...
zwonko Posted August 14, 2021 Author Share Posted August 14, 2021 (edited) 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 Quote Link to comment Share on other sites More sharing options...
devitg Posted August 14, 2021 Share Posted 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. Quote Link to comment Share on other sites More sharing options...
devitg Posted August 14, 2021 Share Posted 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;;;;;;;; Quote Link to comment Share on other sites More sharing options...
zwonko Posted August 14, 2021 Author Share Posted August 14, 2021 (edited) 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 1 Quote Link to comment Share on other sites More sharing options...
Grrr Posted August 14, 2021 Share Posted 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) 1 Quote Link to comment Share on other sites More sharing options...
zwonko Posted August 14, 2021 Author Share Posted 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 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.