[yêu cầu] xin lisp ghi cao độ

[tvkill 1]

chào các bro

mình đang làm hồ sơ hoàn công,nên rất cần 1 lisp có nội dung như sau:

chọn 1 điểm mình nhập tạo độ gốc,sau đó pick vào điểm khác thì xuất ra text có sẵn của điểm đó

mình đang rất cần,mong cả nhà giúp

xin cám ơn

[quang_lac 32]

tìm trước khí hỏi đi bạn, diễn đàn có rất nhiều rùi

[mathan 60]

chào các bro

mình đang làm hồ sơ hoàn công,nên rất cần 1 lisp có nội dung như sau:

chọn 1 điểm mình nhập tạo độ gốc,sau đó pick vào điểm khác thì xuất ra text có sẵn của điểm đó

mình đang rất cần,mong cả nhà giúp

xin cám ơn

Trên diễn đàn hẳn có rất nhiều LISP na ná như bạn mong muốn

Ví dụ như LISP đánh cốt tự động của bác Nguyen Hoanh http://www.cadviet.c...p?showtopic=152

Hoặc bạn có thể dùng thử đồ chơi của mình

;;; Free lisp code from CADViet.com
(defun CheckObj(e MyType) (equal (cdr (assoc 0 (entget e))) MyType))
;;;-----------------------------------------
(defun FilObj(ss1 MyType / ss2 i e)
(setq ss2 (ssadd) i 0)
(repeat (sslength ss1)
(setq e (ssname ss1 i) i (1+ i))
(if (CheckObj e MyType) (ssadd e ss2) )
)
(eval ss2)
)
;;;-----------------------------------------
(defun SelData( / OK)
(setq OK nil)
(while (not OK)
(prompt "\tChon text: ")
(setq ss (FilObj (ssget) "TEXT"))
(if (> (sslength ss) 0) (setq OK T) (princ "\nDoi tuong chon khong phai text"))
)
)
;;;-----------------------------------------
(defun WriteRes1(kq / OK e chen data txt)
(setq OK nil)
(while (not OK)
(if (null cheno) (setq cheno ""))
(setq chen (getstring (strcat "\nText chen them vao phia truoc: an 1[+ enter] de nhan text( " cheno " ) hoac nhap text: "))) ;; Dung viet them ghi chu cho text cao do (co the bo qua)
(if (= chen "1") (setq chen cheno) (setq cheno chen))
(setq e (car (entsel "\nChon text ghi ket qua cao do: ")))
(if (CheckObj e "TEXT") (setq OK T) (princ "\nDoi tuong chon khong phai text"))
)
(setq txt (strcat chen (rtos kq 2 tp)))
(entmod (subst (cons 1 txt) (assoc 1 (setq data (entget e))) data))
(princ)
)
;;;-----------------------------------------
(defun C:kb( / new1 )
(if (null newo) (setq newo 1000.0))
(setq new1 (getreal (strcat "\nNhap ty le ban ve 1/ <" (rtos newo) ">:ok [enter] or: ")))
(if (null new1) (setq new1 newo) (setq newo new1))
(setq tyle newo)
(setq dgoc (getpoint "\nChon diem goc cao do: "))
(setq cdg (getreal "\nNhap vao cao do goc: "))
(setq tp (getint "\nNhap vao so chu so thap phan: "))
)
;;;;;;;;;;---------------------------------
(defun C:ccd( / )
(setq i 1 n 100)
(while (< i n)
(setq dchon (getpoint "\nChon diem can tinh cao do: "))
(setq cddc (- cdg (* (/ 1 tyle) (- (cadr dgoc) (cadr dchon) )))	)
;(WriteRes1 cddc)  ;; De dien vao text cac text co san
(command "TEXT" dchon "" "" (rtos cddc 2 tp))  ;; De viet them text moi Ban dung 1 trong 2 truong hop nhe
(setq i (+ i 1))
)
(princ)
)

 

 

Bạn dùng lệnh KB để chọn điểm gốc và các thông số

Và lệnh CCD để chèn cao độ vào các vị trí mong muốn

