Đến nội dung


Hình ảnh
* - - - - 1 Bình chọn

[Nhờ Chỉnh Sửa] Lisp Tính Diện Tích Trên Nhiều Trắc Ngang


  • Please log in to reply
33 replies to this topic

#1 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 12 October 2015 - 05:07 PM

Đây là lisp mình viết đang còn hạn chế về tính tự động(chỉ tính từng hạng mục một).Bây giờ muốn phát triển thêm tính nhiều hạng mục

chỉ 1 lần chạy:

ý tưởng thì có nhưng viết lại không được mới khổ chứ:

1. Sẽ định nghĩa đối tượng tương ứng với hạng mục

Hạng mục 1

 1.1 chọn đối tượng

 1.2 chọn text hạng mục có sẳn (nếu ghi thì tôt hơn)

 1.3 chọn đơn vị m or m2

Hạng mục 2

 1.1 chọn đối tượng

 1.2 chọn text hạng mục có sẳn (nếu ghi thì tôt hơn)

 1.3 chọn đơn vị m or m2

..........

Sau khi định nghĩa xong các hạng mục Enter thì lisp điền diện tích luôn.

Và đây là lisp:

(defun c:DTTN (/ NDTS dem1 lstkm point kcach point1 pointtim diemtam xuongdong kt diemtren1)
(setvar "CMDECHO" 0)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (setq lop1 "entdauco")
  (prompt "\nChon Pline hoac Hatch mau tinh dien tich.")
  (setq fltr (ssx_fe))
  (prompt "\nChon Text ghi dien tich.")
  (setq DTS (car (entsel)))
  (setq DTS (entget DTS))
  (setq NDTS (cdr (assoc 1 DTS)))
  (command "-layer" "new" "Tinh dien tich TN" "color" "2" "Tinh dien tich TN" "")
  (command "-layer" "set" "Tinh dien tich TN" "")
(if (null cdtxt)
 (caidat)
)
 (setq th (getvar "textsize"))
 (setq dentay (- dentay (* 1.5 th)))
  ;(prompt "\nChon trac ngang.")
  (setq danhsachkm (acet-ss-to-list (ssget "X" (list (cons 8 lop1) (cons 1 "K*")))))
  (setq lstkm (mapcar '(lambda (e) (cons (cdr (assoc 11 (entget e))) (cdr (assoc 1 (entget e))))) danhsachkm))
  (setq lstkm (vl-sort lstkm '(lambda(x y / tmx tmy) (setq tmx (timlt x) tmy (timlt y))
                 (or (< (car tmx) (car tmy))
    (and (= (car tmx) (car tmy)) (< (last tmx) (last tmy)))))))
  (setq ss (acet-ss-to-list (ssget "X" '((0 . "LINE")(8 . "ENTTNTUNHIEN")))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq dem1 1)
(setq sodt (length danhsachkm)
ta 
            (chr 8)
stxoa (strcat ta ta ta ta ta ta ta ta ta ta ta ta ta ta 
            ta ta ta ta ta ta)
stxuly "Xu ly duoc: "
ptcu nil
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (foreach ent lstkm
    (setq point (car ent))
    (setq kcach (distance point (cdr (assoc 11 (entget (nth 0 ss))))))
    (foreach enxt ss
      (setq point1 (cdr (assoc 11 (entget enxt))))
      (setq toay (cadr point1))
      (if (and (< (distance point1 point) kcach) (< toay (cadr point)) (equal (car point1) (car point) 1))
(progn
 (setq pointtim (cdr (assoc 11 (entget enxt))))
 (setq kcach (distance pointtim point))
)
      )
    )
    (setq diemtam (polar pointtim (/ pi 2) (/ kcach 2)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
    (vla-ZoomCenter (vlax-get-acad-object) (vlax-3D-point diemtam) (+ kcach 50))
    (setq dd (acet-ss-to-list (ssget "C" (polar pointtim 0 0.1 ) (polar pointtim 0 0.15 ) '((0 . "LINE")(8 . "ENTTNTUNHIEN")))))
    (setq diemdau (cdr (assoc 10 (entget (car dd)))))
    (setq diemcuoi (cdr (assoc 11 (entget (car dd)))))
    (setq diemtren (polar point (/ pi 2) 10))
	(setq diemtren1 (list (car diemcuoi) (cadr diemtren) 0))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq SSS (ssget "C" diemdau diemtren1 fltr)) 
(if (/= sss nil)
(progn
(setq i 0)
(setq s 0)
(setq N (sslength sss))
  (while (< i N)
  ;(luuos)
  (setvar "osmode" 0)
  (setq DT (ssname sss i))	
  (setq j 0)
  (setq ent1 (ssname data 0))
  (setq diemchuan (cdr (assoc 10 (entget ent1))))
  (Command "area" "o" DT)
  (if (= (getvar "area") 0)
  (progn
  (setq s (+ s (getvar "PERIMETER")))
  (setq i (1+ i))
  (setq donvi "m")
  )
  (progn
  (setq s (+ s (getvar "AREA")))
  (setq i (1+ i))
  (setq donvi "m2")
  )
  ))
  (setq diemghi (polar diemchuan 0 dentax))
  (setq diemghi (polar diemghi (/ pi 2) dentay))
  (setq txt NDTS)
  (command "TEXT" diemghi th 0 txt)
  (setq pointt11 (polar diemghi 0 cdtxt))
  (command "TEXT" pointt11 th 0 ":")
  (setq pointt1 (polar pointt11 0 cdsokl))
  (command "TEXT" "J" "R" pointt1 th 0 (rtos s 2 2))
  (setq point2 (polar pointt1 0 0.2))
  (command "TEXT" point2 th 0 donvi)
  ;(traos)
  )
  (progn
  (setq data (ssget "C" diemdau diemtren1 '((0 . "INSERT") (8 . "entdauco"))))
  (setq ent1 (ssname data 0))
  ;(luuos)
  (setvar "osmode" 0)
  (setq diemchuan (cdr (assoc 10 (entget ent1))))
  (setq diemghi (polar diemchuan 0 dentax))
  (setq diemghi (polar diemghi (/ pi 2) dentay))
  (setq txt NDTS)
  (command "TEXT" diemghi th 0 txt)
  (setq pointt11 (polar diemghi 0 cdtxt))
  (command "TEXT" pointt11 th 0 ":")
  (setq pointt1 (polar pointt11 0 cdsokl))
  (command "TEXT" "J" "R" pointt1 th 0 "0.00")
  (setq point2 (polar pointt1 0 0.2))
  (command "TEXT" point2 th 0 donvi)
  ;(traos)
  )
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; xu ly phan tram chay o duoi
(setq pt (* (/ (* dem1 1.0) sodt) 100.0)
dem1 (+ dem1 1)
)
(if (/= pt ptcu)
(progn
(princ (strcat stxoa stxuly (rtos pt 2 0) "%"))
(setq ptcu pt)
)
)
;(princ "\nDang xu ly")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setvar "MODEMACRO" "DANG CHUYEN DU LIEU CHO TRONG GIAY LAT")  
)
(setvar "CMDECHO" 1)
;(thoi)
)
(defun timlt (st / tm)
  (setq tm (vl-string->list (substr (strcase (cdr st)) (+ 3 (vl-string-search "KM" (strcase (cdr st)))))))
  (read (strcat "(" (vl-list->string (subst 32 43 (subst 32 58 tm))) ")"))
)
(defun Caidat (/ htxt httxt ltxt lsokl)
 (if (null dentax)
 (progn
 (setq dentax 10)
 (setq dentay 10)
 ))
 (setq x (getstring (strcat "\nKhoang cach dien phuong x <"(rtos dentax)"> :")))
 (setq y (getstring (strcat "\nKhoang cach dien phuong y <"(rtos dentay)"> :")))
 (if (/= x "") (setq dentax (atof x)))
 (if (/= y "") (setq dentay (atof y)))
(setq htxt 0.2)
(setq httxt (getstring (strcat "\nNhap chieu cao chu <"(rtos htxt)"> :")))
(if (/= httxt "") (setq htxt (atof httxt)))
(setvar "textsize" htxt)
(setq cdtxt 4.5)
(setq ltxt (getstring (strcat "\nNhap chieu dai chuoi <"(rtos cdtxt)"> :")))
(if (/= ltxt "") (setq cdtxt (atof ltxt)))
(setq cdsokl 0.75)
(setq lsokl (getstring (strcat "\nNhap chieu dai chu so khoi luong <"(rtos cdsokl)"> :")))
(if (/= lsokl "") (setq cdsokl (atof lsokl)))
)
(defun C:Caidatlai (/ htxt httxt ltxt lsokl)
(if (null dentax)
 (progn
 (setq dentax 10)
 (setq dentay 10)
 ))
 (setq x (getstring (strcat "\nKhoang cach dien phuong x <"(rtos dentax)"> :")))
 (setq y (getstring (strcat "\nKhoang cach dien phuong y <"(rtos dentay)"> :")))
 (if (/= x "") (setq dentax (atof x)))
 (if (/= y "") (setq dentay (atof y)))
(setq htxt 0.2)
(setq httxt (getstring (strcat "\nNhap chieu cao chu <"(rtos htxt)"> :")))
(if (/= httxt "") (setq htxt (atof httxt)))
(setvar "textsize" htxt)
(setq cdtxt 4.5)
(setq ltxt (getstring (strcat "\nNhap chieu dai chuoi <"(rtos cdtxt)"> :")))
(if (/= ltxt "") (setq cdtxt (atof ltxt)))
(setq cdsokl 0.75)
(setq lsokl (getstring (strcat "\nNhap chieu dai chu so khoi luong <"(rtos cdsokl)"> :")))
(if (/= lsokl "") (setq cdsokl (atof lsokl)))
) 

Đây là file test:

http://www.cadviet.c...66960_vi_du.dwg


  • 1

#2 buithengan1

buithengan1

    biết vẽ line

  • Members
  • PipPip
  • 22 Bài viết
Điểm đánh giá: -1 (bình thường)

Đã gửi 13 October 2015 - 09:13 AM

cái lisp của bạn phải tô vật liệu hết rồi mới tính được diện tích à


  • 0

#3 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 13 October 2015 - 11:16 AM

Tô cũng được hoặc pline cũng được, các đối tượng của cad có diện tích là ok


  • 0

#4 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 16 October 2015 - 01:01 PM

Dang lay hoay viết tiếp mà hình như hơi khó nên không ai quan tâm.
  • 0

#5 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 16 October 2015 - 06:01 PM

Bài toán của bạn khá hay

Nhưng theo mình cách tính diện tích nên theo hướng khác, vì nếu đã tạo được Polyline thì vấn đề đơn giản rồi

Thuật toán xây dựng nên như Nova, dựa vào đường trắc ngang tự nhiên để xác định các loại diện tích.


  • 0

#6 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 16 October 2015 - 08:43 PM

Nó xuất phát từ thực tế bạn à. Với lại mình không đủ khả năng để xây dựng các thuật toán như Nova với các mã diện tích với các phép toán cộng trừ. ở đây mình đơn giản hơn nhiều. chỉ là các Polyline và các Hatch đã tạo ra sẳn từ 1 ứng dụng khác. Cám ơn bạn đã quan tâm


  • 1

#7 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 16 October 2015 - 09:08 PM

Mình cũng đang quan tâm đến chủ đề này. Nhưng về VBA mình có thể làm được cái bạn đang cần

Theo hướng này, bạn nên đi vào giao diện thì hay hơn
Sẽ tạo ra 1 list box gồm các layer đối tượng cần ghi trên từng trắc ngang
Sau đó, lệnh sẽ lấy diện tích hoặc chiều dài của đối tượng này ghi vào bản vẽ

Nhưng mình thiên theo hướng giống như Nova hơn, đang tìm hiểu và xây dựng bằng VBA

Bạn có ý tưởng gì có thể chia sẻ giúp

Trân trọng!


  • 0

#8 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 16 October 2015 - 10:55 PM

Cái giao diện thì mình đã nghĩ tới rồi nhưng khả năng viết thì chưa làm được. Lisp của mình ở đây lọc theo hàm ssx chứ ko phải layer. Mình nghĩ sẽ tao 1list các điều kiện lọc, sau đó sẽ chạy qua từng điều kiện để lấy kết quả không biết có được ko nữa.
Còn về VBA thì lúc đầu định đi theo nhưng lên diễn đàn thấy mọi người ko quan tâm nhiều nên bỏ.
  • 0

#9 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 20 October 2015 - 05:42 PM

Sau mấy ngày mày mò cuối cùng cũng làm được đang mày mò tiếp để đưa thêm giao diện vào là ok

 

https://youtu.be/7NInPky8G1M


  • 0

#10 buithengan1

buithengan1

    biết vẽ line

  • Members
  • PipPip
  • 22 Bài viết
Điểm đánh giá: -1 (bình thường)

Đã gửi 21 October 2015 - 09:23 AM

mình thấy trện youtube có 1 cái lisp tính diện tích khá hay nhưng không tải được. bạn có thể liên hệ với tác giả xem chớ mình thấy lisp của bạn phải mất thêm công đoạn bo polyline hoặc tô vật liệu khá mất thời gian


  • 0

#11 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 21 October 2015 - 10:56 AM

Cái này của Bác Hưng bạn vào trang của Bác ấy mà down nếu không thì để lại mail mình gửi cho. Cái này thì mình chưa dùng nhưng mình đã down về. Những cái Hatch và poly đã xuất ra từ 1 phần mềm khác, nên cũng nhanh thôi. mình đưa lên cho ai cần thôi mà


  • 2

#12 buithengan1

buithengan1

    biết vẽ line

  • Members
  • PipPip
  • 22 Bài viết
Điểm đánh giá: -1 (bình thường)

Đã gửi 21 October 2015 - 03:53 PM

bạn cho mình xin cái lisp của bác hưng với cái phần mềm tô cái hatch với poly luôn nha. cảm ơn bạn nhiều. mail của mình là thengan1990@gmail.com


  • 0

#13 leoteo1988

leoteo1988

    Chưa sử dụng CAD

  • Members
  • Pip
  • 3 Bài viết
Điểm đánh giá: -2 (bình thường)

Đã gửi 22 October 2015 - 09:30 AM

Mình là dân ngoại đạo biết rất ít nhưng lisp bạn viết cũng khá hay, mình tải về dùng thử thì bị lỗi, nếu được xin phép bạn gửi cho mình cái lisp này dùng thử, và cái bác hưng nữa. Cảm ơn bạn đã góp cho diễn đàn rất bổ ích, mail của mình là leohuy1988@gmail.com, một lần nữa cảm ơn bạn rất nhiều


  • 0

#14 chuotxd

chuotxd

    Chưa sử dụng CAD

  • Members
  • Pip
  • 3 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 12 November 2015 - 10:12 AM

e là thành viên mới .. đấy là vấn đê e tìm rất lâu rồi . bác có thể cho e xin lip của bác Hưng đc k ạ. vì clip bác ấy up lên mạng e đã thấy nhưng k dowload đc về .. nếu đc gủi cho e vào gmail.. xuandoaixd92@gmail.com.. tk bác huunhantvxdts


  • 0

#15 chuotxd

chuotxd

    Chưa sử dụng CAD

  • Members
  • Pip
  • 3 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 12 November 2015 - 10:23 AM

nếu đc bác cho e xin lip của bác viết đã sửa trong youtube ạ.. lip tren loi hay sao ấy e k gọi đc lệnh dttn .. vì vẫn con gà nên mong bác thông cảm .. huunhantvxdts


  • 0

#16 trangnhung

trangnhung

    biết vẽ pline

  • Members
  • PipPip
  • 60 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 12 November 2015 - 02:06 PM

chào bác huunhantvxdts cho mình hỏi một chút, mình đã xem clips, mình có một thắc mắc là nếu như vậy thì mình phải bôi hacth cho toàn bộ các mặt cắt à vì địa hình luôn thay đổi làm như vậy rất mất thời gian. Mong hồi âm

ps: bác cho e xin lisp của bác duyhung được ko: mail:vlc.vnn@gmail.com


  • 0

#17 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 12 November 2015 - 02:32 PM

Đã gửi cho 2 bạn 

trangnhung chuotxd
  • 1

#18 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 12 November 2015 - 02:35 PM

chào bác huunhantvxdts cho mình hỏi một chút, mình đã xem clips, mình có một thắc mắc là nếu như vậy thì mình phải bôi hacth cho toàn bộ các mặt cắt à vì địa hình luôn thay đổi làm như vậy rất mất thời gian. Mong hồi âm

ps: bác cho e xin lisp của bác duyhung được ko: mail:vlc.vnn@gmail.co

Cái này Hatch cũng được Polyline cũng được, đang nghiên cứu để tự động hơn


  • 1

#19 trangnhung

trangnhung

    biết vẽ pline

  • Members
  • PipPip
  • 60 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 13 November 2015 - 08:45 AM

thanks bác, chúc bác một ngày tốt lành !


  • 0

#20 thonghoang

thonghoang

    Chưa sử dụng CAD

  • Members
  • Pip
  • 2 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 13 November 2015 - 08:35 PM

  chào bác 

huunhantvxdt: lip của bác mình thấy hay. bác cho minh xin lip cua bác được không: mail:daccogdp@gmail.com. cảm ơn nhiều
  • 0