How to select area screenshot

March 2, 2022

2 hours ago, ekko said:

I tried it, it is not the function I want, can you teach me how to import the screenshot from CAD to excel

1. if you want just how to input wmf to excel.

my routine makes .wmf image file in .dwg file's directory. just insert like png or jpeg same way.

2. if you want just image with fixed size.

jpgout or pngout make same pixel size with your autocad drawing window. (not coordinates or size in drawing, just window box size you can see)

so, this is Cheating way. I like cheating

When specifying pt1 and pt2, you do not enter pixels. just picking coordinates.

so, width of the output image value is entered

height of the output image is automatically adjusted according to the xy ratio of pt1 and pt2.

Because it is affected by the window size, it worked normally at a width of 1500 or less in an environment of 1920x1080.

and, In my environment

-16px is insufficient in width

-55px is insufficient in height.

it's probably because of the scrollbars and titles of the drawing window.

You can test it in your own environment and change this number.

(defun c:ss (/ ods pt1 pt2 patch nm ss acdoc input_width input_height x_dist_selection y_dist_selection xy_ratio _opendirectory)
  (setvar "cmdecho" 0)
  (setq ods (getvar "osmode"))
  (setvar "osmode" 0)
 
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object))) ;edited line

  (setq    pt1 (getpoint "\nSelect the first point:")
    pt2 (getcorner pt1
               "\nselect the second point:"
        )
    ph  (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".png") ;edited line
  )

  (setq x_dist_selection (abs (- (car pt1) (car pt2)) )) ;edited line
  (setq y_dist_selection (abs (- (cadr pt1) (cadr pt2)) )) ;edited line
  (setq xy_ratio (/ y_dist_selection x_dist_selection)) ;edited line
  
  
  (initget 7) ;edited line
  (setq input_width (getint "\nInput image width (under approx.1500 is best):")) 
  (setq input_height (atoi (rtos (* input_width xy_ratio) 2 0)) )

  ; if 1:1 scale, delete above 3 lines (initget 7)~(setq input_height ~)
  ; and add this (setq input_width x_dist_selection) (setq input_height y_dist_selection)

  (setq input_width (+ input_width 16)) ; 16 is my environment gap of window size & image size. shoud be edited
  (setq input_height (+ input_height 55)) ; 45 is my environment gap of window size & image size. shoud be edited

  ;(princ "\n xy_ratio - ")
  ;(princ xy_ratio)  
  ;(princ "\n input_width - ")
  ;(princ input_width)
  ;(princ "\n input_height - ")
  ;(princ input_height)

  (if (setq ss (ssget "w" pt1 pt2)) ;'((0 . "lwpolyline,line,ARC"))))
    (progn
      (command "_Zoom" "OB" ss "")
      (vla-put-height acdoc input_height)  ;edited line
      (vla-put-width acdoc input_width)  ;edited line
      (command "_pngout" ph "all" "") ;edited line for all entities, replace with (command "_pngout" ph ss "") 
    )
  )
  (command "_Zoom" "p")
  (vla-put-windowstate acdoc 3)  ;edited line
  (command "_syswindows" "c")  ;edited line

  (setvar "osmode" ods)
  (princ "\ndone.")
  (princ (strcat "\nimage output path:" ph))