Trong LISP có 2 options ghi vào text có sẵn hoặc chèn text bạn nhé

Dùng trường hợp nào thì bạn cho dấu ";" vào đầu dòng còn lại nhé và bỏ dấu ";" của dòng kia đi

Lưu ý: Nếu chèn text, bạn hãy tạo text style có sẵn chiều cao chữ như bạn muốn thì nó mới chạy ngon được bạn nhé

Thân,

[ketxu 2.984]

Đã viết theo dạng vừa copy vừa đánh

[tvkill 1]

tìm trước khí hỏi đi bạn, diễn đàn có rất nhiều rùi

Trước khi muốn giúp ai đó cái gì thì hãy đọc người ta cần gì .Đừng cầm đèm chạy trước ô tô

Mình thì không biết viết lisp,mình đã tìm nhưng chăng cái nào đúng ý mình mong muốn cả,nên mói lập topick mới này

[tvkill 1]

Trên diễn đàn hẳn có rất nhiều LISP na ná như bạn mong muốn

Ví dụ như LISP đánh cốt tự động của bác Nguyen Hoanh http://www.cadviet.c...p?showtopic=152

Hoặc bạn có thể dùng thử đồ chơi của mình

;;; Free lisp code from CADViet.com
(defun CheckObj(e MyType) (equal (cdr (assoc 0 (entget e))) MyType))
;;;-----------------------------------------
(defun FilObj(ss1 MyType / ss2 i e)
(setq ss2 (ssadd) i 0)
(repeat (sslength ss1)
(setq e (ssname ss1 i) i (1+ i))
(if (CheckObj e MyType) (ssadd e ss2) )
)
(eval ss2)
)
;;;-----------------------------------------
(defun SelData( / OK)
(setq OK nil)
(while (not OK)
(prompt "\tChon text: ")
(setq ss (FilObj (ssget) "TEXT"))
(if (> (sslength ss) 0) (setq OK T) (princ "\nDoi tuong chon khong phai text"))
)
)
;;;-----------------------------------------
(defun WriteRes1(kq / OK e chen data txt)
(setq OK nil)
(while (not OK)
(if (null cheno) (setq cheno ""))
(setq chen (getstring (strcat "\nText chen them vao phia truoc: an 1[+ enter] de nhan text( " cheno " ) hoac nhap text: "))) ;; Dung viet them ghi chu cho text cao do (co the bo qua)
(if (= chen "1") (setq chen cheno) (setq cheno chen))
(setq e (car (entsel "\nChon text ghi ket qua cao do: ")))
(if (CheckObj e "TEXT") (setq OK T) (princ "\nDoi tuong chon khong phai text"))
)
(setq txt (strcat chen (rtos kq 2 tp)))
(entmod (subst (cons 1 txt) (assoc 1 (setq data (entget e))) data))
(princ)
)
;;;-----------------------------------------
(defun C:kb( / new1 )
(if (null newo) (setq newo 1000.0))
(setq new1 (getreal (strcat "\nNhap ty le ban ve 1/ <" (rtos newo) ">:ok [enter] or: ")))
(if (null new1) (setq new1 newo) (setq newo new1))
(setq tyle newo)
(setq dgoc (getpoint "\nChon diem goc cao do: "))
(setq cdg (getreal "\nNhap vao cao do goc: "))
(setq tp (getint "\nNhap vao so chu so thap phan: "))
)
;;;;;;;;;;---------------------------------
(defun C:ccd( / )
(setq i 1 n 100)
(while (< i n)
(setq dchon (getpoint "\nChon diem can tinh cao do: "))
(setq cddc (- cdg (* (/ 1 tyle) (- (cadr dgoc) (cadr dchon) )))	)
;(WriteRes1 cddc)  ;; De dien vao text cac text co san
(command "TEXT" dchon "" "" (rtos cddc 2 tp))  ;; De viet them text moi Ban dung 1 trong 2 truong hop nhe
(setq i (+ i 1))
)
(princ)
)

 

 

