magnifying glass in autocad

[Anonymous]

Hi guys,

I came up with another idea that will be very helpfull , I would be glad for help.

As you can see in the pic. 

https://www.dropbox.com/s/g9v4gzrxdo17rw7/2017-04-20_10-50-17.jpg?dl=0

I want that the lisp wil magnify the cursor location in a rectangle that will apear over the cursor

By clicking on the lisp it should ask for scale to magnify , the default would be 3 times the original.

Thank you in advance. 

[marko_ribar]

Contact Andrea from Ductisoft...

https://www.theswamp.org/index.php?topic=42964.msg482624#msg482624

(you have to be logged to access...)

[Anonymous]

Hi Marko,

It looks great

https://www.dropbox.com/s/7n8aio56ek8foqn/mvexmove.gif?dl=0

but how can I use this code?

(setq circleMVIEW nil)
(while (not circleMVIEW)
  (if (setq it (entsel))
    (progn
      (setq circleMVIEW (cdr (assoc 330 (entget (car it)))))
      (princ)
    )
  )
)
  
(setq newcoord '(0.0 0.0 0.0))  
(entmod (subst (cons 12 newcoord) (assoc 12 (entget circleMVIEW)) (entget circleMVIEW)))

Is it a lisp?

[Anonymous]

Yes, this is Autolisp.

The code will be executed immediately when you enter it. If you want to use it a function you have to add a first and a last line:

(defun c:my_magn_glass ()  ; you can use another name for the function

--> insert the code above here

) ; this is the last line to close the first one ...

UNTESTED!

[marko_ribar]

My version is not so smooth, but it works...

M.R.

[Anonymous]

Hi Marko,

It looks very nice, can you publish your lisp?

Thank you.

[marko_ribar]

Will I get solution and kudo if I publish it... Actually it's very simple - 95 lines, everyone can write it... And I don't want to spoil Andrea's business, so I'll think of posting the code...

[Anonymous]

Hi Marko,

Of course you'll get solution and KUDO , 

And don't worry you are absolutely not spoil Andrea's business , you are making a wonderfull service.

Thank you in advance!

Eyal

[marko_ribar · Accepted solution]

---

@Anonymous wrote:

Hi Marko,

Of course you'll get solution and KUDO , 

And don't worry you are absolutely not spoil Andrea's business , you are making a wonderfull service.

Thank you in advance!

Eyal

---

OK then... I even shortened more the code - it's now ab 80 lines...

(defun c:magglass ( / *error* polygon adoc spc s1 s2 s e b n scf pp gr p v vn ip bn loop )

  (vl-load-com)

  (defun *error* ( m )
    (if (and e (not (vlax-erased-p e)))
      (entdel e)
    )
    (vla-endundomark adoc)
    (if m
      (prompt m)
    )
    (princ)
  )

  (defun polygon ( ci n / c r k a p pl )
    (setq c (cdr (assoc 10 (entget ci))))
    (setq r (cdr (assoc 40 (entget ci))))
    (setq k -1 a (/ (* 2 pi) n))
    (repeat n
      (setq p (polar c (* (setq k (1+ k)) a) r))
      (setq pl (cons p pl))
    )
    (setq pl (reverse pl))
    (entmakex
      (append
        (list
          '(0 . "LWPOLYLINE")
          '(100 . "AcDbEntity")
          '(100 . "AcDbPolyline")
          (cons 90 (length pl))
          '(70 . 1)
          '(38 . 0.0)
        )
        (mapcar '(lambda ( x ) (cons 10 (mapcar '+ '(0 0) x))) pl)
        '((210 0.0 0.0 1.0))
      )
    )
  )

  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (setq spc (vla-get-block (vla-get-activelayout adoc)))
  (prompt "\nPick magnifying glass circle...")
  (setq s1 (ssget "_+.:E:S" '((0 . "CIRCLE"))))
  (while (not s1)
    (prompt "\nMissed... Pick magnifying glass circle again...")
    (setq s1 (ssget "_+.:E:S" '((0 . "CIRCLE"))))
  )
  (prompt "\nPick moving glass circle...")
  (setq s2 (ssget "_+.:E:S:L" '((0 . "CIRCLE"))))
  (while (not s2)
    (prompt "\nMissed... Pick moving glass circle on unlocked layer again...")
    (setq s2 (ssget "_+.:E:S:L" '((0 . "CIRCLE"))))
  )
  (setq s (ssget "_A"))
  (if (cadr (sssetfirst nil s))
    (setq s (ssget "_:L"))
  )
  (ssdel (setq s1 (ssname s1 0)) s)
  (ssdel (setq s2 (ssname s2 0)) s)
  (setq e (polygon s1 36))
  (command "_.COPYBASE" "_non" '(0 0 0) s "")
  (command "_.PASTEBLOCK" "_non" '(0 0 0))
  (setq b (entlast))
  (setq n (cdr (assoc 2 (entget b))))
  (entdel b)
  (setq scf (/ (cdr (assoc 40 (entget s1))) (cdr (assoc 40 (entget s2)))))
  (setq pp (cdr (assoc 10 (entget s1))))
  (while (/= 3 (car (setq gr (grread t))))
    (if loop
      (entdel bn)
    )
    (setq p (cadr gr))
    (setq v (mapcar '- '(0 0 0) p))
    (setq vn (mapcar '* v (list scf scf scf)))
    (entupd (cdr (assoc -1 (entmod (subst (cons 10 p) (assoc 10 (entget s2)) (entget s2))))))
    (setq ip (mapcar '+ pp vn))
    (setq bn (vlax-vla-object->ename (vla-insertblock spc (vlax-3d-point ip) n scf scf scf 0)))
    (command "_.XCLIP" bn "" "_N" "_S" e)
    (setq loop t)
  )
  (*error* nil)
)

Now, you promised ab kudo and solution...

Regards, M.R.

[Anonymous]

Hi Marko,

Thank you!! it works very good!

How can I mark this post as solution , I can't find it

Have a nice day.

Eyal

[marko_ribar]

Look in the attached picture in this link...

https://forums.autodesk.com/t5/inventor-forum/please-mark-this-response-as-quot-accept-as-solution-q...

Thanks...