OSNAP after inserting block und while moving text.

[C.Utzinger]

HI

A little part of my code.

Whith that i can after inserting the block move directly the Attribute, but i have no osnaps.

Is there a possibility to have osnaps while i'm moving the text?

	    (setq atb  (Car (vlax-invoke blk 'Getattributes)))
            (vla-put-textstring atb txt)
            (princ "\nTextposition angeben: ")	
                (Textmove (trans (vlax-get atb 'TextAlignmentPoint) 0 1) atb)

regards

[ВeekeeCZ]

I would say why not. But there is nothing to see from your snippet. The block is inserted before, the Textmove sub is nowhere.

Basically you need to control the 'osmode at right moment.

(princ "\nTextposition angeben: ")

(setvar 'osmode oldOsmode)

(Textmove ...)

[C.Utzinger]

Hmmmm

I think now it should be enough

I tried to activate osmode, but it is still on, but does not work...

(cond 
 ((and (/= *Koordpunkt-g* nil)(= btog13 0))
  (while (progn
           (initget "Undo")
           (setq pnt (getpoint (strcat "\nEinfügepunkt angeben für '" (setq txt (strcat btxt (:AddLeadingZeros (itoa *Koordpunkt-i*) *Koordpunkt-z*))) "' [Undo] <exit>: "))))
    (if (= pnt "Undo")
      (progn
        (if (equal enlast (entlast))
          (alert "Alle eingefügten Punkte gelöscht!")
          (progn
            (setq enl (entlast))
            (command "_.UNDO" 1)
            (if (not (equal enl (entlast)))
              (setq *Koordpunkt-i* (1- *Koordpunkt-i*))))))
      (progn
        (command "_.-INSERT" "SPI-Datenextraktionspunkt-CM" "_none" pnt KoordSk KoordSk "" txt "")
        (setq *Koordpunkt-i* (1+ *Koordpunkt-i*)))))
 ) ; end of cond 1

 ((and (/= *Koordpunkt-g* nil)(= btog13 1))
  (while (progn
           (initget "Undo")
           (setq pnt (getpoint (strcat "\nEinfügepunkt angeben für '" (setq txt (strcat btxt (:AddLeadingZeros (itoa *Koordpunkt-i*) *Koordpunkt-z*))) "' [Undo] <exit>: "))))
    (cond ((eq (type pnt) 'LIST)
           (setq blk (vlax-invoke
			(vlax-get
			   (vla-get-ActiveLayout
			     (vla-get-activedocument
			        (vlax-get-acad-object)))
			        'Block)
			        'InsertBlock  (trans pnt 1 0)
			        "SPI-Datenextraktionspunkt-CM.dwg" KoordSk KoordSk 1 (- (getvar 'viewtwist))))

	    (setq atb  (Car (vlax-invoke blk 'Getattributes)))
            (vla-put-textstring atb txt)
            (princ "\nTextposition angeben: ")	
                (Textmove (trans (vlax-get atb 'TextAlignmentPoint) 0 1) atb)
	    (setq inserted (cons blk inserted)
                  *Koordpunkt-i* (1+ *Koordpunkt-i*))
            (command "_.draworder" "_l" "" "_f")
           )
           ((and  (setq str (eq (type pnt) 'STR))(eq pnt "Undo") inserted)
                  (vla-delete (car inserted))
                  (setq inserted (Cdr inserted)
                        *Koordpunkt-i* (1- *Koordpunkt-i*))
		  )
           (str (alert "Alle Punkte gelöscht!") 
	   *Koordpunkt-i*)
    ); end of cond
  ) ; end of while
 ) ; end of cond 2
) ; end of cond

[ВeekeeCZ]

It was not 🙂

The issue is within your (Textmove) sub, specifically the grread function. And the solution is not that simple, fortunately Lee has some pre-made solution, read HERE.

PS I'm impressed how pretty complex got your routine during last few months.

  (defun Textmove  (pt obj / end code pt2 p)
    (while
      (and (null end)
           (setq p    (grread t 15 0)
                 code (car p)))
      (cond
        ((= 5 code)
         (vlax-put
           obj
           'TextAlignmentPoint
           (setq pt2 (trans (cadr p) 1 0)))
         (setq pt pt2)
         )
        ((or (= 2 code) (= code 3))
         (setq end T)))
      )
    ) ; end of defun

[C.Utzinger]

---

BeekeeCZ wrote:

PS I'm impressed how pretty complex got your routine during last few months.

---

Thank you. I'm sure there is a lot of crap and bull**** in it, but it works...

I will try to fix it, and write again...

Kind regards

[C.Utzinger]

HI

OK that is to much for me.

I tried it like this, but obviously it didn't work...

  (defun Textmove  (pt obj / end code pt2 p osf osm)

      (setq osf (LM:grsnap:snapfunction) ;; Define optimised Object Snap function
            osm (getvar 'osmode)         ;; Retrieve active Object Snap modes
      )

      (while
            (and (null end)
                 (setq p    (grread t 15 0)
                       code (car p)))
                 (cond
                       ((= 5 code)
                        (vlax-put
                              obj
                              'TextAlignmentPoint
                              (setq pt2 (trans (cadr p) 1 0)))
                        (setq pt pt2)
                        (redraw)             
                        (osf (cadr p) osm)
                        )
                       ((or (= 2 code) (= code 3))
                        (setq end T)))
      )
   ) ; end of defun

If it is so complicated, then I will let it like this.

Kind regards

[ВeekeeCZ]

It looks good. Did you added all the hard stuff we don't understand, but Lee made that for us? (following)

;; Object Snap for grread: Snap Function  -  Lee Mac
;; Returns: [fun] A function requiring two arguments:
;; p - [lst] UCS Point to be snapped
;; o - [int] Object Snap bit code
;; The returned function returns either the snapped point (displaying an appropriate snap symbol)
;; or the supplied point if the snap failed for the given Object Snap bit code.

(defun LM:grsnap:snapfunction ( )
    (eval
        (list 'lambda '( p o / q )
            (list 'if '(zerop (logand 16384 o))
                (list 'if
                   '(setq q
                        (cdar
                            (vl-sort
                                (vl-remove-if 'null
                                    (mapcar
                                        (function
                                            (lambda ( a / b )
                                                (if (and (= (car a) (logand (car a) o)) (setq b (osnap p (cdr a))))
                                                    (list (distance p b) b (car a))
                                                )
                                            )
                                        )
                                       '(
                                            (0001 . "_end")
                                            (0002 . "_mid")
                                            (0004 . "_cen")
                                            (0008 . "_nod")
                                            (0016 . "_qua")
                                            (0032 . "_int")
                                            (0064 . "_ins")
                                            (0128 . "_per")
                                            (0256 . "_tan")
                                            (0512 . "_nea")
                                            (2048 . "_app")
                                            (8192 . "_par")
                                        )
                                    )
                                )
                               '(lambda ( a b ) (< (car a) (car b)))
                            )
                        )
                    )
                    (list 'LM:grsnap:displaysnap '(car q)
                        (list 'cdr
                            (list 'assoc '(cadr q)
                                (list 'quote
                                    (LM:grsnap:snapsymbols
                                        (atoi (cond ((getenv "AutoSnapSize")) ("5")))
                                    )
                                )
                            )
                        )
                        (LM:OLE->ACI
                            (if (= 1 (getvar 'cvport))
                                (atoi (cond ((getenv "Layout AutoSnap Color")) ("117761")))
                                (atoi (cond ((getenv  "Model AutoSnap Color")) ("104193")))
                            )
                        )
                    )
                )
            )
           '(cond ((car q)) (p))
        )
    )
)

;; Object Snap for grread: Display Snap  -  Lee Mac
;; pnt - [lst] UCS point at which to display the symbol
;; lst - [lst] grvecs vector list
;; col - [int] ACI colour for displayed symbol
;; Returns nil

(defun LM:grsnap:displaysnap ( pnt lst col / scl )
    (setq scl (/ (getvar 'viewsize) (cadr (getvar 'screensize)))
          pnt (trans pnt 1 2)
    )
    (grvecs (cons col lst)
        (list
            (list scl 0.0 0.0 (car  pnt))
            (list 0.0 scl 0.0 (cadr pnt))
            (list 0.0 0.0 scl 0.0)
           '(0.0 0.0 0.0 1.0)
        )
    )
)

;; Object Snap for grread: Snap Symbols  -  Lee Mac
;; p - [int] Size of snap symbol in pixels
;; Returns: [lst] List of vector lists describing each Object Snap symbol

(defun LM:grsnap:snapsymbols ( p / -p -q -r a c i l q r )
    (setq -p (- p) q (1+  p)
          -q (- q) r (+ 2 p)
          -r (- r) i (/ pi 6.0)
           a 0.0
    )
    (repeat 12
        (setq l (cons (list (* r (cos a)) (* r (sin a))) l)
              a (- a i)
        )
    )
    (setq c (apply 'append (mapcar 'list (cons (last l) l) l)))
    (list
        (list 1
            (list -p -p) (list p -p) (list p -p) (list p p) (list p p) (list -p p) (list -p p) (list -p -p)
            (list -q -q) (list q -q) (list q -q) (list q q) (list q q) (list -q q) (list -q q) (list -q -q)
        )
        (list 2
            (list -r -q) (list 0  r) (list 0  r) (list r -q)
            (list -p -p) (list p -p) (list p -p) (list 0  p) (list 0  p) (list -p -p)
            (list -q -q) (list q -q) (list q -q) (list 0  q) (list 0  q) (list -q -q)
        )
        (cons 4 c)
        (vl-list* 8 (list -r -r) (list r r) (list r -r) (list -r r) c)
        (list 16
            (list p 0) (list 0 p) (list 0 p) (list -p 0) (list -p 0) (list 0 -p) (list 0 -p) (list p 0)
            (list q 0) (list 0 q) (list 0 q) (list -q 0) (list -q 0) (list 0 -q) (list 0 -q) (list q 0)
            (list r 0) (list 0 r) (list 0 r) (list -r 0) (list -r 0) (list 0 -r) (list 0 -r) (list r 0)
        )
        (list 32
            (list  r r) (list -r -r) (list  r q) (list -q -r) (list  q r) (list -r -q)
            (list -r r) (list  r -r) (list -q r) (list  r -q) (list -r q) (list  q -r)
        )
        (list 64
            '( 0  1) (list  0  p) (list  0  p) (list -p  p) (list -p  p) (list -p -1) (list -p -1) '( 0 -1)
            '( 0 -1) (list  0 -p) (list  0 -p) (list  p -p) (list  p -p) (list  p  1) (list  p  1) '( 0  1)
            '( 1  2) (list  1  q) (list  1  q) (list -q  q) (list -q  q) (list -q -2) (list -q -2) '(-1 -2)
            '(-1 -2) (list -1 -q) (list -1 -q) (list  q -q) (list  q -q) (list  q  2) (list  q  2) '( 1  2)
        )
        (list 128
            (list (1+ -p) 0) '(0 0) '(0 0) (list 0 (1+ -p))
            (list (1+ -p) 1) '(1 1) '(1 1) (list 1 (1+ -p))
            (list -p q) (list -p -p) (list -p -p) (list q -p)
            (list -q q) (list -q -q) (list -q -q) (list q -q)
        )
        (vl-list* 256 (list -r r)  (list r r) (list -r (1+ r)) (list r (1+ r)) c)
        (list 512
            (list -p -p) (list  p -p) (list -p  p) (list p p) (list -q -q) (list  q -q)
            (list  q -q) (list -q  q) (list -q  q) (list q q) (list  q  q) (list -q -q)
        )
        (list 2048
            (list   -p     -p) (list    p      p) (list   -p      p) (list    p     -p)
            (list (+ p 05) -p) (list (+ p 06) -p) (list (+ p 05) -q) (list (+ p 06) -q)
            (list (+ p 09) -p) (list (+ p 10) -p) (list (+ p 09) -q) (list (+ p 10) -q)
            (list (+ p 13) -p) (list (+ p 14) -p) (list (+ p 13) -q) (list (+ p 14) -q)
            (list -p -p) (list p -p) (list p -p) (list p p) (list p p) (list -p p) (list -p p) (list -p -p)
            (list -q -q) (list q -q) (list q -q) (list q q) (list q q) (list -q q) (list -q q) (list -q -q)
        )
        (list 8192 (list r 1) (list -r -q) (list r 0) (list -r -r) (list r q) (list -r -1) (list r r) (list -r 0))
    )
)

;; Object Snap for grread: Parse Point  -  Lee Mac
;; bpt - [lst] Basepoint for relative point input, e.g. @5,5
;; str - [str] String representing point input
;; Returns: [lst] Point represented by the given string, else nil

(defun LM:grsnap:parsepoint ( bpt str / str->lst lst )
 
    (defun str->lst ( str / pos )
        (if (setq pos (vl-string-position 44 str))
            (cons (substr str 1 pos) (str->lst (substr str (+ pos 2))))
            (list str)
        )
    )

    (if (wcmatch str "`@*")
        (setq str (substr str 2))
        (setq bpt '(0.0 0.0 0.0))
    )           

    (if
        (and
            (setq lst (mapcar 'distof (str->lst str)))
            (vl-every 'numberp lst)
            (< 1 (length lst) 4)
        )
        (mapcar '+ bpt lst)
    )
)

;; Object Snap for grread: Snap Mode  -  Lee Mac
;; str - [str] Object Snap modifier
;; Returns: [int] Object Snap bit code for the given modifier, else nil

(defun LM:grsnap:snapmode ( str )
    (vl-some
        (function
            (lambda ( x )
                (if (wcmatch (car x) (strcat (strcase str t) "*"))
                    (progn
                        (princ (cadr x)) (caddr x)
                    )
                )
            )
        )
       '(
            ("endpoint"      " of " 00001)
            ("midpoint"      " of " 00002)
            ("center"        " of " 00004)
            ("node"          " of " 00008)
            ("quadrant"      " of " 00016)
            ("intersection"  " of " 00032)
            ("insert"        " of " 00064)
            ("perpendicular" " to " 00128)
            ("tangent"       " to " 00256)
            ("nearest"       " to " 00512)
            ("appint"        " of " 02048)
            ("parallel"      " to " 08192)
            ("none"          ""     16384)
        )
    )
)

;; OLE -> ACI  -  Lee Mac
;; Args: c - [int] OLE Colour

(defun LM:OLE->ACI ( c )
    (apply 'LM:RGB->ACI (LM:OLE->RGB c))
)

;; OLE -> RGB  -  Lee Mac
;; Args: c - [int] OLE Colour

(defun LM:OLE->RGB ( c )
    (mapcar '(lambda ( x ) (lsh (lsh (fix c) x) -24)) '(24 16 8))
)

;; RGB -> ACI  -  Lee Mac
;; Args: r,g,b - [int] Red, Green, Blue values

(defun LM:RGB->ACI ( r g b / c o )
    (if (setq o (vla-getinterfaceobject (LM:acapp) (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2))))
        (progn
            (setq c (vl-catch-all-apply '(lambda ( ) (vla-setrgb o r g b) (vla-get-colorindex o))))
            (vlax-release-object o)
            (if (vl-catch-all-error-p c)
                (prompt (strcat "\nError: " (vl-catch-all-error-message c)))
                c
            )
        )
    )
)

;; Application Object  -  Lee Mac
;; Returns the VLA Application Object

(defun LM:acapp nil
    (eval (list 'defun 'LM:acapp 'nil (vlax-get-acad-object)))
    (LM:acapp)
)

(vl-load-com) (princ)

[C.Utzinger]

Yes but it does not work correctly.

While im moving the text i see only the "Basispunkt" ("Basepoint"?) of the text, and it does not Show any other Points, for example of a line.

[ВeekeeCZ]

Well, honestly I wouldn't bother. I'm using a similar routine for point marking where snapping works correctly (If I remember correctly I suggested you that approach at the time you where writing this), but I don't think I ever use it.

Anyway, here is a THREAD where I added the same what you trying to add here. Draw some line and run the routine. Focus on how OSNAPs works (not sure 'bout the rest of the routine). You'll see that it definitely not perfect...