Excel管线调查写CAD,加了附件

弥勒

;管线表格生成器 20230104编写完成 。QQ:11414516
(defun c:gxbg( / pt  os  af fp pta w pt1 i filename  XLobj sheetobj exlib wkst row col row5x  rowA rowb rowc ppt1 value value2 value1 value6 value7 value12 ppt1 ph ppt1a ppt3 ppt5 ppt7 ppt9 ppt11 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 pt10 pt11 pt12)
    (vl-load-com)
    (setvar "cmdecho" 0)
    (setq os(getvar "osmode"))
    (setvar "osmode" 0)
    (alert "        欢迎使用管线表格生成器

                    公益免费，后果自负！！！" )
    (setq filename ( getfiled "************" " " "xlsx" 128))

    (setq pta (getpoint "\n 管线成果表>左上角"))
    (if ( null MX-acos)

       (jinn-get-excel-Lib)
    )

     (setq XLobj (vlax-create-object "Excel.Application"))

          (vla-put-visible XLobj 1)

          (vlax-Invoke-Method (vlax-Get-Property XLobj 'Workbooks) 'Open filename)

          (setq sheetobj ( MX-get-activesheet XLobj))
           (get-xl-cell-value sheetobj 5 11)  
          (get-xl-test2-data sheetobj)

     (setvar "osmode" os)
     (setvar "cmdecho" 1)
)
;*************************load excal's library.

(defun jinn-get-excel-Lib ()
      (setq patha "C:\\Program Files (x86)\\Microsoft Office\\root\\Office16\\")
      (setq pathb "C:\\Program Files (x86)\\Microsoft Office\\Office12\\")
      (setq pathc "C:\\Program Files (x86)\\Microsoft Office\\Office14\\")
      (setq pathd "C:\\Program Files (x86)\\Microsoft Office\\Office10\\")

     ( cond
      ((setq exlib    (findfile ( strcat patha "Excel.exe"))))
      ((setq exlib    (findfile ( strcat pathb "Excel.exe"))))
      ((setq exlib    (findfile ( strcat pathc "Excel.exe"))))
      ((setq exlib    (findfile ( strcat pathd "Excel.exe"))))
      (t (setq exlib nil))
     )
         (if exlib
             (vlax-import-type-library
                   :tlb-filename        exlib
                   :methods-prefix      "MX-"
                   :properties-prefix   "MX-"
                   :constants-prefix    "MX-"
             )
            (alert"Excel typelib文件不存在")
         )
)
;****************************************************************************
(defun GET-XL-CELL-value (wkst row col)
       (vlax-variant-value (MX-get-value(vlax-Variant-Value
              (MX-Get-Item (MX-Get-Cells wkst) row col)
        )))
)
;************************************************************************
(defun GET-XL-CELL(wkst row col)
            (vlax-Variant-Value
            (MX-Get-Item (MX-Get-Cells wkst) row col))
)
;****************************************
(defun get-xl-test2-data (stobj)
    (setq  row 1 )
    (setq  col 1 )
    (setq  row5x 2)
    (setq  rowA 0)
    (setq  rowb 0)
    (setq  rowc 2)
    (setq  ppt1 pta)
        (while (get-xl-cell-value stobj row5x 6)
                    (setq value1 (get-xl-cell-value stobj rowc 6));获取种类
                        (if (= (type value1) 'real)
                               (setq value1 (rtos value1 2 0))
                        )
                    (if (= value1  "污水" )
                        (command "layer" "make" "污水" "c"  "247" "污水" "")
                     )
                    (if (= value1  "雨水" )
                        (command "layer" "make" "雨水" "c"  "5" "雨水" "")
                     )
                    (if (= value1  "上水" )
                        (command "layer" "make" "上水" "c"  "4" "上水" "")
                     )
                    (if (= value1  "中水" )
                        (command "layer" "make" "中水" "c"  "8" "中水" "")
                    )
                    (if (= value1  "电力" )
                        (command "layer" "make" "电力" "c"  "1" "电力" "")
                    )
                    (if (= value1  "照明" )
                        (command "layer" "make" "照明" "c"  "1" "照明" "")
                    )
                    (if (= value1  "热力" )
                        (command "layer" "make" "热力" "c"  "40" "热力" "")
                    )
                    (if (= value1  "燃气" )
                        (command "layer" "make" "燃气" "c"  "6" "燃气" "")
                    )
                    (if (= value1  "通信")
                        (command "layer" "make" "通信" "c"  "3" "通信" "")
                    )

         
           
           (gxb ppt1 ) ;drawing grid
           
           (setq ph 2)
           (setq ppt1a  (polar ppt1 pi 22.5))
           (setq ppt3   (polar ppt1a (* pi 1.5) h))
           (setq ppt5   (polar ppt1a (* pi 1.5) (* h 2)))
           (setq ppt7   (polar ppt1a (* pi 1.5) (* h 3)))
           (setq ppt9   (polar ppt1a (* pi 1.5) (* h 4)))
           (setq ppt11  (polar ppt1a (* pi 1.5) (* h 5)))

           (setq value1 (get-xl-cell-value stobj rowc 6));获取种类
                        (if (= (type value1) 'real)
                               (setq value1 (rtos value1 2 0))
                        )
                (repeat 34
                      (setq lista nil)

                      (setq pw 7.5)   ;pipe text location
;***************



;******************
                     (if ( and (> row ( + rowA 4)) (< row ( + rowb 34)) )
                         (PROGN
                             (repeat 13
                                    (setq value (get-xl-cell-value stobj row col))
                                        (if (= (type value) 'real)
                                            (setq value (rtos value 2 2))
                                         )
                                         (setq value2 (get-xl-cell-value stobj row 2))
                                           (if (= (type value2) 'real)
                                            (setq value2 (rtos value2 2 0))
                                        )


                                        (setq value6 (get-xl-cell-value stobj row 6))
                                        (if (= (type value6) 'real)
                                            (setq value6 (rtos value6 2 0))
                                        )
                                        (setq value7 (get-xl-cell-value stobj row 7))
                                        (if (= (type value7) 'real)
                                            (setq value7(rtos value7 2 0))
                                         )
                                        (setq value12 (get-xl-cell-value stobj row 12))
                                        (if (= (type value12) 'real)
                                            (setq value12 (rtos value12 2 0))
                                        )
                              
                                        ;(if (and (and (= col 4)  (/= value2 "")) (or   (/= value6 "") (/= value7 "")))
                                        (if   (/= value2 nil)
                                           (command "text" "bl" ppt3  1 0  value1)
                                            (command "text" "bl" ppt3  1 0  "")
                                        )
                                        (if (= col 2)
                                            (command "text" "bl" ppt5  1 0 value)
                                        )
                                        (if (= col 4)
                                            (command "text" "bl" ppt7  1 0   value )
                                        )

                                       (if (and (= col 6)  (/= value6 ""))
                                       
                                              (PROGN
                                                (command "text" "bl" ppt9  1 0 "管外顶高")
                                                (command "text" "bl" ppt11  1 0   value )
                                              )

                                        )



                              

                              
                                        (if (and (= col 7)  (= value6 "") (/= value7 "")  )
                                          
                                            (PROGN
                                            
                                             (if (= value12 "是")  (command "text" "bl" ppt9  1 0 "沟底高")  (command "text" "bl" ppt9  1 0 "管内底高"))
                                                            
                                            )
                                       
                                        )
                                       (if (and (= col 7)  (/= value7 "") )

                                               (command "text" "bl" ppt11  1 0   value )
                                                
                                       )
                                         

                                    
                                    
                                       


                                  (setq col (+ col 1))
                          );end repeat 12
                      )ROGN
                   );end if
                ;**********
                  (setq ppt3 (polar ppt3 0 w))
                  (setq ppt5 (polar ppt5 0 w))
                  (setq ppt7 (polar ppt7 0 w))
                  (setq ppt9 (polar ppt9 0 w))
                  (setq ppt11 (polar ppt11 0 w))
                  (setq row (+ row 1 ))
                  (setq col 1)
            );end repeat 34
            (setq ppt1   (polar ppt1 (* pi 1.5) 15));向下画表格
            (setq rowA   (+ rowA 34))
            (setq rowb   (+ rowb 34))
            (setq row5x  (+ row5x 34 ))
            (setq rowc   (+ rowc 34))
       )

)
;*****************************************
(defun gxb(  pt )
     (setq w 7.5)
     (setq h 2)
     (setq pt1 pt)
     (setq i 0)
       (while ( < i 30 )

          (setq pt3   (polar pt1 (* pi 1.5) h))
          (setq pt5   (polar pt1 (* pi 1.5) (* h 2)))
          (setq pt7   (polar pt1 (* pi 1.5) (* h 3)))
          (setq pt9   (polar pt1 (* pi 1.5) (* h 4)))
          (setq pt11  (polar pt1 (* pi 1.5) (* h 5)))

          (setq pt2   (polar pt1 0 w))
          (setq pt4   (polar pt2 (* pi 1.5) h))
          (setq pt6   (polar pt2 (* pi 1.5) (* h 2)))
          (setq pt8   (polar pt2 (* pi 1.5) (* h 3)))
          (setq pt10  (polar pt2 (* pi 1.5) (* h 4)))
          (setq pt12  (polar pt2 (* pi 1.5) (* h 5)))

              (command "pline" pt1 pt2  pt12  pt11 pt1 "")
              (command "pline" pt3 pt4     "")
              (command "pline" pt5 pt6     "")
              (command "pline" pt7 pt8     "")
              (command "pline" pt9 pt10    "")
              (command "pline" pt5 pt6     "")

          (setq pt1  (polar pt1 0 w))

              ( if (= i 0)
                  (progn
                    (command "text" "bl" pt3  1 0 "管线类型")
                    (command "text" "bl" pt5  1 0 "点名")
                    (command "text" "bl" pt7  1 0 "方向")
                    (command "text" "bl" pt9  1 0 "高程种类")
                    (command "text" "bl" pt11 1 0 "高程")
                  )
               )
         (setq i (+ i 1))

      )

)