(defun _opendirectory (path / sa)  ;edited line
 (if (and (eq 'str (type path))  ;edited line
   (findfile (vl-string-right-trim "\\" path))  ;edited line
   (setq sa (vlax-create-object "Shell.Application"))  ;edited line
     ) ;edited line
   (progn (vlax-invoke sa 'explore path) (vlax-release-object sa)) ;edited line
 ) ;edited line
 (princ) ;edited line
) ;edited line

(_opendirectory (getvar 'dwgprefix)) ;edited line


  (setvar "osmode" ods)
  (princ)
)

Because png has better quality than jpeg, I changed it at will

Edited March 2, 2022 by exceed

March 2, 2022

1 hour ago, exceed said:

(defun c:ss (/ ods pt1 pt2 patch nm ss acdoc input_width input_height x_dist_selection y_dist_selection xy_ratio _opendirectory)
  (setvar "cmdecho" 0)
  (setq ods (getvar "osmode"))
  (setvar "osmode" 0)
 
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object))) ;edited line

  (setq    pt1 (getpoint "\nSelect the first point:")
    pt2 (getcorner pt1
               "\nselect the second point:"
        )
    ph  (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".png") ;edited line
  )

  (setq x_dist_selection (abs (- (car pt1) (car pt2)) )) ;edited line
  (setq y_dist_selection (abs (- (cadr pt1) (cadr pt2)) )) ;edited line
  (setq xy_ratio (/ y_dist_selection x_dist_selection)) ;edited line
  
  
  (initget 7) ;edited line
  (setq input_width (getint "\nInput image width (under approx.1500 is best):")) 
  (setq input_height (atoi (rtos (* input_width xy_ratio) 2 0)) )

  ; if 1:1 scale, delete above 3 lines (initget 7)~(setq input_height ~)
  ; and add this (setq input_width x_dist_selection) (setq input_height y_dist_selection)

  (setq input_width (+ input_width 16)) ; 16 is my environment gap of window size & image size. shoud be edited
  (setq input_height (+ input_height 55)) ; 45 is my environment gap of window size & image size. shoud be edited

  ;(princ "\n xy_ratio - ")
  ;(princ xy_ratio)  
  ;(princ "\n input_width - ")
  ;(princ input_width)
  ;(princ "\n input_height - ")
  ;(princ input_height)

  (if (setq ss (ssget "w" pt1 pt2)) ;'((0 . "lwpolyline,line,ARC"))))
    (progn
      (command "_Zoom" "OB" ss "")
      (vla-put-height acdoc input_height)  ;edited line
      (vla-put-width acdoc input_width)  ;edited line
      (command "_pngout" ph "all" "") ;edited line for all entities, replace with (command "_pngout" ph ss "") 
    )
  )
  (command "_Zoom" "p")
  (vla-put-windowstate acdoc 3)  ;edited line
  (command "_syswindows" "c")  ;edited line

  (setvar "osmode" ods)
  (princ "\ndone.")
  (princ (strcat "\nimage output path:" ph))

(defun _opendirectory (path / sa)  ;edited line
 (if (and (eq 'str (type path))  ;edited line
   (findfile (vl-string-right-trim "\\" path))  ;edited line
   (setq sa (vlax-create-object "Shell.Application"))  ;edited line
     ) ;edited line
   (progn (vlax-invoke sa 'explore path) (vlax-release-object sa)) ;edited line
 ) ;edited line
 (princ) ;edited line
) ;edited line

(_opendirectory (getvar 'dwgprefix)) ;edited line


  (setvar "osmode" ods)
  (princ)
)

Thank you for your help my bro, but it doesn't seem to work, my requirement is to take a screenshot in the CAD selection area --> import the screenshot into the excel sheet, of course, I don't want the screenshot to be too big. Specifying the area screenshot is just the first step, please help me if you can, as it is beyond my programming skills, thanks

March 3, 2022

ekk 1st the "A4 400 dpi" just do PLOT "plot to web jpg" and look at all the sizes available, use a suitable one

Ok for paste to excel different method I would do something like this very simple

(alert "Pick window for clip") you can move the alert window out of the way,

use window+shift+S on keyboard this starts snipping tool. select screen area.

Click ok on alert

Go to excel, pick cell, paste

Ok tricky bit could know cell address, get application to excel and use pasteclip to cell.

Not tested a lot of time to code compared to seconds to snip and paste.

March 3, 2022

58 minutes ago, BIGAL said:

ekk 1st the "A4 400 dpi" just do PLOT "plot to web jpg" and look at all the sizes available, use a suitable one

Ok for paste to excel different method I would do something like this very simple

(alert "Pick window for clip") you can move the alert window out of the way,

use window+shift+S on keyboard this starts snipping tool. select screen area.

Click ok on alert

Go to excel, pick cell, paste

Ok tricky bit could know cell address, get application to excel and use pasteclip to cell.

Not tested a lot of time to code compared to seconds to snip and paste.

(defun jc-excel-insertpicture (et      path    Height  width   down
			       right   /       EXCEL   PIC     PICTURE
			       SHAPE   SHEET
			      )
  (vl-load-com)
  (setq excelapp0 (vlax-get-object "Excel.Application")) ;Get the excel app
  (setq	activeworkbook0
	 (vlax-get-property excelapp0 'ActiveWorkbook)
  )
  ;;excel workbook object
  (setq	activesheet0
	 (vlax-get-property activeworkbook0 'ActiveSheet)
  )
  ;;excel worksheet object
  (setq cells0 (vlax-get-property activesheet0 'cells))
  ;;excel cell object
					;(vlax-put-property cells0 'item sjxrcs 5 x1)

  (setq	activesheet0
	 (vlax-get-property activeworkbook0 'ActiveSheet)
  )
  (setq pic (vlax-get activesheet0 'Pictures))	;Pictures object
  (setq picture (vlax-invoke pic 'insert (strcat ph nm))) ;execute insert image
  (vlax-invoke picture 'select)		;select this image
  (setq
    shape (vlax-get (vlax-get activeworkbook0 'selection) 'shapeRange)
  )					;picture object
  (vlax-put shape 'LockAspectRatio 0)	;Release aspect lock
  (vlax-put shape 'Height (* 28.3464566929 Height))
					;Set the height of the image (pixels)
  (vlax-put shape 'width (* 28.3464566929 width)) ;Set the width of the image (pixels)
  (vlax-invoke shape 'IncrementTop (* 28.3464566929 down))
					;Set the image downshift distance (pixels)
  (vlax-invoke shape 'IncrementLeft (* 28.3464566929 right))
					;Set the image right shift distance (pixels)
  shape
)

I found a piece of code on the Internet, this is just an example, it doesn't seem to be complete, and an error is reported when debugging, can you use this code to modify it to meet expectations

March 3, 2022

https://www.theswamp.org/index.php?topic=52702.0

I found this code. in MSWORD, paste new screenshot continuously in 1 word file.

automatic doc file making by same name. or open that if it existed.

I think do same thing in MSEXCEL is work.

(vl-load-com)

(defun c:ss (/ ods pt1 pt2 patch nm ss acdoc input_width input_height x_dist_selection y_dist_selection xy_ratio _opendirectory)
  (setvar "cmdecho" 0)
  (setq ods (getvar "osmode"))
  (setvar "osmode" 0)
 
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq    pt1 (getpoint "\nSelect the first point:")
            pt2 (getcorner pt1 "\nselect the second point:")
            ph  (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".png") ;edited line
  )

  (setq x_dist_selection (abs (- (car pt1) (car pt2)) )) ;edited line
  (setq y_dist_selection (abs (- (cadr pt1) (cadr pt2)) )) ;edited line
  (setq xy_ratio (/ y_dist_selection x_dist_selection)) ;edited line
  
  ;(initget 7) ;edited line
  ;(setq input_width (getint "\nInput image width (under approx.1500 is best):")) 
  
  (setq input_width 1000) ;input fixed value for simplify
  (setq input_height (atoi (rtos (* input_width xy_ratio) 2 0)) )

  ; if 1:1 scale, delete above 3 lines (initget 7)~(setq input_height ~)
  ; and add this (setq input_width x_dist_selection) (setq input_height y_dist_selection)

  (setq input_width (+ input_width 16)) ; 16 is my environment gap of window size & image size. shoud be edited
  (setq input_height (+ input_height 55)) ; 45 is my environment gap of window size & image size. shoud be edited

  (if (= (findfile ph) nil) 
     (progn 
        (princ "\nCreate new image file ")
     ) 
     (progn 
        (vl-file-delete ph) 
        (princ "\nReplace image file")
     )
  )


  (if (setq ss (ssget "w" pt1 pt2)) ;'((0 . "lwpolyline,line,ARC"))))
    (progn
      (command "_Zoom" "OB" ss "")
      (vla-put-height acdoc input_height)  ;edited line
      (vla-put-width acdoc input_width)  ;edited line
      (command "_pngout" ph "all" "") ;edited line for all entities, replace with (command "_pngout" ph ss "") 
    )
  )
  (command "_Zoom" "p")
  (vla-put-windowstate acdoc 3)  ;edited line
  (command "_syswindows" "c")  ;edited line

  (setvar "osmode" ods)
  (princ "\ndone.")
  (princ (strcat "\nimage output path:" ph))



 (setq app (vlax-get-or-create-object "Word.Application"))
 (vla-put-visible app :vlax-true)
 (vlax-put-property app 'ScreenUpdating :vlax-true)
 (setq docs (vlax-get-property app 'Documents))
;; open test file
 (vlax-invoke-method docs 'Open (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".doc") :vlax-false)
 (setq doc (vlax-get-property app 'Activedocument))

 (vlax-invoke-method doc 'Activate)
 (setq paragraphs (vlax-get-property doc 'paragraphs ))
 (setq para(vlax-get-property paragraphs 'last ))
 (setq range (vlax-get-property para 'range ))
 ;; 
 (setq selection (vlax-get-property app 'Selection ))
 
 ;; set cursor in last page [here's the error ???]
 (vlax-invoke-method selection 'Endkey 6)
 (vlax-invoke-method range 'Collapse  0) ; wdCollapseEnd costant value = 0
;; get image obiect
 (setq img (vlax-get-property selection 'InlineShapes))
;; insert  image
 (setq pic(vlax-invoke-method img 'AddPicture ph))
 
; closing..
 
 (vlax-invoke-method doc 'Saveas  (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".doc"))
 (vlax-invoke-method doc 'Close)
 (vlax-invoke-method app 'Quit)




(defun _opendirectory (path / sa)  ;edited line
 (if (and (eq 'str (type path))  ;edited line
   (findfile (vl-string-right-trim "\\" path))  ;edited line
   (setq sa (vlax-create-object "Shell.Application"))  ;edited line
     ) ;edited line
   (progn (vlax-invoke sa 'explore path) (vlax-release-object sa)) ;edited line
 ) ;edited line
 (princ) ;edited line
) ;edited line

(_opendirectory (getvar 'dwgprefix)) ;edited line
(vl-file-delete ph)


  (setvar "osmode" ods)
  (princ)
)

(princ "\n loading complete")

below SS2 is wmf version

(vl-load-com)

(defun c:ss2 (/ ods pt1 pt2 patch nm ss acdoc input_width input_height x_dist_selection y_dist_selection xy_ratio _opendirectory)
  (setvar "cmdecho" 0)
  (setq ods (getvar "osmode"))
  (setvar "osmode" 0)
 
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq    pt1 (getpoint "\nSelect the first point:")
            pt2 (getcorner pt1 "\nselect the second point:")
            ph  (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".wmf") ;edited line
  )

  (setq x_dist_selection (abs (- (car pt1) (car pt2)) )) ;edited line
  (setq y_dist_selection (abs (- (cadr pt1) (cadr pt2)) )) ;edited line
  (setq xy_ratio (/ y_dist_selection x_dist_selection)) ;edited line
  
  ;(initget 7) ;edited line
  ;(setq input_width (getint "\nInput image width (under approx.1500 is best):")) 
  
  (setq input_width 1000) ;input fixed value for simplify
  (setq input_height (atoi (rtos (* input_width xy_ratio) 2 0)) )

  ; if 1:1 scale, delete above 3 lines (initget 7)~(setq input_height ~)
  ; and add this (setq input_width x_dist_selection) (setq input_height y_dist_selection)

  (setq input_width (+ input_width 16)) ; 16 is my environment gap of window size & image size. shoud be edited
  (setq input_height (+ input_height 55)) ; 45 is my environment gap of window size & image size. shoud be edited

  (if (= (findfile ph) nil) 
     (progn 
        (princ "\nCreate new image file ")
     ) 
     (progn 
        (vl-file-delete ph) 
        (princ "\nReplace image file")
     )
  )


  (if (setq ss (ssget "w" pt1 pt2)) ;'((0 . "lwpolyline,line,ARC"))))
    (progn
      (command "_Zoom" "OB" ss "")
      (vla-put-height acdoc input_height)  ;edited line
      (vla-put-width acdoc input_width)  ;edited line
      (command "_wmfout" ph "all" "") ;edited line for all entities, replace with (command "_pngout" ph ss "") 
    )
  )
  (command "_Zoom" "p")
  (vla-put-windowstate acdoc 3)  ;edited line
  (command "_syswindows" "c")  ;edited line

  (setvar "osmode" ods)
  (princ "\ndone.")
  (princ (strcat "\nimage output path:" ph))



 (setq app (vlax-get-or-create-object "Word.Application"))
 (vla-put-visible app :vlax-true)
 (vlax-put-property app 'ScreenUpdating :vlax-true)
 (setq docs (vlax-get-property app 'Documents))
;; open test file
 (vlax-invoke-method docs 'Open (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".doc") :vlax-false)
 (setq doc (vlax-get-property app 'Activedocument))

 (vlax-invoke-method doc 'Activate)
 (setq paragraphs (vlax-get-property doc 'paragraphs ))
 (setq para(vlax-get-property paragraphs 'last ))
 (setq range (vlax-get-property para 'range ))
 ;; 
 (setq selection (vlax-get-property app 'Selection ))
 
 ;; set cursor in last page [here's the error ???]
 (vlax-invoke-method selection 'Endkey 6)
 (vlax-invoke-method range 'Collapse  0) ; wdCollapseEnd costant value = 0
;; get image obiect
 (setq img (vlax-get-property selection 'InlineShapes))
;; insert  image
 (setq pic(vlax-invoke-method img 'AddPicture ph))
 
; closing..
 
 (vlax-invoke-method doc 'Saveas  (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".doc"))
 (vlax-invoke-method doc 'Close)
 (vlax-invoke-method app 'Quit)




(defun _opendirectory (path / sa)  ;edited line
 (if (and (eq 'str (type path))  ;edited line
   (findfile (vl-string-right-trim "\\" path))  ;edited line
   (setq sa (vlax-create-object "Shell.Application"))  ;edited line
     ) ;edited line
   (progn (vlax-invoke sa 'explore path) (vlax-release-object sa)) ;edited line
 ) ;edited line
 (princ) ;edited line
) ;edited line

(_opendirectory (getvar 'dwgprefix)) ;edited line
(vl-file-delete ph)


  (setvar "osmode" ods)
  (princ)
)

(princ "\n loading complete")

Edited March 3, 2022 by exceed

March 3, 2022

1 minute ago, ekko said:

(defun jc-excel-insertpicture (et      path    Height  width   down
			       right   /       EXCEL   PIC     PICTURE
			       SHAPE   SHEET
			      )
  (vl-load-com)
  (setq excelapp0 (vlax-get-object "Excel.Application")) ;Get the excel app
  (setq	activeworkbook0
	 (vlax-get-property excelapp0 'ActiveWorkbook)
  )
  ;;excel workbook object
  (setq	activesheet0
	 (vlax-get-property activeworkbook0 'ActiveSheet)
  )
  ;;excel worksheet object
  (setq cells0 (vlax-get-property activesheet0 'cells))
  ;;excel cell object
					;(vlax-put-property cells0 'item sjxrcs 5 x1)

  (setq	activesheet0
	 (vlax-get-property activeworkbook0 'ActiveSheet)
  )
  (setq pic (vlax-get activesheet0 'Pictures))	;Pictures object
  (setq picture (vlax-invoke pic 'insert (strcat ph nm))) ;execute insert image
  (vlax-invoke picture 'select)		;select this image
  (setq
    shape (vlax-get (vlax-get activeworkbook0 'selection) 'shapeRange)
  )					;picture object
  (vlax-put shape 'LockAspectRatio 0)	;Release aspect lock
  (vlax-put shape 'Height (* 28.3464566929 Height))
					;Set the height of the image (pixels)
  (vlax-put shape 'width (* 28.3464566929 width)) ;Set the width of the image (pixels)
  (vlax-invoke shape 'IncrementTop (* 28.3464566929 down))
					;Set the image downshift distance (pixels)
  (vlax-invoke shape 'IncrementLeft (* 28.3464566929 right))
					;Set the image right shift distance (pixels)
  shape
)

I want it to be done automatically without the need to manually go and paste the copy,I found a piece of code on the Internet, this is just an example, it doesn't seem to be complete, and an error is reported when debugging, can you use this code to modify it to meet expectations

March 3, 2022

3 minutes ago, exceed said:

https://www.theswamp.org/index.php?topic=52702.0

I found this code. in MSWORD, paste new screenshot continuously in 1 word file.

I think do same thing in MSEXCEL is work.

(defun jc-excel-insertpicture (et      path    Height  width   down
			       right   /       EXCEL   PIC     PICTURE
			       SHAPE   SHEET
			      )
  (vl-load-com)
  (setq excelapp0 (vlax-get-object "Excel.Application")) ;Get the excel app
  (setq	activeworkbook0
	 (vlax-get-property excelapp0 'ActiveWorkbook)
  )
  ;;excel workbook object
  (setq	activesheet0
	 (vlax-get-property activeworkbook0 'ActiveSheet)
  )
  ;;excel worksheet object
  (setq cells0 (vlax-get-property activesheet0 'cells))
  ;;excel cell object
					;(vlax-put-property cells0 'item sjxrcs 5 x1)

  (setq	activesheet0
	 (vlax-get-property activeworkbook0 'ActiveSheet)
  )
  (setq pic (vlax-get activesheet0 'Pictures))	;Pictures object
  (setq picture (vlax-invoke pic 'insert (strcat ph nm))) ;execute insert image
  (vlax-invoke picture 'select)		;select this image
  (setq
    shape (vlax-get (vlax-get activeworkbook0 'selection) 'shapeRange)
  )					;picture object
  (vlax-put shape 'LockAspectRatio 0)	;Release aspect lock
  (vlax-put shape 'Height (* 28.3464566929 Height))
					;Set the height of the image (pixels)
  (vlax-put shape 'width (* 28.3464566929 width)) ;Set the width of the image (pixels)
  (vlax-invoke shape 'IncrementTop (* 28.3464566929 down))
					;Set the image downshift distance (pixels)
  (vlax-invoke shape 'IncrementLeft (* 28.3464566929 right))
					;Set the image right shift distance (pixels)
  shape
)

I found a piece of code on the Internet, it seems to be broken and can't run, this code is beyond my understanding, can you help me read, is this code feasible, thank you

March 3, 2022

(vl-load-com)

(defun c:ss3 (/ ods pt1 pt2 patch nm ss acdoc input_width input_height x_dist_selection y_dist_selection xy_ratio _opendirectory)
  (setvar "cmdecho" 0)
  (setq ods (getvar "osmode"))
  (setvar "osmode" 0)
 
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq    pt1 (getpoint "\nSelect the first point:")
            pt2 (getcorner pt1 "\nselect the second point:")
            ph  (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".wmf") ;edited line
  )

  (setq x_dist_selection (abs (- (car pt1) (car pt2)) )) ;edited line
  (setq y_dist_selection (abs (- (cadr pt1) (cadr pt2)) )) ;edited line
  (setq xy_ratio (/ y_dist_selection x_dist_selection)) ;edited line
  
  (setq input_width 1000) ;input fixed value for simplify
  (setq input_height (atoi (rtos (* input_width xy_ratio) 2 0)) )

  (setq input_width (+ input_width 16)) ; 16 is my environment gap of window size & image size. shoud be edited
  (setq input_height (+ input_height 55)) ; 45 is my environment gap of window size & image size. shoud be edited

  (if (= (findfile ph) nil) 
     (progn 
        (princ "\nCreate new image file ")
     ) 
     (progn 
        (vl-file-delete ph) 
        (princ "\nReplace image file")
     )
  )

  (if (setq ss (ssget "w" pt1 pt2)) ;'((0 . "lwpolyline,line,ARC"))))
    (progn
      (command "_Zoom" "OB" ss "")
      (vla-put-height acdoc input_height)  ;edited line
      (vla-put-width acdoc input_width)  ;edited line
      (command "_wmfout" ph "all" "") ;edited line for all entities, replace with (command "_pngout" ph ss "") 
    )
  )
  (command "_Zoom" "p")
  (vla-put-windowstate acdoc 3)  ;edited line
  (command "_syswindows" "c")  ;edited line

  (setvar "osmode" ods)
  (princ "\ndone.")
  (princ (strcat "\nimage output path:" ph))



 (setq app (vlax-get-or-create-object "Excel.Application"))
 (vla-put-visible app :vlax-true)
 (vlax-put-property app 'ScreenUpdating :vlax-true)
  (setq	activeworkbook0
	 (vlax-get-property app 'ActiveWorkbook)
  )
  (setq	activesheet0
	 (vlax-get-property activeworkbook0 'ActiveSheet)
  )
  (setq cells0 (vlax-get-property activesheet0 'cells))

  (setq pic (vlax-get activesheet0 'Pictures))	;Pictures object
  (setq picture (vlax-invoke pic 'insert ph)) ;execute insert image

  (vlax-invoke picture 'select)		;select this image

  (setq
    shape (vlax-get (vlax-get activeworkbook0 'selection) 'shapeRange)
  )					;picture object

  (vlax-put shape 'LockAspectRatio 0)	;Release aspect lock



  (vlax-put shape 'Height input_height)
					;Set the height of the image (pixels)
  (vlax-put shape 'width input_width) ;Set the width of the image (pixels)
  (vlax-invoke shape 'IncrementTop (* 28.3464566929 down))
					;Set the image downshift distance (pixels)
  (vlax-invoke shape 'IncrementLeft (* 28.3464566929 right))
					;Set the image right shift distance (pixels)
; closing..

 ;(vlax-invoke-method app 'Saveas  (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".xlsx"))
 ;(vlax-invoke-method app 'Close)
 (vlax-invoke-method app 'Quit)



(vl-file-delete ph)


  (setvar "osmode" ods)
  (princ)
)

(princ "\n loading complete")

ss3

open empty excel file. before run this lisp.

paste in selected cell, but size is 1:1 scale, not fit to cell

Edited March 3, 2022 by exceed

March 3, 2022

There is a lot of code involved in Autocad <--> Excel so 1 comment you can pick a cell in excel and return that to your lisp so could pick a random cell for image. The pasteclip may be simpler method a google paste image into excel macro should reveal the code required.

The same with open excel as new or a existing file.

(if (= (setq myxl (vlax-get-object "Excel.Application") ) nil)
(setq myxl (vlax-get-or-create-object "excel.Application"))
)

March 3, 2022

3 hours ago, exceed said:

(vl-load-com)

(defun c:ss3 (/ ods pt1 pt2 patch nm ss acdoc input_width input_height x_dist_selection y_dist_selection xy_ratio _opendirectory)
  (setvar "cmdecho" 0)
  (setq ods (getvar "osmode"))
  (setvar "osmode" 0)
 
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq    pt1 (getpoint "\nSelect the first point:")
            pt2 (getcorner pt1 "\nselect the second point:")
            ph  (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".wmf") ;edited line
  )

  (setq x_dist_selection (abs (- (car pt1) (car pt2)) )) ;edited line
  (setq y_dist_selection (abs (- (cadr pt1) (cadr pt2)) )) ;edited line
  (setq xy_ratio (/ y_dist_selection x_dist_selection)) ;edited line
  
  (setq input_width 1000) ;input fixed value for simplify
  (setq input_height (atoi (rtos (* input_width xy_ratio) 2 0)) )

  (setq input_width (+ input_width 16)) ; 16 is my environment gap of window size & image size. shoud be edited
  (setq input_height (+ input_height 55)) ; 45 is my environment gap of window size & image size. shoud be edited

  (if (= (findfile ph) nil) 
     (progn 
        (princ "\nCreate new image file ")
     ) 
     (progn 
        (vl-file-delete ph) 
        (princ "\nReplace image file")
     )
  )

  (if (setq ss (ssget "w" pt1 pt2)) ;'((0 . "lwpolyline,line,ARC"))))
    (progn
      (command "_Zoom" "OB" ss "")
      (vla-put-height acdoc input_height)  ;edited line
      (vla-put-width acdoc input_width)  ;edited line
      (command "_wmfout" ph "all" "") ;edited line for all entities, replace with (command "_pngout" ph ss "") 
    )
  )
  (command "_Zoom" "p")
  (vla-put-windowstate acdoc 3)  ;edited line
  (command "_syswindows" "c")  ;edited line

  (setvar "osmode" ods)
  (princ "\ndone.")
  (princ (strcat "\nimage output path:" ph))



 (setq app (vlax-get-or-create-object "Excel.Application"))
 (vla-put-visible app :vlax-true)
 (vlax-put-property app 'ScreenUpdating :vlax-true)
  (setq	activeworkbook0
	 (vlax-get-property app 'ActiveWorkbook)
  )
  (setq	activesheet0
	 (vlax-get-property activeworkbook0 'ActiveSheet)
  )
  (setq cells0 (vlax-get-property activesheet0 'cells))

  (setq pic (vlax-get activesheet0 'Pictures))	;Pictures object
  (setq picture (vlax-invoke pic 'insert ph)) ;execute insert image

  (vlax-invoke picture 'select)		;select this image

  (setq
    shape (vlax-get (vlax-get activeworkbook0 'selection) 'shapeRange)
  )					;picture object

  (vlax-put shape 'LockAspectRatio 0)	;Release aspect lock



  (vlax-put shape 'Height input_height)
					;Set the height of the image (pixels)
  (vlax-put shape 'width input_width) ;Set the width of the image (pixels)
  (vlax-invoke shape 'IncrementTop (* 28.3464566929 down))
					;Set the image downshift distance (pixels)
  (vlax-invoke shape 'IncrementLeft (* 28.3464566929 right))
					;Set the image right shift distance (pixels)
; closing..

 ;(vlax-invoke-method app 'Saveas  (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".xlsx"))
 ;(vlax-invoke-method app 'Close)
 (vlax-invoke-method app 'Quit)



(vl-file-delete ph)


  (setvar "osmode" ods)
  (princ)
)

(princ "\n loading complete")

ss3

open empty excel file. before run this lisp.

paste in selected cell, but size is 1:1 scale, not fit to cell

Oh~ It's very magical to achieve this function, salute to you, thank you very much for your help, here is an error:
ActiveX server returned error: Unknown name: "SELECTION"

March 3, 2022

if you copy from "(vl-load-com)" well. i don't know why.

It works in my test. I load only that lisp, except others for test

March 3, 2022

11 minutes ago, exceed said:

if you copy from "(vl-load-com)" well. i don't know why.

It works in my test. I load only that lisp, except others for test

That's right, it can run and achieve the effect. After the operation is completed, the program reports a problem Unknown name: "SELECTION", I guess there is a problem with this code: (setq
shape (vlax-get (vlax-get activeworkbook0 'selection) 'shapeRange)
) The “selection” in it does not know why it reports an error

Edited March 3, 2022 by ekko

March 3, 2022

ok, I study that, below is correct I think.

  (setq
    shape (vlax-get (vlax-get-property app 'selection) 'shapeRange)
  )

vlax-get > vlax-get-property

activeworkbook0 > app (excel application)

and add error control

when cancel the process (space-bar or esc), osmode recovered

and add option png,

ssw - wmf out

ssp - png out

if you want change width of picture.

(setq width_you_want 30) ;edit this 30 value. in ssw and ssp both.

this is same with width property in excel. (30cm)

(vl-load-com)

(defun c:ssw (/ *error* ods acdoc pt1 pt2 ph x_dist_selection y_dist_selection xy_ratio input_width input_height ss app activeworkbook0 activesheet0 cells0 shape pic picture width_you_want)
  (setvar "cmdecho" 0)
  (setq ods (getvar "osmode"))
  (setvar "osmode" 0)
  (LM:startundo (LM:acdoc))

    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (setvar "cmdecho" 1)
        (setvar "osmode" ods)
        (princ)
    ) 


  (princ "\nPlease open the excel sheet before running.\nInserts the selected area screenshot into the selected cell in Excel as a wmf image. (background transparent)")
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq    pt1 (getpoint "\nSelect the first point:")
            pt2 (getcorner pt1 "\nselect the second point:")
            ph  (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".wmf") ;edited line
  )

  (setq x_dist_selection (abs (- (car pt1) (car pt2)) )) ;edited line
  (setq y_dist_selection (abs (- (cadr pt1) (cadr pt2)) )) ;edited line
  (setq xy_ratio (/ y_dist_selection x_dist_selection)) ;edited line
  
  (setq input_width 1000) ;input fixed value for simplify
  (setq input_height (atoi (rtos (* input_width xy_ratio) 2 0)) )

  (setq input_width (+ input_width 16)) ; 16 is my environment gap of window size & image size. shoud be edited
  (setq input_height (+ input_height 55)) ; 55 is my environment gap of window size & image size. shoud be edited

  (if (= (findfile ph) nil) 
     (progn 
        (princ "\nCreate new image file ")
     ) 
     (progn 
        (vl-file-delete ph) 
        (princ "\nReplace image file")
     )
  )

  (if (setq ss (ssget "c" pt1 pt2)) ;'((0 . "lwpolyline,line,ARC"))))
    (progn
      (command "_Zoom" "w" pt1 pt2 "")
      (vla-put-height acdoc input_height)  ;edited line
      (vla-put-width acdoc input_width)  ;edited line
      (command "_wmfout" ph "all" "") ;edited line for all entities, replace with (command "_wmfout" ph ss "") 
    )
  )
  (command "_Zoom" "p")
  (vla-put-windowstate acdoc 3)  ;edited line
  (command "_syswindows" "c")  ;edited line

  (setvar "osmode" ods)
  (princ "\ndone.")
  (princ (strcat "\nimage output path:" ph))

 

 (setq app (vlax-get-or-create-object "Excel.Application"))
 (vla-put-visible app :vlax-true)
 (vlax-put-property app 'ScreenUpdating :vlax-true)
  (setq	activeworkbook0
	 (vlax-get-property app 'ActiveWorkbook)
  )
  (setq	activesheet0
	 (vlax-get-property activeworkbook0 'ActiveSheet)
  )
  (setq cells0 (vlax-get-property activesheet0 'cells))

  (setq pic (vlax-get activesheet0 'Pictures))	;Pictures object
  (setq picture (vlax-invoke pic 'insert ph)) ;execute insert image

  (vlax-invoke picture 'select)		;select this image


  (setq
    shape (vlax-get (vlax-get-property app 'selection) 'shapeRange)
  )					;picture object

  ;(vlax-put shape 'LockAspectRatio 0)	;Release aspect lock


  
  ;(vlax-put shape 'Height (/ input_height 3))
					;Set the height of the image (pixels)

  (setq width_you_want 30) ;edit this 30 value. this is same with width property in excel.
  (vlax-put shape 'width (* 28.3464566929 width_you_want)) ;Set the width of the image (pixels)
  ;(vlax-invoke shape 'IncrementTop input_height)
					;Set the image downshift distance (pixels)
  ;(vlax-invoke shape 'IncrementLeft input_width)
					;Set the image right shift distance (pixels)
; closing..

 ;(vlax-invoke-method app 'Saveas  (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".xlsx"))
 ;(vlax-invoke-method app 'Close)
 ;(vlax-invoke-method app 'Quit)

  (LM:endundo (LM:acdoc))
  (setvar "cmdecho" 1)
  (setvar "osmode" ods)
  (princ)
)



(defun c:ssp (/ *error* ods acdoc pt1 pt2 ph x_dist_selection y_dist_selection xy_ratio input_width input_height ss app activeworkbook0 activesheet0 cells0 shape pic picture width_you_want )
  (setvar "cmdecho" 0)
  (setq ods (getvar "osmode"))
  (setvar "osmode" 0)
  (LM:startundo (LM:acdoc))

    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (setvar "cmdecho" 1)
        (setvar "osmode" ods)
        (princ)
    ) 


  (princ "\nPlease open the excel sheet before running.\nInserts the selected area screenshot into the selected cell in Excel as a png image.")
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq    pt1 (getpoint "\nSelect the first point:")
            pt2 (getcorner pt1 "\nselect the second point:")
            ph  (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".png") ;edited line
  )

  (setq x_dist_selection (abs (- (car pt1) (car pt2)) )) ;edited line
  (setq y_dist_selection (abs (- (cadr pt1) (cadr pt2)) )) ;edited line
  (setq xy_ratio (/ y_dist_selection x_dist_selection)) ;edited line
  
  (setq input_width 1200) ;input fixed value for simplify
  (setq input_height (atoi (rtos (* input_width xy_ratio) 2 0)) )

  (setq input_width (+ input_width 16)) ; 16 is my environment gap of window size & image size. shoud be edited
  (setq input_height (+ input_height 55)) ; 45 is my environment gap of window size & image size. shoud be edited

  (if (= (findfile ph) nil) 
     (progn 
        (princ "\nCreate new image file ")
     ) 
     (progn 
        (vl-file-delete ph) 
        (princ "\nReplace image file")
     )
  )

  (if (setq ss (ssget "c" pt1 pt2)) ;'((0 . "lwpolyline,line,ARC"))))
    (progn
      (command "_Zoom" "w" pt1 pt2 "")
      (vla-put-height acdoc input_height)  ;edited line
      (vla-put-width acdoc input_width)  ;edited line
      (command "_pngout" ph "all" "") ;edited line for all entities, replace with (command "_pngout" ph ss "") 
    )
  )
  (command "_Zoom" "p")
  (vla-put-windowstate acdoc 3)  ;edited line
  (command "_syswindows" "c")  ;edited line

  (setvar "osmode" ods)
  (princ "\ndone.")
  (princ (strcat "\nimage output path:" ph))

 

 (setq app (vlax-get-or-create-object "Excel.Application"))
 (vla-put-visible app :vlax-true)
 (vlax-put-property app 'ScreenUpdating :vlax-true)
  (setq	activeworkbook0
	 (vlax-get-property app 'ActiveWorkbook)
  )
  (setq	activesheet0
	 (vlax-get-property activeworkbook0 'ActiveSheet)
  )
  (setq cells0 (vlax-get-property activesheet0 'cells))

  (setq pic (vlax-get activesheet0 'Pictures))	;Pictures object
  (setq picture (vlax-invoke pic 'insert ph)) ;execute insert image

  (vlax-invoke picture 'select)		;select this image



  (setq
    shape (vlax-get (vlax-get-property app 'selection) 'shapeRange)
  )					;picture object

  ;(vlax-put shape 'LockAspectRatio 0)	;Release aspect lock


  ;(vlax-put shape 'Height (/ input_height 3))
					;Set the height of the image (pixels)


  (setq width_you_want 30) ;edit this 30 value. this is same with width property in excel.
  (vlax-put shape 'width (* 28.3464566929 width_you_want)) ;Set the width of the image (pixels)
  ;(vlax-invoke shape 'IncrementTop input_height)
					;Set the image downshift distance (pixels)
  ;(vlax-invoke shape 'IncrementLeft input_width)
					;Set the image right shift distance (pixels)
; closing..

 ;(vlax-invoke-method app 'Saveas  (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".xlsx"))
 ;(vlax-invoke-method app 'Close)
 ;(vlax-invoke-method app 'Quit)




  (LM:endundo (LM:acdoc))
  (setvar "cmdecho" 1)
  (setvar "osmode" ods)
  (princ)
)


;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)


;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)





(princ "\nSSW, SSP - loading complete")

code edited. after posting

Edited March 3, 2022 by exceed

March 3, 2022

1 hour ago, exceed said:

o

(vl-load-com)

(defun c:ssw (/ *error* ods acdoc pt1 pt2 ph x_dist_selection y_dist_selection xy_ratio input_width input_height ss app activeworkbook0 activesheet0 cells0 shape pic picture width_you_want)
  (setvar "cmdecho" 0)
  (setq ods (getvar "osmode"))
  (setvar "osmode" 0)
  (LM:startundo (LM:acdoc))

    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (setvar "cmdecho" 1)
        (setvar "osmode" ods)
        (princ)
    ) 



  (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq    pt1 (getpoint "\nSelect the first point:")
            pt2 (getcorner pt1 "\nselect the second point:")
            ph  (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".wmf") ;edited line
  )

  (setq x_dist_selection (abs (- (car pt1) (car pt2)) )) ;edited line
  (setq y_dist_selection (abs (- (cadr pt1) (cadr pt2)) )) ;edited line
  (setq xy_ratio (/ y_dist_selection x_dist_selection)) ;edited line
  
  (setq input_width 1000) ;input fixed value for simplify
  (setq input_height (atoi (rtos (* input_width xy_ratio) 2 0)) )

  (setq input_width (+ input_width 16)) ; 16 is my environment gap of window size & image size. shoud be edited
  (setq input_height (+ input_height 55)) ; 45 is my environment gap of window size & image size. shoud be edited

  (if (= (findfile ph) nil) 
     (progn 
        (princ "\nCreate new image file ")
     ) 
     (progn 
        (vl-file-delete ph) 
        (princ "\nReplace image file")
     )
  )

  (if (setq ss (ssget "c" pt1 pt2)) ;'((0 . "lwpolyline,line,ARC"))))
    (progn
      (command "_Zoom" "w" pt1 pt2 "")
      (vla-put-height acdoc input_height)  ;edited line
      (vla-put-width acdoc input_width)  ;edited line
      (command "_wmfout" ph "all" "") ;edited line for all entities, replace with (command "_wmfout" ph ss "") 
    )
  )
  (command "_Zoom" "p")
  (vla-put-windowstate acdoc 3)  ;edited line
  (command "_syswindows" "c")  ;edited line

  (setvar "osmode" ods)
  (princ "\ndone.")
  (princ (strcat "\nimage output path:" ph))

 

 (setq app (vlax-get-or-create-object "Excel.Application"))
 (vla-put-visible app :vlax-true)
 (vlax-put-property app 'ScreenUpdating :vlax-true)
  (setq	activeworkbook0
	 (vlax-get-property app 'ActiveWorkbook)
  )
  (setq	activesheet0
	 (vlax-get-property activeworkbook0 'ActiveSheet)
  )
  (setq cells0 (vlax-get-property activesheet0 'cells))

  (setq pic (vlax-get activesheet0 'Pictures))	;Pictures object
  (setq picture (vlax-invoke pic 'insert ph)) ;execute insert image

  (vlax-invoke picture 'select)		;select this image


  (setq
    shape (vlax-get (vlax-get-property app 'selection) 'shapeRange)
  )					;picture object

  ;(vlax-put shape 'LockAspectRatio 0)	;Release aspect lock


  
  ;(vlax-put shape 'Height (/ input_height 3))
					;Set the height of the image (pixels)

  (setq width_you_want 30) ;edit this 30 value. this is same with width property in excel.
  (vlax-put shape 'width (* 28.3464566929 width_you_want)) ;Set the width of the image (pixels)
  ;(vlax-invoke shape 'IncrementTop input_height)
					;Set the image downshift distance (pixels)
  ;(vlax-invoke shape 'IncrementLeft input_width)
					;Set the image right shift distance (pixels)
; closing..

 ;(vlax-invoke-method app 'Saveas  (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".xlsx"))
 ;(vlax-invoke-method app 'Close)
 ;(vlax-invoke-method app 'Quit)

  (LM:endundo (LM:acdoc))
  (setvar "cmdecho" 1)
  (setvar "osmode" ods)
  (princ)
)



(defun c:ssp (/ *error* ods acdoc pt1 pt2 ph x_dist_selection y_dist_selection xy_ratio input_width input_height ss app activeworkbook0 activesheet0 cells0 shape pic picture width_you_want )
  (setvar "cmdecho" 0)
  (setq ods (getvar "osmode"))
  (setvar "osmode" 0)
  (LM:startundo (LM:acdoc))

    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (setvar "cmdecho" 1)
        (setvar "osmode" ods)
        (princ)
    ) 

  (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq    pt1 (getpoint "\nSelect the first point:")
            pt2 (getcorner pt1 "\nselect the second point:")
            ph  (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".png") ;edited line
  )

  (setq x_dist_selection (abs (- (car pt1) (car pt2)) )) ;edited line
  (setq y_dist_selection (abs (- (cadr pt1) (cadr pt2)) )) ;edited line
  (setq xy_ratio (/ y_dist_selection x_dist_selection)) ;edited line
  
  (setq input_width 1200) ;input fixed value for simplify
  (setq input_height (atoi (rtos (* input_width xy_ratio) 2 0)) )

  (setq input_width (+ input_width 16)) ; 16 is my environment gap of window size & image size. shoud be edited
  (setq input_height (+ input_height 55)) ; 45 is my environment gap of window size & image size. shoud be edited

  (if (= (findfile ph) nil) 
     (progn 
        (princ "\nCreate new image file ")
     ) 
     (progn 
        (vl-file-delete ph) 
        (princ "\nReplace image file")
     )
  )

  (if (setq ss (ssget "c" pt1 pt2)) ;'((0 . "lwpolyline,line,ARC"))))
    (progn
      (command "_Zoom" "w" pt1 pt2 "")
      (vla-put-height acdoc input_height)  ;edited line
      (vla-put-width acdoc input_width)  ;edited line
      (command "_pngout" ph "all" "") ;edited line for all entities, replace with (command "_pngout" ph ss "") 
    )
  )
  (command "_Zoom" "p")
  (vla-put-windowstate acdoc 3)  ;edited line
  (command "_syswindows" "c")  ;edited line

  (setvar "osmode" ods)
  (princ "\ndone.")
  (princ (strcat "\nimage output path:" ph))

 

 (setq app (vlax-get-or-create-object "Excel.Application"))
 (vla-put-visible app :vlax-true)
 (vlax-put-property app 'ScreenUpdating :vlax-true)
  (setq	activeworkbook0
	 (vlax-get-property app 'ActiveWorkbook)
  )
  (setq	activesheet0
	 (vlax-get-property activeworkbook0 'ActiveSheet)
  )
  (setq cells0 (vlax-get-property activesheet0 'cells))

  (setq pic (vlax-get activesheet0 'Pictures))	;Pictures object
  (setq picture (vlax-invoke pic 'insert ph)) ;execute insert image

  (vlax-invoke picture 'select)		;select this image



  (setq
    shape (vlax-get (vlax-get-property app 'selection) 'shapeRange)
  )					;picture object

  ;(vlax-put shape 'LockAspectRatio 0)	;Release aspect lock


  ;(vlax-put shape 'Height (/ input_height 3))
					;Set the height of the image (pixels)


  (setq width_you_want 30) ;edit this 30 value. this is same with width property in excel.
  (vlax-put shape 'width (* 28.3464566929 width_you_want)) ;Set the width of the image (pixels)
  ;(vlax-invoke shape 'IncrementTop input_height)
					;Set the image downshift distance (pixels)
  ;(vlax-invoke shape 'IncrementLeft input_width)
					;Set the image right shift distance (pixels)
; closing..

 ;(vlax-invoke-method app 'Saveas  (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".xlsx"))
 ;(vlax-invoke-method app 'Close)
 ;(vlax-invoke-method app 'Quit)




  (LM:endundo (LM:acdoc))
  (setvar "cmdecho" 1)
  (setvar "osmode" ods)
  (princ)
)


;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)


;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)





(princ "\n loading complete")

The program is running very well, exactly as I expected, obviously you are a selfless person, I wish you good health and a happy life my brother, thank you very much for your help, salute to you

March 3, 2022

2 hours ago, exceed said:
  (setq
    shape (vlax-get (vlax-get-property app 'selection) 'shapeRange)
  )
(vlax-put-property cells0 'item 1 1 picture )

May I ask if I can insert a picture into a specific row or column of cells, (vlax-put-property cells0 'item 1 1 picture ) similar to this, unfortunately, I don't know why, this method will report an error.

March 7, 2022

(vlax-put-property cells0 'item y x "textstring")

I think, this works with text string or text string variable only.

Because Excel treats images as special objects separate from cell values

so, the lisp code you get in internet. also shifting down images and shifting right images in units of pixels, not cells.

of course, there is a way to create a function using Excel's vba macro and insert an image into a cell,

but I don't think it's a good way to put a macro in every target Excel file and change it to an .xlsm file for all work.

or if you want use that sentence, can approach like this way

making image to not replace. (with loop and indexing name of image)

='<img src=""full path of image" "width=100 height=100 ><table>

and copy to clipboard and paste special to put unicode format texts.

i success to put them all. but I failed to load image.

it's not good way also. because images is not in excel.

so, I thnk below is better and different way to approach

make loop like this

(defun c:ssw2 (/ index r c)
  (setq index 0)
  (setq r 1)
  (setq c 1)
  (while 
     (c:ssw)
     (setq r (+ r 1))
     (setq index (+ index 1))
  )
)

and add this

  (setq addr (strcat (chr (+ 64 c)) (itoa r) ":" (chr (+ (ascii (chr (+ 64 c))) (1- 1))) (itoa (+ r (1- 1)))))
  (setq rng (vlax-get-property activesheet0 'Range addr))
  (vlax-invoke Rng 'Select)

in front of this

(setq pic (vlax-get activesheet0 'Pictures)) ;Pictures object
(setq picture (vlax-invoke pic 'insert ph)) ;execute insert image

because this routine is paste in current selected cell in excel.

so, this additional code will change selected cell.

but this is start from column 1, row 1

it will be change with this, paste it in front of ssw2

(setq ExcelApp (vl-catch-all-apply
	       (function (lambda ()(vlax-get-or-create-object "Excel.Application")))))

(if (vl-catch-all-error-p
      (setq Wbk
	     (vl-catch-all-apply
	       (function (lambda ()
			   (vlax-get-property ExcelApp "ActiveWorkBook"))))))
  (progn
    (alert "open Excel before you run this")
    (exit)
    (*error* nil)
    (princ)
    )
  )
(setq Sht
       (vl-catch-all-apply
	 (function (lambda ()
		     (vlax-get-property ExcelApp "ActiveSheet")))))

(vlax-put-property ExcelApp 'visible :vlax-true)

(vlax-put-property ExcelApp 'ScreenUpdating :vlax-true)

(vlax-put-property ExcelApp 'DisplayAlerts :vlax-false)

(princ "\n go to excel then select cell to paste picture")

(if (not (vl-catch-all-error-p
	   (setq Rng
		  (vl-catch-all-apply
		    (function (lambda ()
				(vlax-variant-value
				  (vlax-invoke-method
				    (vlax-get-property Wbk 'Application)
				    'Inputbox
				    "select 1 cell you put in : "
				    "ssw"
				    nil
				    nil
				    nil
				    nil
				    nil
				    8))))))))
  (progn
    (vlax-put-property ExcelApp 'DisplayAlerts :vlax-true)

    (setq r (vlax-get-property Rng 'row))
    (setq c (vlax-get-property Rng 'column))

ExcelApp and Wbk is same with in ssw's. you can optimize this.

and then select entire row. and change row height

=============

like this

; instant screenshot for excel - 2022.03.07 exceed
; open target excel sheet before run this lisp.
;
; - command 
; ssw - screenshot .wmf to selected cell in excel 
; ssp - screenshot .png to selected cell in excel 
; ssw2 - screenshot .wmf to excel continuously from selected cell
; ssp2 - screenshot .png to excel continuously from selected cell
;
; note - If the height is much longer than the width, a wider range than the set width can be seen.
;          Due to a limitation in Excel, the maximum cell height is 409.5.

(vl-load-com)


(defun c:ssw (/ *error* ods acdoc pt1 pt2 ph x_dist_selection y_dist_selection xy_ratio input_width input_height ss app activeworkbook0 activesheet0 cells0 shape pic picture width_you_want)
  (setvar "cmdecho" 0)
  (setq ods (getvar "osmode"))
  (setvar "osmode" 0)
  (LM:startundo (LM:acdoc))

    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (setvar "cmdecho" 1)
        (setvar "osmode" ods)
        (princ)
    ) 


  (princ "\nPlease open the excel sheet before running.\nInserts the selected area screenshot into the selected cell in Excel as a wmf image. (background transparent)")

  (ex:ESMAKE)
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq    pt1 (getpoint "\nSelect the first point:")
            pt2 (getcorner pt1 "\nselect the second point:")
            ph  (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) "-" (rtos (getvar 'cdate) 2 10) ".wmf") ;edited line
  )

  (setq x_dist_selection (abs (- (car pt1) (car pt2)) )) ;edited line
  (setq y_dist_selection (abs (- (cadr pt1) (cadr pt2)) )) ;edited line
  (setq xy_ratio (/ y_dist_selection x_dist_selection)) ;edited line
  
  (setq input_width 1000) ;input fixed value for simplify
  (setq input_height (atoi (rtos (* input_width xy_ratio) 2 0)) )

  (setq input_width (+ input_width 16)) ; 16 is my environment gap of window size & image size. shoud be edited
  (setq input_height (+ input_height 55)) ; 55 is my environment gap of window size & image size. shoud be edited

  (if (= (findfile ph) nil) 
     (progn 
        (princ "\nCreate new image file ")
     ) 
     (progn 
        (vl-file-delete ph) 
        (princ "\nReplace image file")
     )
  )

  (if (setq ss (ssget "c" pt1 pt2)) ;'((0 . "lwpolyline,line,ARC"))))
    (progn
      (command "_Zoom" "w" pt1 pt2 "")
      (vla-put-height acdoc input_height)  ;edited line
      (vla-put-width acdoc input_width)  ;edited line
      (command "_wmfout" ph "all" "") ;edited line for all entities, replace with (command "_wmfout" ph ss "") 
    )
  )
  (command "_Zoom" "p")
  (vla-put-windowstate acdoc 3)  ;edited line
  (command "_syswindows" "c")  ;edited line

  (setvar "osmode" ods)
  (princ "\ndone.")
  (princ (strcat "\nimage output path:" ph))

 

 (setq app (vlax-get-or-create-object "Excel.Application"))
 (vla-put-visible app :vlax-true)
 (vlax-put-property app 'ScreenUpdating :vlax-true)
  (setq	activeworkbook0
	 (vlax-get-property app 'ActiveWorkbook)
  )
  (setq	activesheet0
	 (vlax-get-property activeworkbook0 'ActiveSheet)
  )
  (setq cells0 (vlax-get-property activesheet0 'cells))

  (setq pic (vlax-get activesheet0 'Pictures))	;Pictures object
  (setq picture (vlax-invoke pic 'insert ph)) ;execute insert image

  (vlax-invoke picture 'select)		;select this image


  (setq
    shape (vlax-get (vlax-get-property app 'selection) 'shapeRange)
  )					;picture object

  ;(vlax-put shape 'LockAspectRatio 0)	;Release aspect lock


  
  ;(vlax-put shape 'Height (/ input_height 3))
					;Set the height of the image (pixels)

  (setq width_you_want 30) ;edit this 30 value. this is same with width property in excel.
  (vlax-put shape 'width (* 28.3464566929 width_you_want)) ;Set the width of the image (pixels)
  ;(vlax-invoke shape 'IncrementTop input_height)
					;Set the image downshift distance (pixels)
  ;(vlax-invoke shape 'IncrementLeft input_width)
					;Set the image right shift distance (pixels)
; closing..

 ;(vlax-invoke-method app 'Saveas  (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".xlsx"))
 ;(vlax-invoke-method app 'Close)
 ;(vlax-invoke-method app 'Quit)

  (LM:endundo (LM:acdoc))
  (setvar "cmdecho" 1)
  (setvar "osmode" ods)
  (princ)
)



(defun c:ssp (/ *error* ods acdoc pt1 pt2 ph x_dist_selection y_dist_selection xy_ratio input_width input_height ss app activeworkbook0 activesheet0 cells0 shape pic picture width_you_want )
  (setvar "cmdecho" 0)
  (setq ods (getvar "osmode"))
  (setvar "osmode" 0)
  (LM:startundo (LM:acdoc))

    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (setvar "cmdecho" 1)
        (setvar "osmode" ods)
        (princ)
    ) 


  (princ "\nPlease open the excel sheet before running.\nInserts the selected area screenshot into the selected cell in Excel as a png image.")

  (ex:ESMAKE)
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq    pt1 (getpoint "\nSelect the first point:")
            pt2 (getcorner pt1 "\nselect the second point:")
            ph  (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) "-" (rtos (getvar 'cdate) 2 10) ".png") ;edited line
  )

  (setq x_dist_selection (abs (- (car pt1) (car pt2)) )) ;edited line
  (setq y_dist_selection (abs (- (cadr pt1) (cadr pt2)) )) ;edited line
  (setq xy_ratio (/ y_dist_selection x_dist_selection)) ;edited line
  
  (setq input_width 1200) ;input fixed value for simplify
  (setq input_height (atoi (rtos (* input_width xy_ratio) 2 0)) )

  (setq input_width (+ input_width 16)) ; 16 is my environment gap of window size & image size. shoud be edited
  (setq input_height (+ input_height 55)) ; 45 is my environment gap of window size & image size. shoud be edited

  (if (= (findfile ph) nil) 
     (progn 
        (princ "\nCreate new image file ")
     ) 
     (progn 
        (vl-file-delete ph) 
        (princ "\nReplace image file")
     )
  )

  (if (setq ss (ssget "c" pt1 pt2)) ;'((0 . "lwpolyline,line,ARC"))))
    (progn
      (command "_Zoom" "w" pt1 pt2 "")
      (vla-put-height acdoc input_height)  ;edited line
      (vla-put-width acdoc input_width)  ;edited line
      (command "_pngout" ph "all" "") ;edited line for all entities, replace with (command "_pngout" ph ss "") 
    )
  )
  (command "_Zoom" "p")
  (vla-put-windowstate acdoc 3)  ;edited line
  (command "_syswindows" "c")  ;edited line

  (setvar "osmode" ods)
  (princ "\ndone.")
  (princ (strcat "\nimage output path:" ph))

 

 (setq app (vlax-get-or-create-object "Excel.Application"))
 (vla-put-visible app :vlax-true)
 (vlax-put-property app 'ScreenUpdating :vlax-true)
  (setq	activeworkbook0
	 (vlax-get-property app 'ActiveWorkbook)
  )
  (setq	activesheet0
	 (vlax-get-property activeworkbook0 'ActiveSheet)
  )
  (setq cells0 (vlax-get-property activesheet0 'cells))

  (setq pic (vlax-get activesheet0 'Pictures))	;Pictures object
  (setq picture (vlax-invoke pic 'insert ph)) ;execute insert image

  (vlax-invoke picture 'select)		;select this image



  (setq
    shape (vlax-get (vlax-get-property app 'selection) 'shapeRange)
  )					;picture object

  ;(vlax-put shape 'LockAspectRatio 0)	;Release aspect lock


  ;(vlax-put shape 'Height (/ input_height 3))
					;Set the height of the image (pixels)


  (setq width_you_want 30) ;edit this 30 value. this is same with width property in excel.
  (vlax-put shape 'width (* 28.3464566929 width_you_want)) ;Set the width of the image (pixels)
  ;(vlax-invoke shape 'IncrementTop input_height)
					;Set the image downshift distance (pixels)
  ;(vlax-invoke shape 'IncrementLeft input_width)
					;Set the image right shift distance (pixels)
; closing..

 ;(vlax-invoke-method app 'Saveas  (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".xlsx"))
 ;(vlax-invoke-method app 'Close)
 ;(vlax-invoke-method app 'Quit)




  (LM:endundo (LM:acdoc))
  (setvar "cmdecho" 1)
  (setvar "osmode" ods)
  (princ)
)


(defun c:ssw2 (/ *error* addr selectedcolumns columnwidthtofit xlrows xlcolumns rowheighttofit selectedrows app index r c rng activeworkbook0 activesheet0 ods acdoc pt1 pt2 ph x_dist_selection y_dist_selection xy_ratio input_width input_height ss cells0 shape pic picture width_you_want)
  (setvar "cmdecho" 0)
  (setq ods (getvar "osmode"))
  (setvar "osmode" 0)
  (LM:startundo (LM:acdoc))

    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (setvar "cmdecho" 1)
        (setvar "osmode" ods)
        (princ)
    ) 
  (princ "\n Screenshot Loop")

  (ex:ESMAKE)
  (setq app (vlax-get-or-create-object "Excel.Application"))
  (if (vl-catch-all-error-p (setq activeworkbook0 (vl-catch-all-apply (function (lambda () (vlax-get-property app "ActiveWorkBook"))))))
     (progn 
          (alert "open Excel before you run this")
          (exit)
          (*error* nil)
          (princ)
     ); end of progn
  ); end of if
  (setq activesheet0 (vl-catch-all-apply (function (lambda () (vlax-get-property app "ActiveSheet")))))
  (setq xlrows (vlax-get-property activesheet0 'Rows))
  (setq xlcolumns (vlax-get-property activesheet0 'Columns))

  (vlax-put-property app 'visible :vlax-true)
  (vlax-put-property app 'ScreenUpdating :vlax-true)
  (vlax-put-property app 'DisplayAlerts :vlax-false)

  (princ "\n go to excel then select cell to paste picture")

  (if (not (vl-catch-all-error-p (setq rng (vl-catch-all-apply (function (lambda () (vlax-variant-value (vlax-invoke-method (vlax-get-property activeworkbook0 'Application)
				    'Inputbox
				    "select 1 cell you put in : "
				    "ssw"
				    nil
				    nil
				    nil
				    nil
				    nil
				    8))))))))
    (progn
      (vlax-put-property app 'DisplayAlerts :vlax-true)
      (setq r (vlax-get-property rng 'row))
      (setq c (vlax-get-property rng 'column))
    ); end of progn
  );end of if
  (setq index 0)
  (while 


  (princ "\nPlease open the excel sheet before running.\nInserts the selected area screenshot into the selected cell in Excel as a wmf image. (background transparent)")
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq    pt1 (getpoint "\nSelect the first point:")
            pt2 (getcorner pt1 "\nselect the second point:")
            ph  (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) "-" (rtos (getvar 'cdate) 2 10) ".wmf") ;edited line
  )

  (setq x_dist_selection 0)
  (setq y_dist_selection 0)
  (setq xy_ratio 0)

  (setq x_dist_selection (abs (- (car pt1) (car pt2)) )) ;edited line
  (setq y_dist_selection (abs (- (cadr pt1) (cadr pt2)) )) ;edited line
  (setq xy_ratio (/ y_dist_selection x_dist_selection)) ;edited line
  
  (setq input_width 1000) ;input fixed value for simplify
  (setq input_height (atoi (rtos (* input_width xy_ratio) 2 0)) )

  (setq input_width (+ input_width 16)) ; 16 is my environment gap of window size & image size. shoud be edited
  (setq input_height (+ input_height 55)) ; 55 is my environment gap of window size & image size. shoud be edited

  (if (= (findfile ph) nil) 
     (progn 
        (princ "\nCreate new image file ")
     ) 
     (progn 
        (vl-file-delete ph) 
        (princ "\nReplace image file")
     )
  )

  (if (setq ss (ssget "c" pt1 pt2)) ;'((0 . "lwpolyline,line,ARC"))))
    (progn
      (command "_Zoom" "w" pt1 pt2 "")
      (vla-put-height acdoc input_height)  ;edited line
      (vla-put-width acdoc input_width)  ;edited line
      (command "_wmfout" ph "all" "") ;edited line for all entities, replace with (command "_wmfout" ph ss "") 
    )
  )
  (command "_Zoom" "p")
  (vla-put-windowstate acdoc 3)  ;edited line
  (command "_syswindows" "_hor")  ;edited line

  (setvar "osmode" ods)
  (princ "\ndone.")
  (princ (strcat "\nimage output path:" ph))

 

 (setq app (vlax-get-or-create-object "Excel.Application"))
 (vla-put-visible app :vlax-true)
 (vlax-put-property app 'ScreenUpdating :vlax-true)
  (setq	activeworkbook0
	 (vlax-get-property app 'ActiveWorkbook)
  )
  (setq	activesheet0
	 (vlax-get-property activeworkbook0 'ActiveSheet)
  )
  (setq cells0 (vlax-get-property activesheet0 'cells))

  (setq addr (strcat (chr (+ 64 c)) (itoa r) ":" (chr (+ (ascii (chr (+ 64 c))) (1- 1))) (itoa (+ r (1- 1)))))
  (setq rng (vlax-get-property activesheet0 'Range addr))
  (vlax-invoke Rng 'Select)

  (setq pic (vlax-get activesheet0 'Pictures))	;Pictures object
  (setq picture (vlax-invoke pic 'insert ph)) ;execute insert image

  (vlax-invoke picture 'select)		;select this image


  (setq
    shape (vlax-get (vlax-get-property app 'selection) 'shapeRange)
  )					;picture object

  ;(vlax-put shape 'LockAspectRatio 0)	;Release aspect lock


  
  ;(vlax-put shape 'Height (/ input_height 3))
					;Set the height of the image (pixels)

  (setq width_you_want 10) ;edit this 30 value. this is same with width property in excel.
  (vlax-put shape 'width (* 28.3464566929 width_you_want)) ;Set the width of the image (pixels)
  
  (setq rowheighttofit (* (* width_you_want xy_ratio) 28.3464566929));8.5125))
  (setq columnwidthtofit (* width_you_want 4.71267)); (rtos (* 28.3464566929 width_you_want) 2 0))
  (if (> rowheighttofit 409) (setq rowheighttofit 409))

  (setq selectedrows (vlax-variant-value (vlax-get-property xlrows 'item r)))

  (vlax-put-property selectedrows 'RowHeight rowheighttofit)

  (setq selectedcolumns (vlax-variant-value (vlax-get-property xlcolumns 'item c)))
  (vlax-put-property selectedcolumns 'ColumnWidth columnwidthtofit)

; closing..

 ;(vlax-invoke-method app 'Saveas  (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".xlsx"))
 ;(vlax-invoke-method app 'Close)
 ;(vlax-invoke-method app 'Quit)

     (setq r (+ r 1))
     (setq index (+ index 1))
  ); end of while




  (LM:endundo (LM:acdoc))
  (setvar "cmdecho" 1)
  (setvar "osmode" ods)
  (princ)
)



(defun c:ssp2 (/ *error* addr selectedcolumns columnwidthtofit xlrows xlcolumns rowheighttofit selectedrows app index r c rng activeworkbook0 activesheet0 ods acdoc pt1 pt2 ph x_dist_selection y_dist_selection xy_ratio input_width input_height ss cells0 shape pic picture width_you_want)
  (setvar "cmdecho" 0)
  (setq ods (getvar "osmode"))
  (setvar "osmode" 0)
  (LM:startundo (LM:acdoc))

    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (setvar "cmdecho" 1)
        (setvar "osmode" ods)
        (princ)
    ) 
  (princ "\n Screenshot Loop")

  (ex:ESMAKE)
  (setq app (vlax-get-or-create-object "Excel.Application"))
  (if (vl-catch-all-error-p (setq activeworkbook0 (vl-catch-all-apply (function (lambda () (vlax-get-property app "ActiveWorkBook"))))))
     (progn 
          (alert "open Excel before you run this")
          (exit)
          (*error* nil)
          (princ)
     ); end of progn
  ); end of if
  (setq activesheet0 (vl-catch-all-apply (function (lambda () (vlax-get-property app "ActiveSheet")))))
  (setq xlrows (vlax-get-property activesheet0 'Rows))
  (setq xlcolumns (vlax-get-property activesheet0 'Columns))

  (vlax-put-property app 'visible :vlax-true)
  (vlax-put-property app 'ScreenUpdating :vlax-true)
  (vlax-put-property app 'DisplayAlerts :vlax-false)

  (princ "\n go to excel then select cell to paste picture")

  (if (not (vl-catch-all-error-p (setq rng (vl-catch-all-apply (function (lambda () (vlax-variant-value (vlax-invoke-method (vlax-get-property activeworkbook0 'Application)
				    'Inputbox
				    "select 1 cell you put in : "
				    "ssw"
				    nil
				    nil
				    nil
				    nil
				    nil
				    8))))))))
    (progn
      (vlax-put-property app 'DisplayAlerts :vlax-true)
      (setq r (vlax-get-property rng 'row))
      (setq c (vlax-get-property rng 'column))
    ); end of progn
  );end of if
  (setq index 0)
  (while 


  (princ "\nPlease open the excel sheet before running.\nInserts the selected area screenshot into the selected cell in Excel as a png image. (background transparent)")
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq    pt1 (getpoint "\nSelect the first point:")
            pt2 (getcorner pt1 "\nselect the second point:")
            ph  (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) "-" (rtos (getvar 'cdate) 2 10) ".png") ;edited line
  )

  (setq x_dist_selection 0)
  (setq y_dist_selection 0)
  (setq xy_ratio 0)

  (setq x_dist_selection (abs (- (car pt1) (car pt2)) )) ;edited line
  (setq y_dist_selection (abs (- (cadr pt1) (cadr pt2)) )) ;edited line
  (setq xy_ratio (/ y_dist_selection x_dist_selection)) ;edited line
  
  (setq input_width 1000) ;input fixed value for simplify
  (setq input_height (atoi (rtos (* input_width xy_ratio) 2 0)) )

  (setq input_width (+ input_width 16)) ; 16 is my environment gap of window size & image size. shoud be edited
  (setq input_height (+ input_height 55)) ; 55 is my environment gap of window size & image size. shoud be edited

  (if (= (findfile ph) nil) 
     (progn 
        (princ "\nCreate new image file ")
     ) 
     (progn 
        (vl-file-delete ph) 
        (princ "\nReplace image file")
     )
  )

  (if (setq ss (ssget "c" pt1 pt2)) ;'((0 . "lwpolyline,line,ARC"))))
    (progn
      (command "_Zoom" "w" pt1 pt2 "")
      (vla-put-height acdoc input_height)  ;edited line
      (vla-put-width acdoc input_width)  ;edited line
      (command "_pngout" ph "all" "") ;edited line for all entities, replace with (command "_pngout" ph ss "") 
    )
  )
  (command "_Zoom" "p")
  (vla-put-windowstate acdoc 3)  ;edited line
  (command "_syswindows" "_hor")  ;edited line

  (setvar "osmode" ods)
  (princ "\ndone.")
  (princ (strcat "\nimage output path:" ph))

 

 (setq app (vlax-get-or-create-object "Excel.Application"))
 (vla-put-visible app :vlax-true)
 (vlax-put-property app 'ScreenUpdating :vlax-true)
  (setq	activeworkbook0
	 (vlax-get-property app 'ActiveWorkbook)
  )
  (setq	activesheet0
	 (vlax-get-property activeworkbook0 'ActiveSheet)
  )
  (setq cells0 (vlax-get-property activesheet0 'cells))

  (setq addr (strcat (chr (+ 64 c)) (itoa r) ":" (chr (+ (ascii (chr (+ 64 c))) (1- 1))) (itoa (+ r (1- 1)))))
  (setq rng (vlax-get-property activesheet0 'Range addr))
  (vlax-invoke Rng 'Select)

  (setq pic (vlax-get activesheet0 'Pictures))	;Pictures object
  (setq picture (vlax-invoke pic 'insert ph)) ;execute insert image

  (vlax-invoke picture 'select)		;select this image


  (setq
    shape (vlax-get (vlax-get-property app 'selection) 'shapeRange)
  )					;picture object

  ;(vlax-put shape 'LockAspectRatio 0)	;Release aspect lock


  
  ;(vlax-put shape 'Height (/ input_height 3))
					;Set the height of the image (pixels)

  (setq width_you_want 10) ;edit this 30 value. this is same with width property in excel.
  (vlax-put shape 'width (* 28.3464566929 width_you_want)) ;Set the width of the image (pixels)
  
  (setq rowheighttofit (* (* width_you_want xy_ratio) 28.3464566929));8.5125))
  (setq columnwidthtofit (* width_you_want 4.71267)); (rtos (* 28.3464566929 width_you_want) 2 0))
  (if (> rowheighttofit 409) (setq rowheighttofit 409))

  (setq selectedrows (vlax-variant-value (vlax-get-property xlrows 'item r)))

  (vlax-put-property selectedrows 'RowHeight rowheighttofit)

  (setq selectedcolumns (vlax-variant-value (vlax-get-property xlcolumns 'item c)))
  (vlax-put-property selectedcolumns 'ColumnWidth columnwidthtofit)

; closing..

 ;(vlax-invoke-method app 'Saveas  (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".xlsx"))
 ;(vlax-invoke-method app 'Close)
 ;(vlax-invoke-method app 'Quit)

     (setq r (+ r 1))
     (setq index (+ index 1))
  ); end of while




  (LM:endundo (LM:acdoc))
  (setvar "cmdecho" 1)
  (setvar "osmode" ods)
  (princ)
)




;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)


;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)


(defun ex:ESMAKE ( )
 ;from BIGAL's ah:chkexcel
 (setq excelapp (vlax-get-or-create-object "Excel.Application"))    
 (vlax-invoke-method (vlax-get-property excelapp 'Workbooks) 'Add)
 (vlax-put Excelapp "visible" :vlax-true)
 (setq Workbooks (vlax-get-property ExcelApp 'Workbooks))
 (setq Sheets (vlax-get-property ExcelApp 'Sheets))
 (setq AcSheet (vlax-get-property ExcelApp 'ActiveSheet))
 (setq accell (vlax-get-property ExcelApp 'Activecell))
 (setq xlcols (vlax-get-property acsheet 'Columns))
 (setq xlrows (vlax-get-property acsheet 'Rows))
 (setq cell (vlax-get-property acsheet 'Cells))
)


(princ "\nSSW, SSP, SSW2, SSP2 - loading complete")

Edited July 21, 2022 by exceed
ssw, ssw2, ssp, ssp2 edited 2022.07.21

March 8, 2022

On 3/7/2022 at 9:10 AM, exceed said: