Autolisp Muốn Chèn Một Đường Line Ngang Vào Giữa Mặt Cắt Ngang

[cetuananh 0]

^{Mình giờ có cả ngàn cắt ngang, trên mặt cắt ngang đã có mức so sánh và các cao độ . Bây giờ mình muốn chèn một đường line ngang vào giữa mặt cắt ngang với cao độ do mình tự chọn. Bạn nào có ứng dụng giúp mình với nhé. Mình làm không xuể.} 

^{p/s Mình đã tìm kiếm gần 2 ngày mà không có, nên cực chẳng đã nhờ cậy các bạn. Mong các bạn đừng ném đá nhé. Mình có file có chú thích gửi lên cho các bạn hiểu ý của mình.}

http://www.mediafire.com/download/zco3361km0o6ucs/The+hien.dwg

[VUVUZELA 100]

Ui ,dễ

3 nốt nhạc bạn ơi

[ThuyLinh313 156]

Ui ,dễ

3 nốt nhạc bạn ơi

 

Chủ topic chờ hết 3 nốt nhạc đi. nếu bạn í không viết được cho bạn thì mình giúp. Thời hạn chót bạn cần là bao giờ?

[cetuananh 0]

Ui ,dễ

3 nốt nhạc bạn ơi

Ui, Bạn giúp mình được không?!!! Hi

[cetuananh 0]

Chủ topic chờ hết 3 nốt nhạc đi. nếu bạn í không viết được cho bạn thì mình giúp. Thời hạn chót bạn cần là bao giờ?

Mình vẫn đang phải làm thủ công bạn ạ, làm nhiều lắm. Bạn giúp mình với. Mình không hiểu gì , để viết ứng dụng cả!!

[tien2005 241]

Bạn dùng cái này nhé. Lệnh MOV

 

;; txt2num from http://www.cadviet.com/forum/index.php?showtopic=54635
(defun txt2num (str / num pos)
  (setq pos (vl-string-search (setq num (vl-list->string (vl-remove-if-not '(lambda (x) (or (< 44 x 47)(< 47 x 58)))(vl-string->list str))))str))
  (list
    (substr str 1  pos)
    (if (vl-string-search "." num)(atof num)(atoi num))
    (substr str (+ 1 pos (strlen num)))
    )
  )
(defun DXF (code ent) (cdr (assoc code (entget ent))))
(defun c:mov (/ tl ss txtss txt dy)
  (setq tl (getreal "\nTi le ban ve: "))
  (while
    (and (setq ss (car (entsel "\nChon LINE so sanh: ")))
	 (setq txtss (car (entsel "\nChon text cao do so sanh: ")))
	 (setq txt (car (entsel "\nChon text cao do dat line moi: ")))
    )
     (setq txtss (cadr (txt2num (dxf 1 txtss)))
	   txt	 (cadr (txt2num (dxf 1 txt)))
	   dy	 (/ (- txt txtss) 0.001 tl)
     )
     (entmakex
       (list '(0 . "LINE")
	     (cons 62 1)		; 1 - mau do
	     (cons 10 (mapcar '+ (dxf 10 ss) (list 0 dy 0)))
	     (cons 11 (mapcar '+ (dxf 11 ss) (list 0 dy 0)))
       )
     )
  )
  (princ)
)

[hiepttr 538]

Mình có ý kiến hơi "phá hoại" 1 tí: :D :D :D

Đã là trắc ngang ... với số lượng hàng ngàn thì sao lại ko vẽ đường màu đỏ bằng Thiết kế trắc ngang trong Nova ?

>>> Chỉ cần thống kê cao độ cần vẽ thành 1 dãy = CĐTK ?!

[ThuyLinh313 156]

Bạn VUVUZELA chắc đang hát trường ca sông lô.

Cetuananh dùng lisp này nhé. Lệnh là CD.

Hướng dẫn sử dụng.

- Gõ lệnh CD. nhập tỷ lệ -> zoom pan đến trắc ngang cần vẽ -> pick luôn vào text cao độ cần vẽ  - > zoom pan chuyển sang trắc ngang tiếp theo -> pick text cao độ cần vẽ ..... cứ vậy cho đến hết. toàn bộ các trắc ngang bạn không cần phải làm bước 2 nhé. chỉ cần đảm bảo zoom thấy text MSS và đường line tim đường trước khi pick text cao độ của trắc ngang đó.

tỷ lệ như bản vẽ của bạn up lên thì nhập là 5 nhé

.http://www.cadviet.com/upfiles/4/86046_thehien_1.rar

[VUVUZELA 100]

Nếu mình đoán không nhầm thì bạn đang làm hồ sơ hoàn công, đưa cao độ địa chất của từng lớp vào MCN chi tiết phải không?

Nếu mình viết pm chạy trong vòng 3 nốt nhạc thì mình sẽ làm như vầy :

- Nếu mình làm thì chỉ cần nhập số liệu từng cọc cao độ trước, rồi chọn file cần vẽ hoàn công

- PM sẽ tự động nhận diện toàn bộ hàng ngàn MCN, đưa lớp địa chất vào

- Tự động HATCH, tính diện tích hàng ngàn MCN với từng lớp địa chất

- Tự động xuất ra bảng Excel ==> tính khối lượng tổng và thanh toán luôn

Chứ với hàng ngàn MCN như thế, mỗi MCN 2 command+pan zoom nữa thì ra hàng chục ngàn câu lệnh, dễ sai sót

Ý tưởng của mình là thế, các bác chém hoặc ném đá nhẹ tay nhé :)))

[ThuyLinh313 156]

Rất hay, rất chuyên nghiệp, thể hiện 1 tư duy lớn nhưng... sản phẩm của bạn đâu?

không biết 3 nốt nhạc của bạn là bao lâu nhưng hiện tại là 3 ngày rồi. chủ topic thì có vẻ như cần gấp. Vậy bao giờ thì bạn viết xong và  quan trọng hơn, tinh thần chia sẻ của bạn thế nào cũng là 1 câu hỏi lớn đây? :wub:

[thehost31 19]

Thuylinh313 code rất hay. Vuvuzela cũng có ý hay. Tớ code hơi chuối nhưng thêm ý của vuvuzela cho tiện thao tác. Tuy nhiên, sẽ có sai sót nếu bản vẽ của bạn có khác đôi chút.
 
code của bạn đây. Chạy luôn cả ngàn MCN cho bạn. Lệnh: cd

(defun c:tl()
(setq #tl (getreal "\nNh\U+1EADp t\U+1EF7 l\U+1EC7 v\U+1EBD cao: "))
)

(defun Find_Mlevel(pt1 pt2 / ssmss ti ent texi t_po cdo hl Mlevel)
(setq ssmss (ssget "_W" pt1 pt2 '((0 . "TEXT"))) ti 0)
(while (< ti (sslength ssmss))
(setq ent (entget (ssname ssmss ti))
texi (cdr (assoc 1 ent))
t_po (cdr (assoc 10 ent))
)
(if (= (substr texi 1 5) "MSS: ")
(progn
(setq cdo (atof (substr texi 6 (- (strlen texi) 9)))
hl (ssget "_F" (list t_po (polar t_po (* 1.5 pi) 6.0)))
Mlevel (cadr (cdr (assoc 10 (entget (ssname hl 0)))))
ti (sslength ssmss)
)
)
)
(setq ti (1+ ti))
)
(list cdo Mlevel)
)

(defun Add_Line(pt1 pt2 / modelSpace ourLine)
(setq modelSpace (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-Acad-Object))))
(setq Line (vla-addline modelSpace (vlax-3d-point pt1) (vlax-3d-point pt2)))
)

(defun c:cd(/ ssx si dc_point C1 C2 T1 T2 mlevel ele sste cdo YYY)
(if (= #tl nil) (c:tl))
(prompt "\nCh\U+1ECDn ch\U+1EEF nh\U+1EADt bao toàn b\U+1ED9 tr\U+1EAFc ngang")
(setq pt1 (getpoint "\n\U+0110i\U+1EC3m th\U+1EE9 1: "))
(setq pt2 (getcorner "\n\U+0110i\U+1EC3m \U+0111\U+1ED1i di\U+1EC7n: " pt1))
(command ".zoom" "w" pt1 pt2)
(setq ssb (ssget "_W" pt1 pt2 '((0 . "INSERT") (2 . "Dau_co"))))
(command ".zoom" "p" "")
(setq pt (cdr (assoc 10 (entget (ssname ssb 0)))))
(setq #CX1 (- (car pt) (car pt1))
#CY1 (- (cadr pt) (cadr pt1))
#CX2 (- (car pt) (car pt2))
#CY2 (- (cadr pt) (cadr pt2))
)
(prompt "\nCh\U+1ECDn ch\U+1EEF nh\U+1EADt bao g\U+1ECDn text ch\U+1EE9a cao \U+0111\U+1ED9")
(setq pt1 (getpoint "\n\U+0110i\U+1EC3m th\U+1EE9 1: "))
(setq pt2 (getcorner "\n\U+0110i\U+1EC3m \U+0111\U+1ED1i di\U+1EC7n: " pt1))
(command ".zoom" "w" pt1 pt2)
(setq sst (ssget "_W" pt1 pt2 '((0 . "TEXT"))))
(command ".zoom" "p")
(setq #TX1 (- (car pt) (car pt1))
#TY1 (- (cadr pt) (cadr pt1))
#TX2 (- (car pt) (car pt2))
#TY2 (- (cadr pt) (cadr pt2))
)
(setq ssx (ssget "_X" '((0 . "INSERT") (2 . "Dau_co"))) si 0)
(while (< si (sslength ssx))
(setq dc_point (cdr (assoc 10 (entget (ssname ssx si)))))
(setq C1 (list (- (car dc_point) #CX1) (- (cadr dc_point) #CY1))
C2 (list (- (car dc_point) #CX2) (- (cadr dc_point) #CY2))
T1 (list (- (car dc_point) #TX1) (- (cadr dc_point) #TY1))
T2 (list (- (car dc_point) #TX2) (- (cadr dc_point) #TY2))
)
(command ".zoom" "w" C1 C2)
(setq mlevel (FIND_MLEVEL C1 C2))
(setq sste (ssget "_W" T1 T2 '((0 . "TEXT"))))
(setq cdo (atof (cdr (assoc 1 (entget (ssname sste 0))))))
(setq YYY (+ (* (- cdo (car mlevel)) #tl) (cadr mlevel)))
(ADD_LINE (list (car C1) YYY 0.0) (list (car C2) YYY 0.0))
(setq si (1+ si))
)
(princ)
(princ)
)

 
Video mình chạy thử để bạn dễ hình dung:

https://www.youtube.com/watch?v=j9jTEQLBM20&feature=youtu.be

[cetuananh 0]

Bạn dùng cái này nhé. Lệnh MOV

 

;; txt2num from http://www.cadviet.com/forum/index.php?showtopic=54635
(defun txt2num (str / num pos)
  (setq pos (vl-string-search (setq num (vl-list->string (vl-remove-if-not '(lambda (x) (or (< 44 x 47)(< 47 x 58)))(vl-string->list str))))str))
  (list
    (substr str 1  pos)
    (if (vl-string-search "." num)(atof num)(atoi num))
    (substr str (+ 1 pos (strlen num)))
    )
  )
(defun DXF (code ent) (cdr (assoc code (entget ent))))
(defun c:mov (/ tl ss txtss txt dy)
  (setq tl (getreal "\nTi le ban ve: "))
  (while
    (and (setq ss (car (entsel "\nChon LINE so sanh: ")))
	 (setq txtss (car (entsel "\nChon text cao do so sanh: ")))
	 (setq txt (car (entsel "\nChon text cao do dat line moi: ")))
    )
     (setq txtss (cadr (txt2num (dxf 1 txtss)))
	   txt	 (cadr (txt2num (dxf 1 txt)))
	   dy	 (/ (- txt txtss) 0.001 tl)
     )
     (entmakex
       (list '(0 . "LINE")
	     (cons 62 1)		; 1 - mau do
	     (cons 10 (mapcar '+ (dxf 10 ss) (list 0 dy 0)))
	     (cons 11 (mapcar '+ (dxf 11 ss) (list 0 dy 0)))
       )
     )
  )
  (princ)
)

Thật tuyệt vời, bạn đã cho líp đúng ý mình. Mình đã làm thành công. Thật đa tạ, đa tạ. Mình không biết nói gì hơn. Cảm ơn bạn rất nhiều.

[cetuananh 0]

Rất hay, rất chuyên nghiệp, thể hiện 1 tư duy lớn nhưng... sản phẩm của bạn đâu?

không biết 3 nốt nhạc của bạn là bao lâu nhưng hiện tại là 3 ngày rồi. chủ topic thì có vẻ như cần gấp. Vậy bao giờ thì bạn viết xong và  quan trọng hơn, tinh thần chia sẻ của bạn thế nào cũng là 1 câu hỏi lớn đây? :wub:

heeeeeeeeee, May mà vạn Tien 2005 đã trợ giúp thành công!

[cetuananh 0]

Thuylinh313 code rất hay. Vuvuzela cũng có ý hay. Tớ code hơi chuối nhưng thêm ý của vuvuzela cho tiện thao tác. Tuy nhiên, sẽ có sai sót nếu bản vẽ của bạn có khác đôi chút.

 

code của bạn đây. Chạy luôn cả ngàn MCN cho bạn. Lệnh: cd

(defun c:tl()

(setq #tl (getreal "\nNh\U+1EADp t\U+1EF7 l\U+1EC7 v\U+1EBD cao: "))

)

 

(defun Find_Mlevel(pt1 pt2 / ssmss ti ent texi t_po cdo hl Mlevel)

(setq ssmss (ssget "_W" pt1 pt2 '((0 . "TEXT"))) ti 0)

(while (< ti (sslength ssmss))

(setq ent (entget (ssname ssmss ti))

texi (cdr (assoc 1 ent))

t_po (cdr (assoc 10 ent))

)

(if (= (substr texi 1 5) "MSS: ")

(progn

(setq cdo (atof (substr texi 6 (- (strlen texi) 9)))

hl (ssget "_F" (list t_po (polar t_po (* 1.5 pi) 6.0)))

Mlevel (cadr (cdr (assoc 10 (entget (ssname hl 0)))))

ti (sslength ssmss)

)

)

)

(setq ti (1+ ti))

)

(list cdo Mlevel)

)

 

(defun Add_Line(pt1 pt2 / modelSpace ourLine)

(setq modelSpace (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-Acad-Object))))

(setq Line (vla-addline modelSpace (vlax-3d-point pt1) (vlax-3d-point pt2)))

)

 

(defun c:cd(/ ssx si dc_point C1 C2 T1 T2 mlevel ele sste cdo YYY)

(if (= #tl nil) (c:tl))

(prompt "\nCh\U+1ECDn ch\U+1EEF nh\U+1EADt bao toàn b\U+1ED9 tr\U+1EAFc ngang")

(setq pt1 (getpoint "\n\U+0110i\U+1EC3m th\U+1EE9 1: "))

(setq pt2 (getcorner "\n\U+0110i\U+1EC3m \U+0111\U+1ED1i di\U+1EC7n: " pt1))

(command ".zoom" "w" pt1 pt2)

(setq ssb (ssget "_W" pt1 pt2 '((0 . "INSERT") (2 . "Dau_co"))))

(command ".zoom" "p" "")

(setq pt (cdr (assoc 10 (entget (ssname ssb 0)))))

(setq #CX1 (- (car pt) (car pt1))

#CY1 (- (cadr pt) (cadr pt1))

#CX2 (- (car pt) (car pt2))

#CY2 (- (cadr pt) (cadr pt2))

)

(prompt "\nCh\U+1ECDn ch\U+1EEF nh\U+1EADt bao g\U+1ECDn text ch\U+1EE9a cao \U+0111\U+1ED9")

(setq pt1 (getpoint "\n\U+0110i\U+1EC3m th\U+1EE9 1: "))

(setq pt2 (getcorner "\n\U+0110i\U+1EC3m \U+0111\U+1ED1i di\U+1EC7n: " pt1))

(command ".zoom" "w" pt1 pt2)

(setq sst (ssget "_W" pt1 pt2 '((0 . "TEXT"))))

(command ".zoom" "p")

(setq #TX1 (- (car pt) (car pt1))

#TY1 (- (cadr pt) (cadr pt1))

#TX2 (- (car pt) (car pt2))

#TY2 (- (cadr pt) (cadr pt2))

)

(setq ssx (ssget "_X" '((0 . "INSERT") (2 . "Dau_co"))) si 0)

(while (< si (sslength ssx))

(setq dc_point (cdr (assoc 10 (entget (ssname ssx si)))))

(setq C1 (list (- (car dc_point) #CX1) (- (cadr dc_point) #CY1))

C2 (list (- (car dc_point) #CX2) (- (cadr dc_point) #CY2))

T1 (list (- (car dc_point) #TX1) (- (cadr dc_point) #TY1))

T2 (list (- (car dc_point) #TX2) (- (cadr dc_point) #TY2))

)

(command ".zoom" "w" C1 C2)

(setq mlevel (FIND_MLEVEL C1 C2))

(setq sste (ssget "_W" T1 T2 '((0 . "TEXT"))))

(setq cdo (atof (cdr (assoc 1 (entget (ssname sste 0))))))

(setq YYY (+ (* (- cdo (car mlevel)) #tl) (cadr mlevel)))

(ADD_LINE (list (car C1) YYY 0.0) (list (car C2) YYY 0.0))

(setq si (1+ si))

)

(princ)

(princ)

)

 

 

Video mình chạy thử để bạn dễ hình dung:

https://www.youtube.com/watch?v=j9jTEQLBM20&feature=youtu.be

Rất hay bạn ạ, nhưng nó vân hay xuất hiện lỗi ạ.

[Doan Van Ha 3.191]

@cetuananh: thấy bạn khen nhiều mà chưa thấy bạn bấm like cho các cao thủ í.

[cetuananh 0]

@cetuananh: thấy bạn khen nhiều mà chưa thấy bạn bấm like cho các cao thủ í.

Mình đã LIKE cho các cau thủ rồi bạn nhé, may mắn diễn đàn đã giúp mình cứu bàn thua trông thấy./.

[truongbathuc 0]

xin nhờ các cao thủ sửa lít tính dien tích này ở phần ghi đè kết quả muốn có thêm chữ m phía sau kết quả diện tích.thanks