Jump to content

Leaderboard

Popular Content

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

  1. Hi, the lisp, anticipated with two images here and here, aligns between two curves the hatch elements and creates a block containing the lines of the new geometry. The original shape of the hatch shall be a rectangle, an isosceles triangle or an isosceles trapezoid. In case of large hatches is recommended to divide it into portions, any case it is better to try with small hatches to verify the time required for processing, in according to PC performances, too. Not all hatches are suitable for processing. I hope it works well and there are no problems. AlignH.lsp
    1 point
  2. Likewise, it is easier to modify something using the software designed to do that, so modify an excel file with excel, modify data by LISP wthin CAD but don't try to modify excel with CAD or a LISP If I remember right, in LISP you can also use (if (numberp TXT) (princ "Letters") (princ "Numbers") ) something like that, numberp for data within CAD
    1 point
  3. I don't know about showing the object itself but you can show the rotation angle. (defun C:TEST (/ drawing util MS P1 P2 P3 P-LST OBJ ANG) (vl-load-com) (setq drawing (vla-get-activedocument (vlax-get-acad-object)) util (vla-get-utility drawing) MS (vla-get-modelspace drawing) P1 (getpoint "\nSpecify first point: ") P2 (polar P1 0 5.0) P3 (polar P2 (/ PI 2.0) 1.0) P-LST (apply 'append (list P1 P2 P3)) P-LST (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 0 (- (lenght P-LST) 1))) P-LST) ;not needed in briscad OBJ (vla-addpolyline MS P-LST) ang (vla-getangle util p1 "\nRotation Angle: ") ) (vla-rotate OBJ P1 ang) (princ) )
    1 point
  4. Hello, I have created a table within AutoCAD. I have written some words in cell "A1", I would like to display the same words in another cell using an equation "=A1". When I type the "=A1" equation the cell displays "####" Is there anyway to make this work? possibly using fields? Thanks
    1 point
  5. Have at it. Hope it helped. However, you need not credit me on this as the only thing you used of mine was my function name. lol I thought I'd post a couple examples of your desired result. Both are recursive, but the second uses list over string manipulation as it's just faster (not that it's going to make much of a difference on something like this. (defun _numPad (str len) ((lambda (foo) (if (wcmatch str "-*") (strcat "-" (foo (substr str 2) len)) (foo str len) ) ) (lambda (n l) (if (< (strlen n) l) (foo (strcat "0" n) l) n ) ) ) ) (defun _numPad2 (str len) ((lambda (foo lst) (vl-list->string (if (eq (car lst) 45) (cons 45 (foo (cdr lst) len)) (foo lst len) ) ) ) (lambda (x l) (if (< (length x) l) (foo (cons 48 x) l) x ) ) (vl-string->list str) ) )
    1 point
  6. ;; Extracting Block Attributes to Excel - 2022-04-08 exceed ;; https://www.cadtutor.net/forum/topic/74793-extract-attribute-selected-in-excel/ (vl-load-com) (defun c:EXATT ( / blk *error* ss ssl index ename blk lst rclist answer r c r0 c0 lstlen index2 sublst atxt btxt ) (defun *error* ( msg ) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (princ) ) (setq rclist (ex:ECADR)) (setq r (car rclist)) (setq r0 r) (setq c (cadr rclist)) (setq c0 c) (setq answer (getstring t "\n If you would like to enter here, please enter the CABLE TAG NAME : ")) ; if the cable name has no space bar. replace this line with below. it will make it work by space bar. ; (setq answer (getstring "\n If you would like to enter here, please enter the CABLE TAG NAME : ")) (setq ss (ssget '((0 . "insert")) ) ) (setq ssl (sslength ss)) (setq index 0) (ex:ecsel r c) (ex:ecput answer) (setq c (+ c 1)) (repeat ssl (setq ename (ssname ss index)) (setq blk (vlax-ename->vla-object ename)) (setq lst (LM:vl-getattributevalues blk)) (setq lstlen (length lst)) (setq index2 0) (repeat lstlen (setq sublst (nth index2 lst)) (setq atxt (car sublst)) (setq btxt (cdr sublst)) (ex:ecsel r c) (ex:ecput btxt) (setq r (+ r 1)) (setq index2 (+ index2 1)) );end of repeat2 ;(princ lst) (setq r (- r index2)) (setq c (+ c 1)) (setq index (+ index 1)) );end of repeat ;(setq r r0) (setq r (+ r index2)) (setq c c0) (ex:ecsel r c) (princ) ) ;; Get Attribute Values - Lee Mac ;; Returns an association list of attributes present in the supplied block. ;; blk - [vla] VLA Block Reference Object ;; Returns: [lst] Association list of ((<tag> . <value>) ... ) (defun LM:vl-getattributevalues ( blk ) (mapcar '(lambda ( att ) (cons (vla-get-tagstring att) (vla-get-textstring att))) (vlax-invoke blk 'getattributes)) ) (defun ex:ECSEL ( r c / *error* excelapp workbooks sheets acsheet acsheetname captionname addr rng c1 c2 c3) (setvar "cmdecho" 0) (defun *error* ( msg ) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (vlax-release-object AcSheet) (vlax-release-object Sheets) (vlax-release-object Workbooks) (vlax-release-object ExcelApp) (setvar "cmdecho" 1) (princ) ) ;BIGAL's ah:chkexcel (if (= (setq excelapp (vlax-get-object "Excel.Application") ) nil) ; if open already (setq excelapp (vlax-get-or-create-object "Excel.Application")) ) (if (= (setq acsheet (vlax-get-property ExcelApp 'ActiveSheet)) nil) (vlax-invoke-method (vlax-get-property excelapp 'Workbooks) 'Add) ) (vlax-put Excelapp "visible" :vlax-true) (if (/= (setq captionname (vlax-get-property ExcelApp 'caption)) nil) (progn ;(princ "\n workbook name - ") ;(princ captionname) );end of progn ) (setq Workbooks (vlax-get-property ExcelApp 'Workbooks)) (setq Sheets (vlax-get-property ExcelApp 'Sheets)) (setq AcSheet (vlax-get-property ExcelApp 'ActiveSheet)) (setq acsheetname (vlax-get-property acsheet 'name)) (setq c (- c 1)) (cond ((and (> c -1) (< c 25)) (setq c1 (+ c 1)) (setq addr (strcat (chr (+ 64 c1)) (itoa r) ":" (chr (+ 64 c1)) (itoa r) )) );end of cond option 1 ((and (> c 24) (< c 702)) (setq c2 (fix (/ c 26))) (setq c1 (- c (* c2 26))) (setq c2 c2) (setq c1 (+ c1 1)) (setq addr (strcat (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r))) );end of cond option 2 ((and (> c 701) (< c 18278)) (setq c3 (fix (/ c (* 26 26)) ) ) (setq c2 (fix (/ (- c (* c3 (* 26 26))) 26))) (setq c1 (- (- c (* (* c3 26) 26)) (* c2 26))) (setq c3 c3) (setq c2 c2) (setq c1 (+ c1 1)) (setq addr (strcat (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r))) );end of cond option 3 );end of cond ;(princ " ( in address format ") ;(princ addr) ;(princ " )") (setq rng (vlax-get-property acsheet 'Range addr)) (vlax-invoke rng 'Select) (setvar "cmdecho" 1) (princ) ) (defun ex:ECPUT ( textstring / *error* excelapp workbooks sheets acsheet acsheetname accell cell r c captionname addr rng textstring2 textstring c1 c2 c3) (setvar "cmdecho" 0) (defun *error* ( msg ) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (vlax-release-object AcSheet) (vlax-release-object Sheets) (vlax-release-object Workbooks) (vlax-release-object ExcelApp) (setvar "cmdecho" 1) (princ) ) ;BIGAL's ah:chkexcel (if (= (setq excelapp (vlax-get-object "Excel.Application") ) nil) ; if open already (setq excelapp (vlax-get-or-create-object "Excel.Application")) ) (if (= (setq acsheet (vlax-get-property ExcelApp 'ActiveSheet)) nil) (vlax-invoke-method (vlax-get-property excelapp 'Workbooks) 'Add) ) (vlax-put Excelapp "visible" :vlax-true) (if (/= (setq captionname (vlax-get-property ExcelApp 'caption)) nil) (progn ;(princ "\n workbook name - ") ;(princ captionname) );end of progn ) (setq Workbooks (vlax-get-property ExcelApp 'Workbooks)) (setq Sheets (vlax-get-property ExcelApp 'Sheets)) (setq AcSheet (vlax-get-property ExcelApp 'ActiveSheet)) (setq acsheetname (vlax-get-property acsheet 'name)) (setq accell (vlax-get-property ExcelApp 'Activecell)) (setq cell (vlax-get-property acsheet 'Cells)) (setq textstring2 (strcat "'" textstring)) (setq r (vlax-get-property accell 'row)) (setq c (vlax-get-property accell 'column)) (setq c (- c 1)) (cond ((and (> c -1) (< c 25)) (setq c1 (+ c 1)) (setq addr (strcat (chr (+ 64 c1)) (itoa r) ":" (chr (+ 64 c1)) (itoa r) )) );end of cond option 1 ((and (> c 24) (< c 702)) (setq c2 (fix (/ c 26))) (setq c1 (- c (* c2 26))) (setq c2 c2) (setq c1 (+ c1 1)) ;(princ "c1 - ") ;(princ c1) ;(princ "c2 - ") ;(princ c2) (setq addr (strcat (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r))) );end of cond option 2 ((and (> c 701) (< c 18278)) (setq c3 (fix (/ c (* 26 26)) ) ) (setq c2 (fix (/ (- c (* c3 (* 26 26))) 26))) (setq c1 (- (- c (* (* c3 26) 26)) (* c2 26))) (setq c3 c3) (setq c2 c2) (setq c1 (+ c1 1)) (setq addr (strcat (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r))) );end of cond option 3 );end of cond (setq c (+ c 1)) (vlax-put-property cell 'item r c textstring2) (setvar "cmdecho" 1) (princ) ) (defun ex:ECADR ( / *error* excelapp workbooks sheets acsheet acsheetname accell cell r c captionname addr rng textstring c1 c2 c3 ) (setvar "cmdecho" 0) (defun *error* ( msg ) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (vlax-release-object AcSheet) (vlax-release-object Sheets) (vlax-release-object Workbooks) (vlax-release-object ExcelApp) (setvar "cmdecho" 1) (princ) ) ;BIGAL's ah:chkexcel (if (= (setq excelapp (vlax-get-object "Excel.Application") ) nil) ; if open already (setq excelapp (vlax-get-or-create-object "Excel.Application")) ) (if (= (setq acsheet (vlax-get-property ExcelApp 'ActiveSheet)) nil) (vlax-invoke-method (vlax-get-property excelapp 'Workbooks) 'Add) ) (vlax-put Excelapp "visible" :vlax-true) (if (/= (setq captionname (vlax-get-property ExcelApp 'caption)) nil) (progn (princ "\n workbook name - ") (princ captionname) );end of progn ) (setq Workbooks (vlax-get-property ExcelApp 'Workbooks)) (setq Sheets (vlax-get-property ExcelApp 'Sheets)) (setq AcSheet (vlax-get-property ExcelApp 'ActiveSheet)) (setq acsheetname (vlax-get-property acsheet 'name)) (setq accell (vlax-get-property ExcelApp 'Activecell)) (setq cell (vlax-get-property acsheet 'Cells)) (setq r (vlax-get-property accell 'row)) (setq c (vlax-get-property accell 'column)) (princ "\n active sheet now - ") (princ acsheetname) (princ "\n your selected cell is - Row ") (princ r) (princ ", Column ") (princ c) (setq c (- c 1)) (cond ((and (> c -1) (< c 25)) (setq c1 (+ c 1)) (setq addr (strcat (chr (+ 64 c1)) (itoa r) ":" (chr (+ 64 c1)) (itoa r) )) );end of cond option 1 ((and (> c 24) (< c 702)) (setq c2 (fix (/ c 26))) (setq c1 (- c (* c2 26))) (setq c2 c2) (setq c1 (+ c1 1)) (setq addr (strcat (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r))) );end of cond option 2 ((and (> c 701) (< c 18278)) (setq c3 (fix (/ c (* 26 26)) ) ) (setq c2 (fix (/ (- c (* c3 (* 26 26))) 26))) (setq c1 (- (- c (* (* c3 26) 26)) (* c2 26))) (setq c3 c3) (setq c2 c2) (setq c1 (+ c1 1)) (setq addr (strcat (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r))) );end of cond option 3 );end of cond (princ " ( in address format ") (princ addr) (princ " )") (setq c (+ c 1)) (list r c) ) like this? There was no cable number in the drawing, so I didn't make it. but, I think you'll want something like that, so I made a simple response with getstring, not getkword Y/N. In the first row, as in your example, the number of blocks can be different for each 1 cable (= 1 extraction) so it is easier to write it down in Excel than to find the maximum number of blocks in Lisp. + there's no MVZ value in your example dwg also.
    1 point
  7. http://www.lee-mac.com/attributefunctions.html If you're lost way in Lisp, see the Lee Mac. he will point you to the right path with this code, you can get your block attributes in list. It is not difficult to extract this into Excel. ;; Extracting Block Attributes to Excel - 2022-04-08 exceed ;; https://www.cadtutor.net/forum/topic/74793-extract-attribute-selected-in-excel/ (vl-load-com) (defun c:EXATT ( / blk *error* ss ssl index ename blk lst rclist answer ) (defun *error* ( msg ) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (princ) ) (setq rclist (ex:ECADR)) (setq r (car rclist)) (setq r0 r) (setq c (cadr rclist)) (setq c0 c) (setq answer (getstring "\n enter here? ( space-bar(yes) / esc(no) )")) (setq ss (ssget '((0 . "insert")) ) ) (setq ssl (sslength ss)) (setq index 0) (repeat ssl (setq ename (ssname ss index)) (setq blk (vlax-ename->vla-object ename)) (setq lst (LM:vl-getattributevalues blk)) (setq lstlen (length lst)) (setq index2 0) (ex:ecsel r c) (ex:ecput (strcat "BLOCK" (vl-princ-to-string (+ index 1)))) (setq r (+ r 1)) (repeat lstlen (setq sublst (nth index2 lst)) (setq atxt (car sublst)) (setq btxt (cdr sublst)) (ex:ecsel r c) (ex:ecput btxt) (setq r (+ r 1)) (setq index2 (+ index2 1)) );end of repeat2 ;(princ lst) (setq r (- (- r index2) 1)) (setq c (+ c 1)) (setq index (+ index 1)) );end of repeat (setq r r0) (ex:ecsel r c) (princ) ) ;; Get Attribute Values - Lee Mac ;; Returns an association list of attributes present in the supplied block. ;; blk - [vla] VLA Block Reference Object ;; Returns: [lst] Association list of ((<tag> . <value>) ... ) (defun LM:vl-getattributevalues ( blk ) (mapcar '(lambda ( att ) (cons (vla-get-tagstring att) (vla-get-textstring att))) (vlax-invoke blk 'getattributes)) ) (defun ex:ECSEL ( r c / *error* excelapp workbooks sheets acsheet acsheetname captionname addr rng c1 c2 c3) (setvar "cmdecho" 0) (defun *error* ( msg ) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (vlax-release-object AcSheet) (vlax-release-object Sheets) (vlax-release-object Workbooks) (vlax-release-object ExcelApp) (setvar "cmdecho" 1) (princ) ) ;BIGAL's ah:chkexcel (if (= (setq excelapp (vlax-get-object "Excel.Application") ) nil) ; if open already (setq excelapp (vlax-get-or-create-object "Excel.Application")) ) (if (= (setq acsheet (vlax-get-property ExcelApp 'ActiveSheet)) nil) (vlax-invoke-method (vlax-get-property excelapp 'Workbooks) 'Add) ) (vlax-put Excelapp "visible" :vlax-true) (if (/= (setq captionname (vlax-get-property ExcelApp 'caption)) nil) (progn ;(princ "\n workbook name - ") ;(princ captionname) );end of progn ) (setq Workbooks (vlax-get-property ExcelApp 'Workbooks)) (setq Sheets (vlax-get-property ExcelApp 'Sheets)) (setq AcSheet (vlax-get-property ExcelApp 'ActiveSheet)) (setq acsheetname (vlax-get-property acsheet 'name)) (setq c (- c 1)) (cond ((and (> c -1) (< c 25)) (setq c1 (+ c 1)) (setq addr (strcat (chr (+ 64 c1)) (itoa r) ":" (chr (+ 64 c1)) (itoa r) )) );end of cond option 1 ((and (> c 24) (< c 702)) (setq c2 (fix (/ c 26))) (setq c1 (- c (* c2 26))) (setq c2 c2) (setq c1 (+ c1 1)) (setq addr (strcat (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r))) );end of cond option 2 ((and (> c 701) (< c 18278)) (setq c3 (fix (/ c (* 26 26)) ) ) (setq c2 (fix (/ (- c (* c3 (* 26 26))) 26))) (setq c1 (- (- c (* (* c3 26) 26)) (* c2 26))) (setq c3 c3) (setq c2 c2) (setq c1 (+ c1 1)) (setq addr (strcat (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r))) );end of cond option 3 );end of cond ;(princ " ( in address format ") ;(princ addr) ;(princ " )") (setq rng (vlax-get-property acsheet 'Range addr)) (vlax-invoke rng 'Select) (setvar "cmdecho" 1) (princ) ) (defun ex:ECPUT ( textstring / *error* excelapp workbooks sheets acsheet acsheetname accell cell r c captionname addr rng textstring2 textstring c1 c2 c3) (setvar "cmdecho" 0) (defun *error* ( msg ) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (vlax-release-object AcSheet) (vlax-release-object Sheets) (vlax-release-object Workbooks) (vlax-release-object ExcelApp) (setvar "cmdecho" 1) (princ) ) ;BIGAL's ah:chkexcel (if (= (setq excelapp (vlax-get-object "Excel.Application") ) nil) ; if open already (setq excelapp (vlax-get-or-create-object "Excel.Application")) ) (if (= (setq acsheet (vlax-get-property ExcelApp 'ActiveSheet)) nil) (vlax-invoke-method (vlax-get-property excelapp 'Workbooks) 'Add) ) (vlax-put Excelapp "visible" :vlax-true) (if (/= (setq captionname (vlax-get-property ExcelApp 'caption)) nil) (progn ;(princ "\n workbook name - ") ;(princ captionname) );end of progn ) (setq Workbooks (vlax-get-property ExcelApp 'Workbooks)) (setq Sheets (vlax-get-property ExcelApp 'Sheets)) (setq AcSheet (vlax-get-property ExcelApp 'ActiveSheet)) (setq acsheetname (vlax-get-property acsheet 'name)) (setq accell (vlax-get-property ExcelApp 'Activecell)) (setq cell (vlax-get-property acsheet 'Cells)) (setq textstring2 (strcat "'" textstring)) (setq r (vlax-get-property accell 'row)) (setq c (vlax-get-property accell 'column)) (setq c (- c 1)) (cond ((and (> c -1) (< c 25)) (setq c1 (+ c 1)) (setq addr (strcat (chr (+ 64 c1)) (itoa r) ":" (chr (+ 64 c1)) (itoa r) )) );end of cond option 1 ((and (> c 24) (< c 702)) (setq c2 (fix (/ c 26))) (setq c1 (- c (* c2 26))) (setq c2 c2) (setq c1 (+ c1 1)) ;(princ "c1 - ") ;(princ c1) ;(princ "c2 - ") ;(princ c2) (setq addr (strcat (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r))) );end of cond option 2 ((and (> c 701) (< c 18278)) (setq c3 (fix (/ c (* 26 26)) ) ) (setq c2 (fix (/ (- c (* c3 (* 26 26))) 26))) (setq c1 (- (- c (* (* c3 26) 26)) (* c2 26))) (setq c3 c3) (setq c2 c2) (setq c1 (+ c1 1)) (setq addr (strcat (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r))) );end of cond option 3 );end of cond (setq c (+ c 1)) (vlax-put-property cell 'item r c textstring2) (setvar "cmdecho" 1) (princ) ) (defun ex:ECADR ( / *error* excelapp workbooks sheets acsheet acsheetname accell cell r c captionname addr rng textstring c1 c2 c3 ) (setvar "cmdecho" 0) (defun *error* ( msg ) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (vlax-release-object AcSheet) (vlax-release-object Sheets) (vlax-release-object Workbooks) (vlax-release-object ExcelApp) (setvar "cmdecho" 1) (princ) ) ;BIGAL's ah:chkexcel (if (= (setq excelapp (vlax-get-object "Excel.Application") ) nil) ; if open already (setq excelapp (vlax-get-or-create-object "Excel.Application")) ) (if (= (setq acsheet (vlax-get-property ExcelApp 'ActiveSheet)) nil) (vlax-invoke-method (vlax-get-property excelapp 'Workbooks) 'Add) ) (vlax-put Excelapp "visible" :vlax-true) (if (/= (setq captionname (vlax-get-property ExcelApp 'caption)) nil) (progn (princ "\n workbook name - ") (princ captionname) );end of progn ) (setq Workbooks (vlax-get-property ExcelApp 'Workbooks)) (setq Sheets (vlax-get-property ExcelApp 'Sheets)) (setq AcSheet (vlax-get-property ExcelApp 'ActiveSheet)) (setq acsheetname (vlax-get-property acsheet 'name)) (setq accell (vlax-get-property ExcelApp 'Activecell)) (setq cell (vlax-get-property acsheet 'Cells)) (setq r (vlax-get-property accell 'row)) (setq c (vlax-get-property accell 'column)) (princ "\n active sheet now - ") (princ acsheetname) (princ "\n your selected cell is - Row ") (princ r) (princ ", Column ") (princ c) (setq c (- c 1)) (cond ((and (> c -1) (< c 25)) (setq c1 (+ c 1)) (setq addr (strcat (chr (+ 64 c1)) (itoa r) ":" (chr (+ 64 c1)) (itoa r) )) );end of cond option 1 ((and (> c 24) (< c 702)) (setq c2 (fix (/ c 26))) (setq c1 (- c (* c2 26))) (setq c2 c2) (setq c1 (+ c1 1)) (setq addr (strcat (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r))) );end of cond option 2 ((and (> c 701) (< c 18278)) (setq c3 (fix (/ c (* 26 26)) ) ) (setq c2 (fix (/ (- c (* c3 (* 26 26))) 26))) (setq c1 (- (- c (* (* c3 26) 26)) (* c2 26))) (setq c3 c3) (setq c2 c2) (setq c1 (+ c1 1)) (setq addr (strcat (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r))) );end of cond option 3 );end of cond (princ " ( in address format ") (princ addr) (princ " )") (setq c (+ c 1)) (list r c) ) like this ? command : EXATT
    1 point
×
×
  • Create New...