Bạn dùng lệnh KB để chọn điểm gốc và các thông số

Và lệnh CCD để chèn cao độ vào các vị trí mong muốn

Trong LISP có 2 options ghi vào text có sẵn hoặc chèn text bạn nhé

Dùng trường hợp nào thì bạn cho dấu ";" vào đầu dòng còn lại nhé và bỏ dấu ";" của dòng kia đi

Lưu ý: Nếu chèn text, bạn hãy tạo text style có sẵn chiều cao chữ như bạn muốn thì nó mới chạy ngon được bạn nhé

Thân,

thak bạn ATHAN trước nha!mình muốn chèn vào text đã có sẵn,mình thử làm như bạn hướng dẫn rồi nhưng chẳng được,bạn chỉnh giúp mình cái hoặc bạn hướng dẫn cụ thể hơn cái,mình chẳng biết gì về lips cả.mong bạn giúp.chúc bạn một này vui vẻ

[mathan 60]

thak bạn ATHAN trước nha!mình muốn chèn vào text đã có sẵn,mình thử làm như bạn hướng dẫn rồi nhưng chẳng được,bạn chỉnh giúp mình cái hoặc bạn hướng dẫn cụ thể hơn cái,mình chẳng biết gì về lips cả.mong bạn giúp.chúc bạn một này vui vẻ

Mình đã sửa lại một chút cho thuận tiện hơn

Bạn dùng thử nhé

;;;-----Free lisp code from CADViet.com - Edited by Mathan - From VECC
(defun CheckObj(e MyType) (equal (cdr (assoc 0 (entget e))) MyType))
;;;-----------------------------------------
(defun FilObj(ss1 MyType / ss2 i e)
(setq ss2 (ssadd) i 0)
(repeat (sslength ss1)
(setq e (ssname ss1 i) i (1+ i))
(if (CheckObj e MyType) (ssadd e ss2) )
)
(eval ss2)
)
;;;-----------------------------------------
(defun SelData( / OK)
(setq OK nil)
(while (not OK)
(prompt "\tChon text: ")
(setq ss (FilObj (ssget) "TEXT"))
(if (> (sslength ss) 0) (setq OK T) (princ "\nDoi tuong chon khong phai text"))
)
)
;;;-----------------------------------------
(defun WriteRes1(kq / OK e chen data txt)
(setq OK nil)
(while (not OK)
(if (null cheno) (setq cheno ""))
(setq chen (getstring (strcat "Text chen them vao phia truoc: an 1[+ enter] de nhan text( " cheno " ) hoac nhap text: ")))
(if (= chen "1") (setq chen cheno) (setq cheno chen))
(setq e (car (entsel "\nChon text ghi ket qua cao do: ")))
(if (CheckObj e "TEXT") (setq OK T) (princ "\nDoi tuong chon khong phai text"))
)
(setq txt (strcat chen (rtos kq 2 tp)))
(entmod (subst (cons 1 txt) (assoc 1 (setq data (entget e))) data))
(princ)
)
;;;-----------------------------------------
(defun C:kb( / new1 )
(if (null newo) (setq newo 1000.0))
(setq new1 (getreal (strcat "\nNhap ty le ban ve 1/ <" (rtos newo) ">:ok [enter] or: ")))
(if (null new1) (setq new1 newo) (setq newo new1))
(setq tyle newo)
(setq tp (getint "\nNhap vao so chu so thap phan: "))
(setq phuongan (getint "\nNhap vao goc phuong an chen vao text co san (1) hoac tao text moi (2): "))
(if (= phuongan 2)
  (progn
(setq caochu (getreal "\nNhap vao chieu cao chu: "))
(setq goctext (getreal "\nNhap vao goc ra chu: "))
)
)
)
;;;;;;;;;;---------------------------------
(defun C:ccd( / )
(setq dgoc (getpoint "\nChon diem goc cao do: "))
(setq cdg (getreal "\nNhap vao cao do goc: "))
(setq i 1 n 1000)
(while (< i n)
(setq dchon (getpoint "\nChon diem can tinh cao do: "))
(setq cddc (- cdg (* (/ 1 tyle) (- (cadr dgoc) (cadr dchon) )))	)
(if (= phuongan 1) (WriteRes1 cddc) )
(if (= phuongan 2) (command "TEXT" dchon caochu goctext (rtos cddc 2 tp)))
(setq i (+ i 1))
)
(princ)
)

