Help: Insert block lisp

[mhy3sx]

hi i use this code to insert block in zwcad.

this is part of bigger code

 

      ;; Calculate scale factor based on distance from mid1 to mid2
      (setq scaleFactor (distance mid1 mid2))
      
      ;; Block options
      (defun _eArt67 ()
        (setq blkn "C:\\blocks\\eArt67.dwg")
        (if (and mid1 mid2)
          (progn
            (setq scl (distance mid1 mid2)
                  ang (angle mid1 mid2))
            (if (setq ins mid1)
              (command "._-insert" blkn "_non" ins scaleFactor "" (angtos (+ (/ pi 2) ang)))
            )
          )
        )
      )

 

i find this code and i like the part mirror the block using [TAB]. 

 

(defun C:test ;| credits to: Lee Mac |; ( / *error* cm SelBname bn p Blk ll ur msg SS cen Grrr mc )

(defun *error* (m) (redraw)(and cm (setvar 'cmdecho cm)) (and m (print m)) (princ))
(defun SelBname ( / e bn )
	(setvar 'errno 0)
	(while (/= 52 (getvar 'errno))
		(setq e (car (entsel "\nSelect block to reinsert <exit>: ")))
		(cond
			( (= 7 (getvar 'errno)) (princ "\nMissed, try again.") (setvar 'errno 0) )
			( (and (= 'ENAME (type e)) (/= (cdr (assoc 0 (entget e))) "INSERT")) 
				(princ "\nThis is not a block.") (setq e nil)
			)
			( (and e (not (alert "Visit lee-mac.com")) (setq bn (vla-get-EffectiveName (vlax-ename->vla-object e))) (setvar 'errno 52)) )
		); cond
	); while
	bn
); defun SelBname

(redraw) (setq bn (SelBname))
(while
	(and
		(setq cm (getvar 'cmdecho)) (setvar 'cmdecho 0)
		bn
		(last (setq p (list (getpoint "\nSpecify insertion point <exit>: "))))
		(last (setq p (append p (list (getpoint (last p) "\nSpecify second point <exit>: ")))))
		(not (apply 'grdraw (append p (list 1 7))))
		(setq Blk
			(vla-InsertBlock
				(vlax-get-property 
					(vla-get-ActiveDocument (vlax-get-acad-object)) 
					(if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace)
				) ; AcSpc
				(vlax-3D-point (car p)) bn 1. 1. 1. 0. 
			)	
		)
	)
	(progn
		(vla-GetBoundingBox Blk 'll 'ur)
		(vla-ScaleEntity Blk (vlax-3D-point (car p))
			(/ (apply 'distance p) (abs (apply '- (mapcar 'car (mapcar 'vlax-safearray->list (list ll ur))))) ) 
		)
		(vla-put-Rotation Blk (apply 'angle p))
		(setq msg "\nPress [TAB] to change orientation, [ENTER] to exit: ")
		(and msg (princ msg)) (setvar 'errno 0)
		(setq SS (ssadd))
		(ssadd (handent (vla-get-Handle Blk)) SS)
		(setq cen (apply 'mapcar (cons '(lambda (a b) (/ (+ a b) 2.)) p)))
		(while (/= 52 (getvar 'errno))
			(setq Grrr (grread T))
			(cond
				((= (car Grrr) 2)
					(cond
						((= (cadr Grrr) (ascii "\t"))
							(and msg (princ msg))
							(and (not mc) (setq mc 0))
							(setq mc (rem (+ mc 1) 4))
							(cond
								( (or (= mc 1) (= mc 3) )
									(command "_.MIRROR" SS "" "_non" cen "_non" (polar cen (+ (apply 'angle p) (/ PI 2.)) (apply 'distance p)) "_Y")
								)
								( (or (= mc 2) (= mc 0) )
									(command "_.MIRROR" SS "" "_non" cen "_non" (polar cen (apply 'angle p) (apply 'distance p)) "_Y")
								)
							)
						)
						((= (cadr Grrr) (ascii "\r"))
							(princ "\nExiting.") (redraw) (setvar 'errno 52)
						)
					); cond
				)
				((= (car Grrr) 25)
					(princ "\nExiting.") (redraw) (setvar 'errno 52)
				)
			); cond
		); while
	); progn
); while/if
(and cm (setvar 'cmdecho cm))
(princ)
);| defun |; (vl-load-com) (princ)

 

 

Is it possible to add this part to the first code? 

 

Thanks

 

[mhy3sx]

Ok, I fix it.

 

Thanks