Sửa lisp

[levietclub 0]

Em có 1 bản vẽ ranh giới khu đất và 1 file danh sách diện tích các lô đất. Em muốn vẽ các lô đất nằm trong ranh giới khu đất từ danh sách diện tích các lô đất đã có. Khi chạy lisp và load từ dữ diện tích các lô đất file .txt hoăc excel thì đều bị báo lỗi . Kính nhờ các anh chị sửa lỗi giúp em để lisp chạy được đúng với yêu cầu ban đầu ạ. Em cảm ơn ạ.

(defun c:VDT ( / *error* acDoc oldDel oldOsmode
               filePath ext lstArea
               p1 p2 vVec vLen vUnit nVec nUnit
               txtHeight txtObj danhSo stt lstData ptInsTable tableObj
               strClip html depthAccum areaVal depth pt1 pt2 pt3 pt4 plineObj
               taoBang ) ; Khai báo biến taoBang

  (vl-load-com)
  (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))

  ;; ---------- Hàm xử lý lỗi ----------
  (defun *error* (msg)
    (if oldDel (setvar "DELOBJ" oldDel))
    (if oldOsmode (setvar "OSMODE" oldOsmode))
    (if msg (princ (strcat "\nLoi: " msg)))
    (princ)
  )

  ;; ---------- Hàm đọc file Excel ----------
  (defun ReadExcelAreas ( filePath / excelApp wb sheet usedRange rows rowsCount i cellObj cellVal lst )
    (setq excelApp (vlax-create-object "Excel.Application"))
    (if (not excelApp) (progn (princ "\nKhong khoi dong duoc Excel.") (exit)))
    (vlax-put-property excelApp 'Visible 0)
    (setq wb (vlax-invoke-method (vlax-get-property excelApp 'Workbooks) 'Open filePath))
    (setq sheet (vlax-get-property excelApp 'ActiveSheet))
    (setq usedRange (vlax-get-property sheet 'UsedRange))
    (setq rows (vlax-get-property usedRange 'Rows))
    (setq rowsCount (vlax-get-property rows 'Count))
    (setq lst '())
    (setq i 1)
    (while (<= i rowsCount)
      (setq cellObj (vlax-invoke-method (vlax-get-property sheet 'Cells) 'Item i 1))
      (setq cellVal (vlax-get-property cellObj 'Value2))
      (vlax-release-object cellObj)
      (if (and cellVal (numberp cellVal) (> cellVal 0))
        (setq lst (append lst (list cellVal)))
      )
      (setq i (1+ i))
    )
    (vlax-invoke-method wb 'Close 0)
    (vlax-invoke-method excelApp 'Quit)
    (vlax-release-object sheet)
    (vlax-release-object wb)
    (vlax-release-object excelApp)
    lst
  )

  ;; ---------- Hàm đọc file TXT ----------
  (defun ReadTxtAreas ( filePath / f line val lst )
    (setq lst '())
    (if (setq f (open filePath "r"))
      (progn
        (while (setq line (read-line f))
          ;; Bỏ dấu cách thừa, nếu dòng không rỗng thì thử đọc số
          (setq line (vl-string-trim " \t\n\r" line))
          (if (/= line "")
            (progn
              (setq val (read line))
              (if (and val (numberp val) (> val 0))
                (setq lst (append lst (list val)))
              )
            )
          )
        )
        (close f)
      )
      (progn
        (princ "\nKhong the mo file TXT.")
        (exit)
      )
    )
    lst
  )

  ;; ---------- Thiết lập biến hệ thống ----------
  (setq oldDel (getvar "DELOBJ"))
  (setq oldOsmode (getvar "OSMODE"))
  (setvar "DELOBJ" 0)
  (setvar "OSMODE" 0)

  ;; ---------- 1. Chọn file và đọc dữ liệu ----------
  (setq filePath (getfiled "Chon file du lieu (Excel hoac TXT)" "" "xlsx;xls;txt" 4))
  (if (not filePath) (exit))

  (setq ext (strcase (vl-filename-extension filePath)))
  (cond
    ((or (equal ext ".XLSX") (equal ext ".XLS"))
     (setq lstArea (ReadExcelAreas filePath))
    )
    ((equal ext ".TXT")
     (setq lstArea (ReadTxtAreas filePath))
    )
    (t
     (princ "\nDinh dang file khong ho tro. Chi chap nhan .xlsx, .xls, .txt.")
     (exit)
    )
  )

  (if (not lstArea)
    (progn (princ "\nKhong tim thay du lieu dien tich hop le trong file.") (exit))
  )

  ;; ---------- 2. Chọn điểm bắt đầu và hướng ----------
  (setvar "OSMODE" 1)
  (setq p1 (getpoint "\nChon diem bat dau (goc trai duoi lo 1): "))
  (if (not p1) (exit))
  (setq p2 (getpoint p1 "\nChon diem thu hai (xac dinh mat tien va huong): "))
  (if (not p2) (exit))
  (setvar "OSMODE" 0)

  (setq vVec (mapcar '- p2 p1))
  (setq vLen (distance p1 p2))
  (if (< vLen 1e-6) (progn (princ "\nKhoang cach qua ngan.") (exit)))
  (setq vUnit (mapcar '(lambda (x) (/ x vLen)) vVec))
  (setq nVec (list (cadr vUnit) (- (car vUnit)) 0.0))
  (initget "Co Khong")
  (if (eq (getkword "\nDao huong sau? [Co/Khong] <Khong>: ") "Co")
    (setq nVec (mapcar '- nVec))
  )
  (setq nUnit nVec)

  ;; ---------- 3. Hỏi đánh số thứ tự ----------
  (initget "Co Khong")
  (setq danhSo (getkword "\nDanh so thu tu cac lo? [Co/Khong] <Co>: "))
  (if (not danhSo) (setq danhSo "Co"))
  (setq txtHeight (* vLen 0.08))
  (if (< txtHeight 1.0) (setq txtHeight 1.0))

  (setq lstData '())
  (setq depthAccum 0.0)

  ;; ---------- 4. Vẽ từng lô ----------
  (foreach areaVal lstArea
    (setq stt (1+ (length lstData)))
    (setq depth (/ areaVal vLen))
    (setq pt1 (mapcar '+ p1 (mapcar '(lambda (x) (* x depthAccum)) nUnit)))
    (setq pt2 (mapcar '+ pt1 (mapcar '(lambda (x) (* x vLen)) vUnit)))
    (setq pt3 (mapcar '+ pt2 (mapcar '(lambda (x) (* x depth)) nUnit)))
    (setq pt4 (mapcar '+ pt1 (mapcar '(lambda (x) (* x depth)) nUnit)))

    (command "_.pline" pt1 pt2 pt3 pt4 "_C")
    (setq plineObj (vlax-ename->vla-object (entlast)))

    (if (eq danhSo "Co")
      (progn
        (setq ptCenter (mapcar '(lambda (a b) (/ (+ a b) 2.0)) pt1 pt3))
        (setq txtObj (vla-addText (vla-get-ModelSpace acDoc) (itoa stt) (vlax-3d-point ptCenter) txtHeight))
        (vla-put-Alignment txtObj acAlignmentCenter)
        (vla-put-TextAlignmentPoint txtObj (vlax-3d-point ptCenter))
      )
    )
    (setq ptCenter (mapcar '(lambda (a b) (/ (+ a b) 2.0)) pt1 pt3))
    (setq ptCenter (mapcar '+ ptCenter (list 0.0 (* -1.5 txtHeight) 0.0)))
    (setq txtObj (vla-addText (vla-get-ModelSpace acDoc) (rtos areaVal 2 2) (vlax-3d-point ptCenter) txtHeight))
    (vla-put-Alignment txtObj acAlignmentCenter)
    (vla-put-TextAlignmentPoint txtObj (vlax-3d-point ptCenter))

    (setq lstData (append lstData (list (cons stt areaVal))))
    (setq depthAccum (+ depthAccum depth))
  )

  ;; ---------- 5. Tạo bảng thống kê (tuỳ chọn) ----------
  (initget "Co Khong")
  (if (eq (getkword "\nTao bang thong ke dien tich? [Co/Khong] <Co>: ") "Khong")
    (setq taoBang nil)
    (setq taoBang T)
  )
  (if taoBang
    (progn
      (setq ptInsTable (getpoint "\nChon diem chen bang: "))
      (if (not ptInsTable) (setq ptInsTable (getvar "VIEWCTR")))
      (setq nRows (1+ (length lstData)))
      (setq nCols 2)
      (setq tableObj (vla-addTable (vla-get-ModelSpace acDoc) (vlax-3d-point ptInsTable) nRows nCols (* 2.0 txtHeight) (* 20.0 txtHeight)))
      (vla-setText tableObj 0 0 "STT")
      (vla-setText tableObj 0 1 "Dien tich (m2)")
      (vla-setCellAlignment tableObj 0 0 acMiddleCenter)
      (vla-setCellAlignment tableObj 0 1 acMiddleCenter)
      (setq row 1)
      (foreach item lstData
        (vla-setText tableObj row 0 (itoa (car item)))
        (vla-setText tableObj row 1 (rtos (cdr item) 2 2))
        (vla-setCellAlignment tableObj row 0 acMiddleCenter)
        (vla-setCellAlignment tableObj row 1 acMiddleCenter)
        (setq row (1+ row))
      )
      (vla-setColumnWidth tableObj 0 (* 10 txtHeight))
      (vla-setColumnWidth tableObj 1 (* 25 txtHeight))
    )
  )

  ;; ---------- 6. Xuất clipboard ----------
  (setq strClip "STT\tDien tich (m2)\n")
  (foreach item lstData
    (setq strClip (strcat strClip (itoa (car item)) "\t" (rtos (cdr item) 2 2) "\n"))
  )
  (if (setq html (vlax-create-object "htmlfile"))
    (progn
      (vlax-invoke-method (vlax-get-property html 'ParentWindow) 'ClipboardData 'SetData "Text" strClip)
      (vlax-release-object html)
      (princ "\nDu lieu da duoc sao chep vao clipboard.")
    )
    (princ "\nKhong the sao chep vao clipboard.")
  )

  ;; Kết thúc
  (setvar "DELOBJ" oldDel)
  (setvar "OSMODE" oldOsmode)
  (princ "\nDa ve cac lo thanh cong.")
  (princ)
)

 

TT 2026.dwg

TDT.txt