Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 03/03/2022 in all areas

  1. Press "control+9" to toggle command line on and off.
    1 point
  2. Another way to do this is set ATTREQ to 0 then fill in the attributes after insertion: (defun _putatt (e tag val) (vl-catch-all-apply 'setpropertyvalue (list e tag val)) ) (_putatt (entlast) "XYZ" "123")
    1 point
  3. @Kajanthan Its always best to leave command as the last choice if you can do it another way. (setvar 'clayer "CAO DO") ;set current layer to No real reason to turn off snaps since your pulling points from entget and using entmod to update the text. especially if your not restoring them to the old value. user will start to question why their snaps are randomly getting turned off. Also prob also want to turn cmdecho back on before exit. Saw this for setting & restoring values after lisp is done. (setq lst (list 'cmdecho 'osmode) val (mapcar 'getvar lst) ) (mapcar 'setvar lst '(0 0)) ..... (mapcar 'setvar lst val) or old reliable (setq oldsnap (getvar 'osmode)) (setvar 'osmode 0) ..... (setvar 'osmode oldsnap)
    1 point
  4. Sorry, Updated ....... (defun c:bi (/ ss ent itm val pnt ) (vl-load-com) (setvar "OSMODE" 0) (setvar "CMDECHO" 0) (command "-LAYER" "S" "CAO DO" "") (setq ss (ssget (list (cons 0 "TEXT,INSERT") (cons 8 "CAO DO")))) (repeat (setq x (sslength ss)) (setq ent (ssname ss (setq x (- x 1)))) (setq itm (cdr (assoc 0 (entget ent)))) (if (eq itm "TEXT") (progn (setq ins (cdr (assoc 11 (entget ent)))) (setq val (cdr (assoc 1 (entget ent)))) (setq pnt (list (car ins) (cadr ins) (atof val))) (command "-INSERT" "donut" pnt 0.0002 0.0002 0) (entmod (subst (list 10 (car ins) (cadr ins) (atof val)) (assoc 10 (entget ent)) (entget ent))) ) ) (if (eq itm "INSERT") (entdel ent)) ) (princ) ) Block insert.lsp
    1 point
  5. 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
    1 point
  6. Try This (defun c:bi () (vl-load-com) (setvar "OSMODE" 0) (command "-LAYER" "S" "CAO DO" "") (setq ss (ssget (list (cons 0 "TEXT,INSERT") (cons 8 "CAO DO")))) (repeat (setq x (sslength ss)) (setq ent (ssname ss (setq x (- x 1)))) (setq itm (cdr (assoc 0 (entget ent)))) (if (eq itm "TEXT") (progn (setq ins (cdr (assoc 11 (entget ent)))) (setq val (cdr (assoc 1 (entget ent)))) (setq pnt (list (car ins) (cadr ins) (atof val))) (command "-INSERT" "donut" pnt 0.0002 0.0002 0) ) ) (if (eq itm "INSERT") (entdel ent)) ) (princ) ) Block insert.lsp
    1 point
  7. 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
    1 point
  8. 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")) )
    1 point
  9. If you insert a block with attributes it should prompt what to input for each attribute. Prompt <Value>: Test
    1 point
  10. Maybe this? To work with displaying edges and effects see the AutoDesk whitepaper entitled, "Display the Visual Styles Manager to Set Edge Effects." Mar 30, 2020.
    1 point
  11. 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
    1 point
×
×
  • Create New...