[编程交流] 从文件坐标绘制多段线

(defun c:ptpoly (/ doc spc file nl ptlst)
 (vl-load-com)
 
 (setq doc (vla-get-ActiveDocument
             (vlax-get-Acad-Object))
       spc (if (zerop (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true)
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc)))
 
 (if (setq file (getfiled "Select File" "" "txt" )
   (progn
     (setq file (open file "r"))
     (while (setq nl (read-line file))
       (setq ptlst (cons (StrBrk nl 44) ptlst)))
     (close file)
     (if ptlst
       (progn
         (setq ptlst
                (apply 'append
                       (mapcar
                         (function
                           (lambda (x)
                             (list (car x) (cadr x))))
                         (reverse
                           (mapcar
                             (function
                               (lambda (x)
                                 (mapcar 'distof x))) ptlst)))))
         (vla-addLightweightpolyline spc
           (vlax-make-variant
             (vlax-safearray-fill
               (vlax-make-safearray
                 vlax-vbdouble
                 (cons 0 (1- (length ptlst)))) ptlst))))
       (princ "\n<< No Points Found in File >>")))
   (princ "\n<< No File Selected >>"))
 (princ))
         
(defun StrBrk (str chrc / pos lst)
 (while (setq pos (vl-string-position chrc str))
   (setq lst (cons (substr str 1 pos) lst)
         str (substr str (+ pos 2))))
 (reverse (cons str lst)))

(vl-load-com)
(defun C:PX (/ acapp acsp adoc aexc cel col cols coords csht
       item nwb points poly rang result row rows sht tmp wbks)
(setq aexc (vlax-get-or-create-object "Excel.Application")
     wbks (vlax-get-property aexc "Workbooks")
     nwb  (vlax-invoke-method wbks "Open" "C:\\File excel.xls");;<--change file name here
     sht  (vlax-get-property nwb "Sheets")
     csht (vlax-get-property sht "Item" 1)
     )
(vla-put-visible aexc :vlax-true)
(setq rang (vlax-invoke-method
     (vlax-get-property aexc "Application")
     "InputBox"
     "Select Diapazone To Get Coordinates"
     "Let you get a points"
     nil
     nil
     nil
     nil
     nil
     (vlax-make-variant 8 3))
     )
(setq rang (vlax-variant-value rang)
     )
(setq coords (vlax-get-property rang "Value2")
     )
(setq rows (vlax-get-property (vlax-get-property rang "Rows") "Count")
     )
(setq cols (vlax-get-property
     (vlax-get-property rang "Columns")
     "Count")
     )
(setq row 1)
(repeat        rows
 (setq col 1)
 (repeat cols
   (setq cel (vlax-variant-value
        (vlax-get-property
          (vlax-get-property rang "Cells")
          "Item"
          (vlax-make-variant row vlax-vbLong)
          (vlax-make-variant col vlax-vbLong))))
   (setq item (vlax-variant-value
         (vlax-get-property cel "Value2"))
  )
   (setq tmp (cons item tmp)
  )
   (setq col (1+ col)
  )
   )
 (setq        points (cons (reverse tmp) points)
tmp    nil
row    (1+ row)
)
 )
(setq points (reverse points)
     points (apply 'append points)
     )
(vl-catch-all-apply
 (function (lambda ()
      (vlax-invoke-method
        nwb
        "Close" :vlax-false)))
 )
(vl-catch-all-apply
 (function (lambda ()
      (vlax-invoke-method
        aexc
        "Quit")))
 )
(mapcar        (function (lambda (x)
            (vl-catch-all-apply
              (function        (lambda        ()
                          (progn
                            (vlax-release-object x)
                            (setq x nil)))))))
(list rang csht nwb wbks aexc)
)
(setq
 adoc (vla-get-activedocument
 (setq acapp (vlax-get-acad-object))
 )
 )
(if (= 1 (vlax-get-property adoc "Activespace"))
 (setq acsp (vla-get-modelspace adoc))
 (setq acsp (vla-get-paperspace adoc))
 )
(setq poly (vlax-invoke acsp "Add3DPoly" points)
     )
(vla-eval
 acapp
 (strcat
   "ThisDrawing.SetVariable "USERI1","
   "MsgBox ("Close Polyline?","
   "vbYesNo"
   ",""
   "Answer this question:"
   "")"
   )
 )
(if (= 6 (setq result (getvar "USERI1")))
 (vlax-put-property poly "Closed" :vlax-true)
 )
(vla-zoomextents acapp)
 
(gc)
(gc)
(princ)
 )
(prompt "\t\t***\t\nType PX to run program\t***")
(prin1)