Small modification

Small modification

BB8x
Advocate Advocate
1,215 Views
10 Replies
Message 1 of 11

Small modification

BB8x
Advocate
Advocate

Hi All

 

I need attached lisp changed - command sets elevation to zero. I want to have elevations not changed

 

Body

 

;; QuickMOVE originaly written by CAB
;;  Version 1.2  -  02.11.2010 
;;  No UCS support
;;  If set to Loop, Press ENTER or ESCape to exit.
;;  Use DXF 10 if it exist except for Hatch
;;  Else use Pick Point of LL of bounding box if flag is set
;;
;;  Note that the DXF code 10 my not be desirable on some objects
;;  
(defun c:p () (c:Quickmove))
(defun c:Quickmove (/ ent elst BasePt minpt maxpt Loop pkPoint NoDXF10)
  (setq loop t) ; set to nil to make routine not Loop
  (setq pkPoint nil) ; t = use pickpoint if no dxf 10
                    ;; nil = use lower left of bounding box if no dxf 10
  (setq NoDXF10 '("HATCH" "LWPOLYLINE")) ; list to exclude use of DXF 10
  (command "._undo" "_begin")
  (while
    (and
      (setq ent (entsel "\nSelect object to move: "))
      (progn
	(setq BasePt (cadr ent)) ; default move point
	(setq elst (entget (car ent)))
	(if (and (assoc 10 elst)
		 (not (member (cdr(assoc 0 elst)) NoDXF10)))
	  (setq BasePt (cdr (assoc 10 elst)))
	  (if (not pkPoint)
	    (progn	    
	      (vla-getboundingbox (vlax-ename->vla-object (car ent)) 'minpt 'maxpt)
	      (and (setq minpt (vlax-safearray->list minpt)) (setq BasePt minpt))
	    )
	  )
	)
	(command "._undo" "_mark")
	(command "._move" (car ent) "" "_non" BasePt pause)
	;;  Test for ENTER pressed ILO point picked
	(if (equal 0.0 (distance BasePt (getvar "lastpoint")) 0.0001)
	  (command "._undo" "_back") ; & exit
	  t
	)
      )
      Loop
    )
  )
  (princ)
)

 

 

0 Likes
Accepted solutions (1)
1,216 Views
10 Replies
Replies (10)
Message 2 of 11

ВeekeeCZ
Consultant
Consultant

Try this one. It should honor the OSNAPZ setting now.

 

;; Mods by BeekeeCZ to honor the OSNAPZ setting

;; QuickMOVE originaly written by CAB
;;  Version 1.2  -  02.11.2010 
;;  No UCS support
;;  If set to Loop, Press ENTER or ESCape to exit.
;;  Use DXF 10 if it exist except for Hatch
;;  Else use Pick Point of LL of bounding box if flag is set
;;
;;  Note that the DXF code 10 my not be desirable on some objects
;;  
;(defun c:p () (c:Quickmove))
(defun c:Quickmove (/ ent elst BasePt minpt maxpt Loop pkPoint NoDXF10)
  (setq loop t) ; set to nil to make routine not Loop
  (setq pkPoint nil) ; t = use pickpoint if no dxf 10
                    ;; nil = use lower left of bounding box if no dxf 10
  (setq NoDXF10 '("HATCH" "LWPOLYLINE")) ; list to exclude use of DXF 10
  (command "._undo" "_begin")
  (while
    (and
      (setq ent (entsel "\nSelect object to move: "))
      (progn
	(setq BasePt (cadr ent)) ; default move point
	(setq elst (entget (car ent)))
	(if (and (assoc 10 elst)
		 (not (member (cdr(assoc 0 elst)) NoDXF10)))
	  (setq BasePt (cdr (assoc 10 elst)))
	  (if (not pkPoint)
	    (progn	    
	      (vla-getboundingbox (vlax-ename->vla-object (car ent)) 'minpt 'maxpt)
	      (and (setq minpt (vlax-safearray->list minpt))
		   (setq BasePt minpt))
	    )
	  )
	)
	(command "._undo" "_mark")
	(if (= (getvar 'osnapz) 1) ; added by BeekeeCZ to honor OSNAPZ setting.
	  (setq BasePt (reverse (cdr (reverse minpt)))))
	(command "._move" (car ent) "" "_non" BasePt pause)
	;;  Test for ENTER pressed ILO point picked
	(if (equal 0.0 (distance BasePt (getvar "lastpoint")) 0.0001)
	  (command "._undo" "_back") ; & exit
	  t
	)
      )
      Loop
    )
  )
  (princ)
)
0 Likes
Message 3 of 11

BB8x
Advocate
Advocate

Thanks mate, but still same - elevation zero. OSNAPZ set to 0, when 1 routine does not work

0 Likes
Message 4 of 11

ВeekeeCZ
Consultant
Consultant

Just tested. It works exactly as intended.

0 Likes
Message 5 of 11

BB8x
Advocate
Advocate

Text, circles sets elevation to zero

Line sets Start Z to zero, end is lowered. 

Example: Start Z 10, end Z -35 changes to Start Z 0, end Z -45 (-35-10)

0 Likes
Message 6 of 11

ВeekeeCZ
Consultant
Consultant

Not sure what you are trying to say. You might what to work with osnapz set to 1... 

0 Likes
Message 7 of 11

BB8x
Advocate
Advocate

When osnapz 1 does nothing, just comment error: bad argument type: 2D/3D point: nil

0 Likes
Message 8 of 11

ВeekeeCZ
Consultant
Consultant

@ВeekeeCZ wrote:

Try this one. It should honor the OSNAPZ setting now.

 

;; Mods by BeekeeCZ to honor the OSNAPZ setting

;; QuickMOVE originaly written by CAB
;;  Version 1.2  -  02.11.2010 
;;  No UCS support
;;  If set to Loop, Press ENTER or ESCape to exit.
;;  Use DXF 10 if it exist except for Hatch
;;  Else use Pick Point of LL of bounding box if flag is set
;;
;;  Note that the DXF code 10 my not be desirable on some objects
;;  
;(defun c:p () (c:Quickmove))
(defun c:Quickmove (/ ent elst BasePt minpt maxpt Loop pkPoint NoDXF10)
  (setq loop t) ; set to nil to make routine not Loop
  (setq pkPoint nil) ; t = use pickpoint if no dxf 10
                    ;; nil = use lower left of bounding box if no dxf 10
  (setq NoDXF10 '("HATCH" "LWPOLYLINE")) ; list to exclude use of DXF 10
  (command "._undo" "_begin")
  (while
    (and
      (setq ent (entsel "\nSelect object to move: "))
      (progn
	(setq BasePt (cadr ent)) ; default move point
	(setq elst (entget (car ent)))
	(if (and (assoc 10 elst)
		 (not (member (cdr(assoc 0 elst)) NoDXF10)))
	  (setq BasePt (cdr (assoc 10 elst)))
	  (if (not pkPoint)
	    (progn	    
	      (vla-getboundingbox (vlax-ename->vla-object (car ent)) 'minpt 'maxpt)
	      (and (setq minpt (vlax-safearray->list minpt))
		   (setq BasePt minpt))
	    )
	  )
	)
	(command "._undo" "_mark")
	(if (= (getvar 'osnapz) 1) ; added by BeekeeCZ to honor OSNAPZ setting.
	  (setq BasePt (reverse (cdr (reverse BasePt)))))
	(command "._move" (car ent) "" "_non" BasePt pause)
	;;  Test for ENTER pressed ILO point picked
	(if (equal 0.0 (distance BasePt (getvar "lastpoint")) 0.0001)
	  (command "._undo" "_back") ; & exit
	  t
	)
      )
      Loop
    )
  )
  (princ)
)

 

sorry, little typo in the code.

0 Likes
Message 9 of 11

BB8x
Advocate
Advocate

Looks good now. Works with osnapz 1, but I do need osnapz 0.

 

Is there a way to set osnapz to 1 when lisp start and set to 0 when command terminates?

0 Likes
Message 10 of 11

ВeekeeCZ
Consultant
Consultant
Accepted solution

Ok, added the Quickmove2D function to do that.

 

;; Mods by BeekeeCZ to honor the OSNAPZ setting
;; Added QuickMode2d to force OSNAPZ 1

;; QuickMOVE originaly written by CAB
;;  Version 1.2  -  02.11.2010
;;  No UCS support
;;  If set to Loop, Press ENTER or ESCape to exit.
;;  Use DXF 10 if it exist except for Hatch
;;  Else use Pick Point of LL of bounding box if flag is set
;;
;;  Note that the DXF code 10 my not be desirable on some objects
;;
;(defun c:p () (c:Quickmove))
(defun c:Quickmove (/ ent elst BasePt minpt maxpt Loop pkPoint NoDXF10)
  (setq loop t) ; set to nil to make routine not Loop
  (setq pkPoint nil) ; t = use pickpoint if no dxf 10
  ;; nil = use lower left of bounding box if no dxf 10
  (setq NoDXF10 '("HATCH" "LWPOLYLINE")) ; list to exclude use of DXF 10
  (command "._undo" "_begin")
  (while
    (and
      (setq ent (entsel "\nSelect object to move: "))
      (progn
	(setq BasePt (cadr ent)) ; default move point
	(setq elst (entget (car ent)))
	(if (and (assoc 10 elst)
		 (not (member (cdr(assoc 0 elst)) NoDXF10)))
	  (setq BasePt (cdr (assoc 10 elst)))
	  (if (not pkPoint)
	    (progn
	      (vla-getboundingbox (vlax-ename->vla-object (car ent)) 'minpt 'maxpt)
	      (and (setq minpt (vlax-safearray->list minpt))
		   (setq BasePt minpt)))))
	(command "._undo" "_mark")
	(if (= (getvar 'osnapz) 1) ; added by BeekeeCZ to honor OSNAPZ setting.
	  (setq BasePt (reverse (cdr (reverse BasePt)))))
	(command "._move" (car ent) "" "_non" BasePt pause)
	;;  Test for ENTER pressed ILO point picked
	(if (equal 0.0 (distance BasePt (getvar "lastpoint")) 0.0001)
	  (command "._undo" "_back") ; & exit
	  t))
      Loop))
  (princ)
  )

(defun c:Quickmove2D ( / *error* z)  ;; added by BeekeeCZ to force OSNAPZ to 1
  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
      (princ (strcat "\nError: " errmsg)))
    (if z (setvar 'osnapz z))
    (princ))
  (setq z (getvar 'osnapz)) (setvar 'osnapz 1)
  (c:Quickmove)
  (*error* "end"))
0 Likes
Message 11 of 11

BB8x
Advocate
Advocate

Thanks mate. So far all works as it should

0 Likes