viswa Posted July 11 Share Posted July 11 I am trying to Export Dimensions from autocad file to excel using vba. My requirement is to select one dimension at a time and the value with the prefix and sufix needs to be exported to excel specific cell. Example if there is a Dimension %%C180.00 Max need to Export the Diameter Symbol to Prefix Column Dimension ( 180.00 ) to DImension Column and Max to the Suffix Column. Can anybody help me out with this Quote Link to comment Share on other sites More sharing options...
PeterPan9720 Posted July 11 Share Posted July 11 Could you share your code, perhaps somebody can help you inserting some additional check on achieved text from dimension object Quote Link to comment Share on other sites More sharing options...
BIGAL Posted July 11 Share Posted July 11 Start here your welcome to modify this. It asks for 2 dims. Hor & Ver. Start with no Excel open as it will open Excel. ; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-program-to-copy-dimensions-to-clipboard-and-paste-in-excel/td-p/8705507 ; export dims to excel ; By AlanH June 2024 ; needs version 2 add all the defuns to code ; ColumnRow - Returns a list of the Column and Row number ; Function By: Gilles Chanteau from Marseille, France ; Arguments: 1 ; Cell$ = Cell ID ; Syntax example: (ColumnRow "ABC987") = '(731 987) ;default to "A1" if there's a problem ;------------------------------------------------------------------------------- (defun ColumnRow (Cell$ / Column$ Char$ Row#) (setq Column$ "") (while (< 64 (ascii (setq Char$ (strcase (substr Cell$ 1 1)))) 91) (setq Column$ (strcat Column$ Char$) Cell$ (substr Cell$ 2) ) ) (if (and (/= Column$ "") (numberp (setq Row# (read Cell$)))) (list (Alpha2Number Column$) Row#) '(1 1) ) ) ; Alpha2Number - Converts Alpha string into Number ; Function By: Gilles Chanteau from Marseille, France ; Arguments: 1 ; Str$ = String to convert ; Syntax example: (Alpha2Number "ABC") = 731 ;------------------------------------------------------------------------------- (defun Alpha2Number (Str$ / Num#) (if (= 0 (setq Num# (strlen Str$))) 0 (+ (* (- (ascii (strcase (substr Str$ 1 1))) 64) (expt 26 (1- Num#))) (Alpha2Number (substr Str$ 2)) ) ) ) ;------------------------------------------------------------------------------- ; thanks to Lee-mac for this defun ; www.lee-mac.com ; 44 is comma 9 is tab 34 is space 58 is colon (defun _csv->lst58 ( str / pos ) (if (setq pos (vl-string-position 58 str)) (cons (substr str 1 pos) (_csv->lst58 (substr str (+ pos 2)))) (list str) ) ) ;; Thanks to fixo ;; (defun getcell2 (row column / ) (setq cells (vlax-get-property (vlax-get-property myxl "ActiveSheet") "Cells")) (setq cell (vlax-get (vlax-variant-value (vlax-get-property cells "Item" row column)) 'value)) ) ; get active range selected (defun getrangexl ( / lst UR CR RADD ) (setq lst '()) (setq UR (vlax-get-property (vlax-get-property myxl "ActiveSheet") "UsedRange")) (setq CR (vlax-get-property UR "CurrentRegion")) (setq RADD (vlax-get-property CR "Address")) (setq cnt (vlax-get-property CR "Count")) (setq lst (_csv->lst58 radd)) (setq st (vl-string-subst "" "$" (vl-string-subst "" "$" (nth 0 lst) ))) (setq end (vl-string-subst "" "$" (vl-string-subst "" "$" (nth 1 lst) ))) (setq st (reverse (columnrow st))) (setq end (reverse (columnrow end))) (princ st) (princ "\n") (princ end) ) ;; Thanks to fixo ;; ;; = Set Excel cell text = ;; ;; ;; (defun xlsetcelltext ( row column text) (setq cells (vlax-get-property (vlax-get-property myxl "ActiveSheet") "Cells")) (vl-catch-all-apply 'vlax-put-property (list cells 'Item row column (vlax-make-variant (vl-princ-to-string text) vlax-vbstring))) ) (defun xlnew ( / txt row) (setq myxl (vlax-get-object "Excel.Application")) (if (= myxl nil) (progn (setq myxl (vlax-get-or-create-object "excel.Application")) (setq add "Yes") ) (setq myxl (vlax-get-or-create-object "excel.Application")) ) (vla-put-visible myXL :vlax-true) (vlax-put-property myxl 'ScreenUpdating :vlax-true) (vlax-put-property myXL 'DisplayAlerts :vlax-true) (if (= add "Yes") (progn (vlax-invoke-method (vlax-get-property myXL 'WorkBooks) 'Add) (xlsetcelltext 1 1 "X") (xlsetcelltext 1 2 "Y") (setq row 2) ) ) ) (defun c:dim2xl ( / row txt ent) (if (= myxl nil) (xlnew) (progn (getrangexl) (setq row (car end)) ) ) (while (setq ent (entsel "\nPick X dim Enter to exit ")) (setq txt (vlax-get (vlax-ename->vla-object (car ent)) 'Measurement)) (xlsetcelltext row 1 txt) (setq ent (entsel "\nPick X dim Enter to exit ")) (setq txt (vlax-get (vlax-ename->vla-object (car ent)) 'Measurement)) (xlsetcelltext row 2 txt) (setq row (1+ row)) ) (princ) ) Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.