LISP to recognize mtext from cad to excel

Anonymous · ‎12-19-2021

Hello everyone, I have a requirement to window choosing the mtext from CAD file, then corresponding to the pre-established excel .If mtext correspond to the certain cell in excel then show the corresponding value in CAD besides the mtext like the example file below. Can someone give me some help or some hints . Thanks for everyone's help.

hosneyalaa · ‎12-20-2021

HI

TRY

(defun c:QQQQQTEXTFIND (/ CELL FILENAME I ICOL INS1 IROW IROWS RNG SSET XLAPP XLBOOK XLCELL XLFRANGE XLRANGE XLRANGEC XLSHEET)
  (vl-load-com)
  
  
  (if (AND
	(setq sset (ssget '((-4 . "<OR") (0 . "MTEXT") (0 . "TEXT") (-4 . "OR>"))))
	(setq fileName (getfiled "Select Excel file to find cell address :" (getvar "dwgprefix") "xlsx;xls" 16))
	
	)
    (progn
      (setq xlApp (vlax-create-object "Excel.Application"))
	(vlax-put-property xlApp "Visible" :vlax-true)
	(setq xlBook (vlax-invoke-method (vlax-get-property xlApp 'WorkBooks) "Open" fileName ) )
	(vlax-invoke-method xlBook "Activate")
	(setq xlSheet (vlax-get-property (vlax-get-property xlBook "WorkSheets") "Item" 1) )

	(setq xlRangeC (vlax-invoke-method xlSheet "Activate") )
	 (setq xlRange (vlax-get-property xlSheet "Range" "A1:A1000"))
	  (vlax-invoke-method xlRange "Select")
         (setq iCol (vlax-get-property xlRange "Column"))
	(setq iRows (vlax-get-property(vlax-get-property xlRange "Rows") "Count" )iRow  (vlax-get-property xlRange "Row") )
	(setq rng (vlax-get-property xlApp 'Cells))

      
      (setq i 0)
      (repeat (sslength sset)
        
	(setq xlCell (vlax-invoke-method
      xlRange
      "Find"
      (vlax-make-variant (vla-get-TEXTSTRING (vlax-ename->vla-object (ssname sset i)) ))
      xlFRange
      -4163
      1
      1
      1
      nil
      nil
           )
     )

 (setq cell (vlax-variant-value (vlax-get-property rng 'Item (vlax-get-property xlCell "Row") (+ 1 (vlax-get-property xlCell "Column")) )     )  )

                     (setq ins1 (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint (vlax-ename->vla-object (ssname sset i))))))
                    
	

	(entmakex (list '(0 . "MTEXT")
                       '(100 . "AcDbEntity")
		   '(67 . 0) '(8 . "0") '(62 . 2)
		   '(6 . "Continuous")
		   '(100 . "AcDbMText")
		   (cons 10  (LIST (+ 241 (CAR ins1)) (CADR ins1) (CADDR ins1) ))
		   '(40 . 100) '(41 . 1029.137964877809)
		   '(46 . 0) '(71 . 1) '(72 . 5)
		   (cons 1   (RTOS (vlax-variant-value  (vlax-get-property cell 'value2)) 2 2 ))
		   '(7 . "NOTE") '(11 1 0 0)
		   '(42 . 133.3333333333333) '(43 . 100)
		   '(50 . 0) '(73 . 1) '(44 . 1)
 
                            ) 
                      )
	
        (setq i (1+ i))
      )
      
    )
  )
  (princ)
)

Anonymous · ‎12-20-2021

The lisp you write is great.I tried to realize your code and modify your code to be more suitable for my requirement.If I have some problem could you please help me to solve :)) By the way, thank you so much.

hosneyalaa · ‎12-20-2021

Hi
What is your problem?

Anonymous · ‎12-22-2021

My final goal is like picture in explain.jpg.First, create excel and setting A E F G H row's information by user then B C D row will be generate by excel if function, then the excel for autocad will be prepared.In autocad,I need to show every beam's and slab's elevation.Like picture in explain.jpg,red mark is mtext on dwg file originally, so I want to add green and purple mark using lisp to auto mark them, the data of green mark are B row in excel and the data of purple mark are C and D row.These two marks should be alone red mark like the pictures I show.Finally, this is my final goal.I think last time you help me to write the code to solve that problem,I think my requirement is not difficult to you, but I didn't know too much about AutoLisp.If you can help me, that will be great to me.Otherwise, I will slowly try to modify the code from your last time.By the way, thank for your help,I appreciate your kind assistance..

Anonymous · ‎12-28-2021

Hello, I have some question. I tried to modify your code below.You can see the example in dwg.If I use this lisp, it can do like the picture show.First question,if I want to add text like"Top Height:" bu using cons 1, how can I modify that part to let me have text I need and value in excel at the same time.Second question,I used cons 10 set distance to put mtext near by original text position.But the positions are the same,so if I faced vertical text ,the mtext created by lisp which position is not fit,is there any way to figure this problem?

In the example.dwg ,those marks were created by artificial one by one.The final goal is that do the lisp to auto label that.If you have some great idea,please let me know.Thank you very much.

(defun c:QTEXTFIND (/ CELL FILENAME I ICOL INS1 IROW IROWS RNG SSET XLAPP XLBOOK XLCELL XLFRANGE XLRANGE XLRANGEC XLSHEET)
  (vl-load-com)
 (setq dic (dictsearch (namedobjdict) "ACAD_MLINESTYLE"))

(mapcar 'setvar svnames '(0 0)); turn off Osnap, command echoing
(command "_.layer" "_make" "0S-EL" "_color" 7 "" "p"  "N" "" "");; <---EDIT Layer name/color as desired
(setq styht (cdr (assoc 40 (tblsearch "style" (getvar 'dimtxsty))))); height of text style in current dimension style
(if (= styht 0.0) (setq styht (* (getvar 'dimtxt) (getvar 'dimscale)))); if above is non-fixed-height
 
  
  (if (AND
	(setq sset (ssget '((-4 . "<OR") (0 . "MTEXT") (0 . "TEXT") (-4 . "OR>"))))
	(setq fileName (getfiled "Select Excel file to find cell address :" (getvar "dwgprefix") "xlsx;xls" 16))
	
	)
    (progn
      (setq xlApp (vlax-create-object "Excel.Application"))
	(vlax-put-property xlApp "Visible" :vlax-true)
	(setq xlBook (vlax-invoke-method (vlax-get-property xlApp 'WorkBooks) "Open" fileName ) )
	(vlax-invoke-method xlBook "Activate")
	(setq xlSheet (vlax-get-property (vlax-get-property xlBook "WorkSheets") "Item" 1) )

	(setq xlRangeC (vlax-invoke-method xlSheet "Activate") )
	 (setq xlRange (vlax-get-property xlSheet "Range" "A1:A1000"))
	  (vlax-invoke-method xlRange "Select")
         (setq iCol (vlax-get-property xlRange "Column"))
	(setq iRows (vlax-get-property(vlax-get-property xlRange "Rows") "Count" )iRow  (vlax-get-property xlRange "Row") )
	(setq rng (vlax-get-property xlApp 'Cells))

      
      (setq i 0)
      (repeat (sslength sset)
        
	(setq xlCell (vlax-invoke-method
      xlRange
      "Find"
      (vlax-make-variant (vla-get-TEXTSTRING (vlax-ename->vla-object (ssname sset i)) ))
      xlFRange
      -4163
      1
      1
      1
      nil
      nil
           )
     )

 (setq cell (vlax-variant-value (vlax-get-property rng 'Item (vlax-get-property xlCell "Row") (+ 5 (vlax-get-property xlCell "Column")) )     )  ) ;第幾列
(setq cell2 (vlax-variant-value (vlax-get-property rng 'Item (vlax-get-property xlCell "Row") (+ 6 (vlax-get-property xlCell "Column")) )     )  ) ;第幾列


                     (setq ins1 (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint (vlax-ename->vla-object (ssname sset i))))))

	

	(entmakex (list '(0 . "MTEXT")
                       '(100 . "AcDbEntity")
		   '(67 . 0) '(8 . "0S-EL") '(62 . 0) 
		   '(6 . "Continuous")
		   '(100 . "AcDbMText") 
		   (cons 10  (LIST  (+(CAR ins1)85) (+(CADR ins1) 25) (CADDR ins1) )) 
		   '(40 . 12) '(41 . 100) 
		   '(46 . 0) '(71 . 1) '(72 . 5)
		   (cons 1 (RTOS (vlax-variant-value  (vlax-get-property cell 'value2)) 2 2 )) 
		   '(7 . "NOTE") '(11 1 0 0)
		   '(42 . 133.3333333333333) '(43 . 100)
		   '(50 . 0) '(73 . 1) '(44 . 1)
 
                            ) 
                      )
(setq p1 (LIST  (+(CAR ins1)70) (+(CADR ins1) 30) (CADDR ins1))
p2 (LIST  (+(CAR ins1)160) (-(CADR ins1) 20) (CADDR ins1))
p3 (LIST  (+(CAR ins1)70) (+(CADR ins1) 5) (CADDR ins1))
p4 (LIST  (+(CAR ins1)160) (+(CADR ins1) 5) (CADDR ins1))
)
(command "rectang" p1 p2)
(command "line" p3 p4 "")
	(entmakex (list '(0 . "MTEXT")
                       '(100 . "AcDbEntity")
		   '(67 . 0) '(8 . "0S-EL") '(62 . 2) 
		   '(6 . "Continuous")
		   '(100 . "AcDbMText") 
		   (cons 10  (LIST  (+(CAR ins1)85) (CADR ins1) (CADDR ins1) )) 
		   '(40 . 12) '(41 . 100) 
		   '(46 . 0) '(71 . 1) '(72 . 5)
		   (cons 1   (RTOS (vlax-variant-value  (vlax-get-property cell2 'value2)) 2 2 )) 
		   '(7 . "NOTE") '(11 1 0 0)
		   '(42 . 133.3333333333333) '(43 . 100)
		   '(50 . 0) '(73 . 1) '(44 . 1)
 
                            ) 
                      )
	
        (setq i (1+ i))
      )
      
    )
  )
  (princ)
)

hosneyalaa · ‎12-28-2021

HI

Because my language is not good
I did not understand you well

I think you should use a block with attributeS instead of Mtext

Anonymous · ‎12-28-2021

Sorry that my english is not good because I am Chinese.This row code can type the value in excel's cell.How to add string to show the string plus value which from excel.

(cons 1 (RTOS (vlax-variant-value  (vlax-get-property cell 'value2)) 2 2 ))

How to improve the position to let label to align the origin text and have suitable position.

hosneyalaa · ‎12-28-2021

You can specify the angle of the text if it is horizontal or vertical

then

Determine if you add the length or the width

There should be no difference because the entry point does not change if the text is vertical or horizontal

See the picture you have a mistake

hosneyalaa · ‎12-28-2021

I did not understand this
Can you explain in a video?

Want to add another value to Excel?

hosneyalaa · ‎12-28-2021

(IF (= 0.0 (vla-get-ROTATION (vlax-ename->vla-object (ssname sset i)) ))
  (PROGN
    
(setq p1 (LIST  (+(CAR ins1)70) (+(CADR ins1) 30) (CADDR ins1))
p2 (LIST  (+(CAR ins1)160) (-(CADR ins1) 20) (CADDR ins1))
p3 (LIST  (+(CAR ins1)70) (+(CADR ins1) 5) (CADDR ins1))
p4 (LIST  (+(CAR ins1)160) (+(CADR ins1) 5) (CADDR ins1))
)
(command "rectang" p1 p2)
(command "line" p3 p4 "")

    )
  (PROGN

    CHANGE CODE FOR ROTATION /= 0.0 

    )
 )

Anonymous · ‎12-28-2021

Like this

hosneyalaa · ‎12-28-2021

(strcat "TOP: " (RTOS (vlax-variant-value  (vlax-get-property cell 'value2)) 2 2 ))

Anonymous · ‎12-29-2021

Hello,I tried to modify the code and figure out the problem last time.There are another two question. 1.If there is any tag not found in excel, show "error" 2. make mtext from horizontal to vertical . I show the example in dwg, and the lisp I modified attached below. Thank you so much.

hosneyalaa · ‎01-01-2022

HI

TRY

(defun c:EL (/ CELL FILENAME I ICOL INS1 IROW IROWS RNG SSET XLAPP XLBOOK XLCELL XLFRANGE XLRANGE XLRANGEC XLSHEET)
  (vl-load-com)
 (setq dic (dictsearch (namedobjdict) "ACAD_MLINESTYLE"))

(mapcar 'setvar svnames '(0 0)); turn off Osnap, command echoing
(command "_.layer" "_make" "0S-EL" "_color" 7 "" "p"  "N" "" "");; <---EDIT Layer name/color as desired
(setq styht (cdr (assoc 40 (tblsearch "style" (getvar 'dimtxsty))))); height of text style in current dimension style
(if (= styht 0.0) (setq styht (* (getvar 'dimtxt) (getvar 'dimscale)))); if above is non-fixed-height
 
  
  (if (AND
	(setq sset (ssget '((-4 . "<OR") (0 . "MTEXT") (0 . "TEXT") (-4 . "OR>"))))
	(setq fileName (getfiled "Select Excel file to find cell address :" (getvar "dwgprefix") "xlsx;xls" 16))
	
	)
    (progn
      (setq xlApp (vlax-create-object "Excel.Application"))
	(vlax-put-property xlApp "Visible" :vlax-true)
	(setq xlBook (vlax-invoke-method (vlax-get-property xlApp 'WorkBooks) "Open" fileName ) )
	(vlax-invoke-method xlBook "Activate")
	(setq xlSheet (vlax-get-property (vlax-get-property xlBook "WorkSheets") "Item" 1) )

	(setq xlRangeC (vlax-invoke-method xlSheet "Activate") )
	 (setq xlRange (vlax-get-property xlSheet "Range" "A1:A1000"))
	  (vlax-invoke-method xlRange "Select")
         (setq iCol (vlax-get-property xlRange "Column"))
	(setq iRows (vlax-get-property(vlax-get-property xlRange "Rows") "Count" )iRow  (vlax-get-property xlRange "Row") )
	(setq rng (vlax-get-property xlApp 'Cells))

      
      (setq i 0)
      (repeat (sslength sset)

	(setq xlCell (vlax-invoke-method
      xlRange
      "Find"
      (vlax-make-variant (vla-get-TEXTSTRING (vlax-ename->vla-object (ssname sset i)) ))
      xlFRange
      -4163
      1
      1
      1
      nil
      nil
           )
     )
	

	(IF (/= nil xlCell)
	  
	(PROGN  

 (setq cell (vlax-variant-value (vlax-get-property rng 'Item (vlax-get-property xlCell "Row") (+ 5 (vlax-get-property xlCell "Column")) )     )  ) ;ç¬¬å¹¾åˆ—
(setq cell2 (vlax-variant-value (vlax-get-property rng 'Item (vlax-get-property xlCell "Row") (+ 6 (vlax-get-property xlCell "Column")) )     )  ) ;ç¬¬å¹¾åˆ—

 
)
	 
	  )

                     (setq ins1 (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint (vlax-ename->vla-object (ssname sset i))))))


(IF (= 0.0 (vla-get-ROTATION (vlax-ename->vla-object (ssname sset i)) ))
  (PROGN    ;horizontal part
	

	(entmakex (list '(0 . "MTEXT")
                       '(100 . "AcDbEntity")
		   '(67 . 0) '(8 . "0S-EL") '(62 . 0) 
		   '(6 . "Continuous")
		   '(100 . "AcDbMText") 
		   (cons 10  (LIST  (+(CAR ins1)85) (+(CADR ins1) 35) (CADDR ins1) )) 
		   '(40 . 12) '(41 . 100) 
		   '(46 . 0) '(71 . 1) '(72 . 5)
		   (cons 1 (IF (/= nil xlCell)
			     (strcat "TOP: " (RTOS (vlax-variant-value  (vlax-get-property cell 'value2)) 2 2 ))
			     (strcat "TOP: NIL ")
			     )
			 ) 
		   
'(7 . "NOTE") '(11 1 0 0)
		   '(42 . 133.3333333333333) '(43 . 100)
		   '(50 . 0) '(73 . 1) '(44 . 1)
 
                            ) 
                      )

    
(setq p1 (LIST  (+(CAR ins1)70) (+(CADR ins1) 40) (CADDR ins1))
p2 (LIST  (+(CAR ins1)160) (-(CADR ins1) 10) (CADDR ins1))
p3 (LIST  (+(CAR ins1)70) (+(CADR ins1) 15) (CADDR ins1))
p4 (LIST  (+(CAR ins1)160) (+(CADR ins1) 15) (CADDR ins1))
)
(command "rectang" p1 p2)
(command "line" p3 p4 "")
	(entmakex (list '(0 . "MTEXT")
                       '(100 . "AcDbEntity")
		   '(67 . 0) '(8 . "0S-EL") '(62 . 2) 
		   '(6 . "Continuous")
		   '(100 . "AcDbMText") 
		   (cons 10  (LIST  (+(CAR ins1)85) (+(CADR ins1)10) (CADDR ins1) )) 
		   '(40 . 12) '(41 . 100) 
		   '(46 . 0) '(71 . 1) '(72 . 5)
		   (cons 1  (IF (/= nil xlCell)
			 (strcat "BOT: " (RTOS (vlax-variant-value  (vlax-get-property cell2 'value2)) 2 2 ))
			      (strcat "BOT: NIL ")
			      )

			      ) 
		   
'(7 . "NOTE") '(11 1 0 0)
		   '(42 . 133.3333333333333) '(43 . 100)
		   '(50 . 0) '(73 . 1) '(44 . 1)
 
                            ) 
                      )
	)

  (PROGN    ;if not horizontal part

   (entmakex (list '(0 . "MTEXT")
                       '(100 . "AcDbEntity")
		   '(67 . 0) '(8 . "0S-EL") '(62 . 0) 
		   '(6 . "Continuous")
		   '(100 . "AcDbMText") 
		   (cons 10  (LIST  (+(CAR ins1)20) (+(CADR ins1) 35) (CADDR ins1) )) 
		   '(40 . 12) '(41 . 100) 
		   '(46 . 0) '(71 . 1) '(72 . 5)
		   (cons 1 (IF (/= nil xlCell)
			     (strcat "TOP: " (RTOS (vlax-variant-value  (vlax-get-property cell 'value2)) 2 2 ))
			     (strcat "TOP: NIL ")
			     )
			 ) 
		   
'(7 . "NOTE") '(11 1 0 0)
		   '(42 . 133.3333333333333) '(43 . 100)
		   '(50 . 0) '(73 . 1) '(44 . 1)
 
                            ) 
                      )
(setq p1 (LIST  (+(CAR ins1)5) (+(CADR ins1) 40) (CADDR ins1))
p2 (LIST  (+(CAR ins1)95) (-(CADR ins1) 10) (CADDR ins1))
p3 (LIST  (+(CAR ins1)5) (+(CADR ins1) 15) (CADDR ins1))
p4 (LIST  (+(CAR ins1)95) (+(CADR ins1) 15) (CADDR ins1))
)
(command "rectang" p1 p2)
(command "line" p3 p4 "")
	(entmakex (list '(0 . "MTEXT")
                       '(100 . "AcDbEntity")
		   '(67 . 0) '(8 . "0S-EL") '(62 . 2) 
		   '(6 . "Continuous")
		   '(100 . "AcDbMText") 
		   (cons 10  (LIST  (+(CAR ins1)20) (+(CADR ins1)10) (CADDR ins1) )) 
		   '(40 . 12) '(41 . 100) 
		   '(46 . 0) '(71 . 1) '(72 . 5)
		   (cons 1  (IF (/= nil xlCell)
			 (strcat "BOT: " (RTOS (vlax-variant-value  (vlax-get-property cell2 'value2)) 2 2 ))
			      (strcat "BOT: NIL ")
			      )

			      ) 
		   
'(7 . "NOTE") '(11 1 0 0)
		   '(42 . 133.3333333333333) '(43 . 100)
		   '(50 . 0) '(73 . 1) '(44 . 1)
 
                            ) 
                      )
    )
 )

        (setq i (1+ i))
      )
      
    )
  )
  (princ)
)

Community

LISP to recognize mtext from cad to excel

LISP to recognize mtext from cad to excel

LISP to recognize mtext from cad to excel