Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
11 replies to this topic

#1 tvkill

tvkill

    biết vẽ ellipse

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

Đã gửi 31 May 2012 - 02:11 PM

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
  • 0

#2 quang_lac

quang_lac

    biết lệnh mirror

  • Members
  • PipPipPip
  • 151 Bài viết
Điểm đánh giá: 11 (tàm tạm)

Đã gửi 31 May 2012 - 02:39 PM

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

#3 mathan

mathan

    biết vẽ rectang

  • Members
  • PipPip
  • 83 Bài viết
Điểm đánh giá: 57 (tàm tạm)

Đã gửi 31 May 2012 - 02:42 PM

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,
  • 2
-----------
Hình đã gửi Hãy chia sẻ để thấy có được nhiều hơn điều mình muốn!
Best regard,

#4 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5682 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 31 May 2012 - 06:23 PM

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

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#5 tvkill

tvkill

    biết vẽ ellipse

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

Đã gửi 01 June 2012 - 12:21 PM

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
  • 0

#6 tvkill

tvkill

    biết vẽ ellipse

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

Đã gửi 01 June 2012 - 12:50 PM

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ẻ
  • 0

#7 mathan

mathan

    biết vẽ rectang

  • Members
  • PipPip
  • 83 Bài viết
Điểm đánh giá: 57 (tàm tạm)

Đã gửi 01 June 2012 - 12:55 PM

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
  • 0
-----------
Hình đã gửi Hãy chia sẻ để thấy có được nhiều hơn điều mình muốn!
Best regard,

#8 tvkill

tvkill

    biết vẽ ellipse

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

Đã gửi 01 June 2012 - 01:39 PM

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.
  • 0

#9 mathan

mathan

    biết vẽ rectang

  • Members
  • PipPip
  • 83 Bài viết
Điểm đánh giá: 57 (tàm tạm)

Đã gửi 01 June 2012 - 01:46 PM

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 đã
  • 1
-----------
Hình đã gửi Hãy chia sẻ để thấy có được nhiều hơn điều mình muốn!
Best regard,

#10 tvkill

tvkill

    biết vẽ ellipse

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

Đã gửi 01 June 2012 - 08:28 PM

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!
  • 0

#11 huanxd53

huanxd53

    Chưa sử dụng CAD

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

Đã gửi 08 December 2013 - 03:32 PM

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


  • 0

#12 Superlong

Superlong

    biết vẽ arc

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

Đã gửi 15 March 2016 - 05:10 PM

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 "


  • -1