Vẫn dùng lệnh KB để khai báo và CCD để chèn cao độ bạn nhé

Lưu ý:

Text bạn định chèn vào phải là TEXT chứ không phải là MTEXT bạn nhé, nếu là MTEXT thì bạn phải EXPLODE nó ra

Chèn vào text có sẵn bạn nhập phương án là 1 nhé.

Nếu không cần chèn thêm Text phía trước cao độ ghi ra thì bạn chỉ cần ENTER hoặc SPACE để bỏ qua thôi

[tvkill 1]

Mình đã sửa lại một chút cho thuận tiện hơn

Bạn dùng thử nhé

;;;-----Free lisp code from CADViet.com - Edited by Mathan - From VECC
(defun CheckObj(e MyType) (equal (cdr (assoc 0 (entget e))) MyType))
;;;-----------------------------------------
(defun FilObj(ss1 MyType / ss2 i e)
(setq ss2 (ssadd) i 0)
(repeat (sslength ss1)
(setq e (ssname ss1 i) i (1+ i))
(if (CheckObj e MyType) (ssadd e ss2) )
)
(eval ss2)
)
;;;-----------------------------------------
(defun SelData( / OK)
(setq OK nil)
(while (not OK)
(prompt "\tChon text: ")
(setq ss (FilObj (ssget) "TEXT"))
(if (> (sslength ss) 0) (setq OK T) (princ "\nDoi tuong chon khong phai text"))
)
)
;;;-----------------------------------------
(defun WriteRes1(kq / OK e chen data txt)
(setq OK nil)
(while (not OK)
(if (null cheno) (setq cheno ""))
(setq chen (getstring (strcat "Text chen them vao phia truoc: an 1[+ enter] de nhan text( " cheno " ) hoac nhap text: ")))
(if (= chen "1") (setq chen cheno) (setq cheno chen))
(setq e (car (entsel "\nChon text ghi ket qua cao do: ")))
(if (CheckObj e "TEXT") (setq OK T) (princ "\nDoi tuong chon khong phai text"))
)
(setq txt (strcat chen (rtos kq 2 tp)))
(entmod (subst (cons 1 txt) (assoc 1 (setq data (entget e))) data))
(princ)
)
;;;-----------------------------------------
(defun C:kb( / new1 )
(if (null newo) (setq newo 1000.0))
(setq new1 (getreal (strcat "\nNhap ty le ban ve 1/ <" (rtos newo) ">:ok [enter] or: ")))
(if (null new1) (setq new1 newo) (setq newo new1))
(setq tyle newo)
(setq tp (getint "\nNhap vao so chu so thap phan: "))
(setq phuongan (getint "\nNhap vao goc phuong an chen vao text co san (1) hoac tao text moi (2): "))
(if (= phuongan 2)
  (progn
(setq caochu (getreal "\nNhap vao chieu cao chu: "))
(setq goctext (getreal "\nNhap vao goc ra chu: "))
)
)
)
;;;;;;;;;;---------------------------------
(defun C:ccd( / )
(setq dgoc (getpoint "\nChon diem goc cao do: "))
(setq cdg (getreal "\nNhap vao cao do goc: "))
(setq i 1 n 1000)
(while (< i n)
(setq dchon (getpoint "\nChon diem can tinh cao do: "))
(setq cddc (- cdg (* (/ 1 tyle) (- (cadr dgoc) (cadr dchon) )))	)
(if (= phuongan 1) (WriteRes1 cddc) )
(if (= phuongan 2) (command "TEXT" dchon caochu goctext (rtos cddc 2 tp)))
(setq i (+ i 1))
)
(princ)
)

Vẫn dùng lệnh KB để khai báo và CCD để chèn cao độ bạn nhé

Lưu ý:

Text bạn định chèn vào phải là TEXT chứ không phải là MTEXT bạn nhé, nếu là MTEXT thì bạn phải EXPLODE nó ra

Chèn vào text có sẵn bạn nhập phương án là 1 nhé.

Nếu không cần chèn thêm Text phía trước cao độ ghi ra thì bạn chỉ cần ENTER hoặc SPACE để bỏ qua thôi

thak bạn nha!nhưng bạn có thể giúp mình là:

1.chỉ cần nhập một lần cao độ gốc không,->> để pick các điêm khác nữa

2.chi cho ra 1 phương án chon text cần sửa lại(giông như lệnh tính diện tích cho ra text có sẵn)

vì một mặt cắt ngang có đến gần chục điểm làm như thế cung lâu lắm bạn à,mong bạn giúp mình cái.

[mathan 60]

thak bạn nha!nhưng bạn có thể giúp mình là: 1.chỉ cần nhập mộ lần cao độ gốc không, để pick các điêm khác nữa

2.chi cho ra 1 phương án chon text cần sửa lại(giông như lệnh tính diện tích cho ra text có sẵn)

vì một mặt cắt ngang có đến gần chục điểm làm như thế cung lâu lắm bạn à,mong bạn giúp mình cái.

Bạn đã dùng thử chưa? Dùng rồi bạn sẽ thấy

Đánh KB: Chỉ cần khai báo một lần

Đánh CCD: thì cũng chỉ nhận điểm gốc một lần rồi pick bao nhiêu điểm là quền của bạn đấy thôi.

Nói chung bạn cứ dùng thử đi đã

[tvkill 1]

Bạn đã dùng thử chưa? Dùng rồi bạn sẽ thấy

Đánh KB: Chỉ cần khai báo một lần

Đánh CCD: thì cũng chỉ nhận điểm gốc một lần rồi pick bao nhiêu điểm là quền của bạn đấy thôi.

Nói chung bạn cứ dùng thử đi đã

Lúc trưa mình check chưa kĩ nên,hơi lúng túng trong việc thao tác lệnh,mình làm được rồi,nhanh hơn nhiều so với việc la thủ công.

Chân thành cắm ơn bạn mathan

mừng bạn cốc bia nhé. cherr-cạn nào!

[huanxd53 0]

Link bi die rồi.ai có post lên rùi e vs...thank nhiều

[Superlong 9]

lisp này có thể bổ sung thêm đo k/c tới tim luôn được không bạn kết quả xuất ra khi chèn điểm theo dạng " cao độ / khoảng cách "

[nttrung111191 0]

 

Chào toàn thể anh em trên diễn đàn. Bên mình đã viết một vài tiện ích hỗ trợ thiết kế, thi công công trình dạng tuyến, nhất là công trình cầu đường. Tiện ích Pick cắt ngang là một trong số những tiện ích như vậy. Thấy anh em đang trao đổi rất nhiệt tình về tiện ích này, mình xin chia sẻ với anh em tiện ích, link tải tiện ích bên dưới. Hy vọng có thể giúp được anh em bớt thao tác thủ công. Cám ơn anh em đã đọc comment của mình.

 

Tiện ích Pick cắt ngang

[phamthanhbinh 3.146]

Vào lúc 1/1/2018 tại 15:59, nttrung111191 đã nói:

 

Chào toàn thể anh em trên diễn đàn. Bên mình đã viết một vài tiện ích hỗ trợ thiết kế, thi công công trình dạng tuyến, nhất là công trình cầu đường. Tiện ích Pick cắt ngang là một trong số những tiện ích như vậy. Thấy anh em đang trao đổi rất nhiệt tình về tiện ích này, mình xin chia sẻ với anh em tiện ích, link tải tiện ích bên dưới. Hy vọng có thể giúp được anh em bớt thao tác thủ công. Cám ơn anh em đã đọc comment của mình.

 

Tiện ích Pick cắt ngang

Hề hề hề, đồ miễn phí có khác ......