Đến nội dung


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

Viết lisp theo yêu cầu [phần 2]


  • Chủ đề bị khóa Chủ đề bị khóa
3783 replies to this topic

#2041 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 29 September 2010 - 04:31 PM

Có phải code ở bài 2059 không ạ ?? E test ...chưa được phát nào.Tình trạng lúc nào cũng như thế này ạ :
Màu xanh là 2 đường có sẵn.Màu vàng là đường tròn e vẽ để lấy OA,OB..Còn màu đỏ là ết quả att chạy sau khi e chọn điểm tiếp xúc là A..Mà e cũng thấy lạ cơ.Code của bác,của bác Tue...e thử đều bị lỗi,chưa được cái nào ý.Hay cad e có vấn đề ??
Hình đã gửi

Lúc viết xong chạy ngon lành mà sao giờ test lại sai toé loe thế này hả trời. Híc híc
  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2042 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 29 September 2010 - 04:35 PM

Đúng là cái này dùng thủ công còn nhanh hơn dùng lisp.
Nó phân ra quá nhiều trường hợp. Trong hàm đặt quá nhiều điều kiện. Mình đã đặt thế này rồi mà vẫn thiếu lúc thì đúng lúc thì sai. Thật đau cái đầu.

Mình thấy bạn cũng giống như bạn phamthanhbinh cách đây vài năm là
mặc dù chưa biết nhiều về lisp nhưng vẫn tích cực viết chương trình.
Mặc dù bạn Tue_NV đã viết rồi nhưng mình cũng sửa lại code của bạn với vài góp ý sau:
- Vẽ ARC có nhiều cách, ta tìm cách nào dễ tính toán là được. Trong lisp này mình chọn (Start, End, Direction)
- Cho hẳn điểm P1 nằm trên đường thứ nhất, P2 nằm trên đường thứ hai thì sẽ bớt nhiều phép so sánh.
- Hạn chế dùng biến GLOBAL, chỉ dùng khi cần thiết.
Các dòng comment là code đầy đủ của tính toán P1&P2 , bạn xem sẽ thấy dễ hiểu hơn
(defun c:ptt ( / ss pg1 pg2 pg3 pg4 p1 p2 giao d om)

(setq ss (ssget '((0 . "line")))
pg1 (cdr (assoc 10 (entget (ssname ss 0))))
pg2 (cdr (assoc 11 (entget (ssname ss 0))))
pg3 (cdr (assoc 10 (entget (ssname ss 1))))
pg4 (cdr (assoc 11 (entget (ssname ss 1))))
p1 (getpoint "\nchon diem tiep xuc thu nhat:")
giao (inters pg1 pg2 pg3 pg4 nil)
d (distance giao p1)
om (getvar "osmode")
)
(setvar "osmode" 0)

;;; (if (equal giao pg1 1.e-8)
;;; (setq ang1 (angle giao pg2))
;;; (setq ang1 (angle giao pg1))
;;; )
;;; (setq p1 (polar giao ang1 d))
;;;
;;; (if (equal giao pg3 1.e-8)
;;; (setq ang2 (angle giao pg4))
;;; (setq ang2 (angle giao pg3))
;;; )
;;; (setq p2 (polar giao ang2 d))

(setq p1 (polar giao (angle giao (if (equal giao pg1 1.e-8)pg2 pg1)) d))
(setq p2 (polar giao (angle giao (if (equal giao pg3 1.e-8)pg4 pg3)) d))

(command "arc" p1 "e" p2 "d" giao)
(setvar "osmode" om)
)

  • 1

#2043 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 29 September 2010 - 04:47 PM

[quote name='ndtnv' post='110157' date='Sep 29 2010, 16:35']Mình thấy bạn cũng giống như bạn phamthanhbinh cách đây vài năm là
mặc dù chưa biết nhiều về lisp nhưng vẫn tích cực viết chương trình.
Mặc dù bạn Tue_NV đã viết rồi nhưng mình cũng sửa lại code của bạn với vài góp ý sau:
- Vẽ ARC có nhiều cách, ta tìm cách nào dễ tính toán là được. Trong lisp này mình chọn (Start, End, Direction)
- Cho hẳn điểm P1 nằm trên đường thứ nhất, P2 nằm trên đường thứ hai thì sẽ bớt nhiều phép so sánh.
- Hạn chế dùng biến GLOBAL, chỉ dùng khi cần thiết.
Các dòng comment là code đầy đủ của tính toán P1&P2 , bạn xem sẽ thấy dễ hiểu hơn

;; free lisp from cadviet.com
(defun c:att ()
(setq ss (ssget '((0 . "line")))
pg1 (cdr (assoc 10 (entget (ssname ss 0))))
pg2 (cdr (assoc 11 (entget (ssname ss 0))))
pg3 (cdr (assoc 10 (entget (ssname ss 1))))
pg4 (cdr (assoc 11 (entget (ssname ss 1))))
p1 (getpoint "\nchon diem tiep xuc thu nhat:")
giao (inters pg1 pg2 pg3 pg4)
)
(if (equal giao pg1 1)
(setq ang1 (angle giao pg2))
(setq ang1 (angle giao pg1))
)
(if (equal giao pg3 1)
(setq ang2 (angle giao pg4))
(setq ang2 (angle giao pg3))
)
(if (equal (angtos (angle giao p1)) (angtos ang1) 1)
(setq p2 (polar giao ang2 (distance giao p1)))
(setq p2 (polar giao ang1 (distance giao p1)))
)
(command "arc" p1 "e" p2 "d" giao)
)

  • 1
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2044 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 29 September 2010 - 07:13 PM

Đúng là mình tìm ra lỗi rồi với hàm equal thì phải cho tham số chính xác nếu không có thì nhiều trường hợp sẽ báo nil
code này đã sửa rồi và test thấy đúng không biết chạy trên máy kác thì thế nào. Cám ơn bạn đã giúp mình nhưng nhờ gợi ý của bác Tue_VN mà mình đã tìm ra rôi. Vì mình không được học cad từ cơ bản nên mới thế này đây


;; free lisp from cadviet.com
(defun c:att ()
(setq ss (ssget '((0 . "line")))
pg1 (cdr (assoc 10 (entget (ssname ss 0))))
pg2 (cdr (assoc 11 (entget (ssname ss 0))))
pg3 (cdr (assoc 10 (entget (ssname ss 1))))
pg4 (cdr (assoc 11 (entget (ssname ss 1))))
p1 (getpoint "\nchon diem tiep xuc thu nhat:")
giao (inters pg1 pg2 pg3 pg4)
)
(if (equal giao pg1 1)
(setq ang1 (angle giao pg2))
(setq ang1 (angle giao pg1))
)
(if (equal giao pg3 1)
(setq ang2 (angle giao pg4))
(setq ang2 (angle giao pg3))
)
(if (equal (angtos (angle giao p1)) (angtos ang1) 1)
(setq p2 (polar giao ang2 (distance giao p1)))
(setq p2 (polar giao ang1 (distance giao p1)))
)
(command "arc" p1 "e" p2 "d" giao)
)

Chúc mừng bạn PhamngocTukts hết bị đau đầu :( Bạn đã giải ra câu đố của Tue_NV rồi đấy
..............

@Anh TUE và anh BÌNH cho em hỏi với, sao cùng 1 file cad mà 2 lisp của 2 anh cho ra 2 bảng thống kê khác nhau và khác cả bảng thống kê em làm bằng excel luôn, em gửi file CAD đính kèm nhờ các anh kiểm tra lại giúp em với nhen! (Em ko có ý so sánh 2 lisp của 2 anh viết, vì cùng 1 nội dung mà được 2 cao thủ như 2 anh giúp là niềm vinh hạnh của em)
Cảm ơn 2 anh nhiều!
http://www.cadviet.c...s/3/testnew.dwg

Chào truongthanh
Sorry em, anh đã fix lỗi ở Bài viết số 2018. Em chạy thử nhá
Chúc mọi người vui vẻ
Thân ái
  • 1

#2045 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 29 September 2010 - 07:47 PM

Chào bạn Truongthanh,
Sở dĩ cái kết quả cửa lisp do mình viết khác với cái kết quả mà bạn làm bằng Excel là do thằng cu này đây:
"Ø800 - L120- i1.25"
Do cấu trúc text của bạn bị sai (thiếu một khoảng trắng giữa các ký tự chỉ chiều dài và dấu gạch ngang) nên lisp nó đọc kết quả bị sai. Thay vì phải là 120 thì nó chỉ đọc được là 12.
Vì thế nên hai kết quả chênh lệch nhau đúng 108 đơn vị bạn ạ.
Còn cái vụ tại sao bạn chạy lisp thì nó lại vẽ thiếu đường line thì mình đoán là do các biến hễ thống của bạn mà thôi. Bởi vì mình chạy thì nó vẫn ra kết quả ngon lành. Bạn xem đây, không phải chỉ một lần chạy mà chạy rất nhiều lần . Có khác chăng chỉ là cái text nó không ra tiếng Việt là do nó sử dụng style khác mà thôi.
http://www.cadviet.c...truongthanh.jpg

Mình sẽ kiểm tra lại cái style này để cho nó hiển thị đúng.

Và đây là cái kết quả chạy ra sau khi mình đã sửa cái text sai của bạn cho đúng cấu trúc như mình đã mô tả ở bài trước.

Trang upload của diễn đàn trục trặc nên mình không upload ảnh cho bạn thấy được. Mình sẽ upload sau vậy. Bạn cứ thử sửa lại cái text đó và chạy lại xem nhé.


Do không biết cái style bạn thường dùng cho các bản vẽ này nên mình không bổ sung phần tạo style cho text nữa. Tỷ như trong bản vẽ testnew.dwg mà bạn gửi sau cùng thì nếu bạn bổ sung thêm (cons 7 "1") vào các dòng code (enmake (list (cons 0 "TEXT") ....... ) ) để thành (enmake (list (cons 0 "TEXT") ....... (cons 7 "1") ) ) Thì nó sẽ hiển thị đúng tiếng Việt vì trong bản vẽ này bạn sử dụng style có tên là "1" cho các text tiếng Việt bạn ạ.
Còn trong bản vẽ Bang_thong_ke.dwg bạn gửi lần trứơc thì bạn lại dùng style có tên là "ahs-Arial". Khi đó bạn phải thay (cons 7 "1" ) bằng (cons 7 "ahs-Arial") hoặc bạn phải bổ sung cái Style "1" này vào bản vẽ của bạn bạn nhé.

Chúc bạn vui.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2046 truongthanh

truongthanh

    biết lệnh text

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

Đã gửi 29 September 2010 - 08:40 PM

Do không biết cái style bạn thường dùng cho các bản vẽ này nên mình không bổ sung phần tạo style cho text nữa. Tỷ như trong bản vẽ testnew.dwg mà bạn gửi sau cùng thì nếu bạn bổ sung thêm (cons 7 "1") vào các dòng code (enmake (list (cons 0 "TEXT") ....... ) ) để thành (enmake (list (cons 0 "TEXT") ....... (cons 7 "1") ) ) Thì nó sẽ hiển thị đúng tiếng Việt vì trong bản vẽ này bạn sử dụng style có tên là "1" cho các text tiếng Việt bạn ạ.
Còn trong bản vẽ Bang_thong_ke.dwg bạn gửi lần trứơc thì bạn lại dùng style có tên là "ahs-Arial". Khi đó bạn phải thay (cons 7 "1" ) bằng (cons 7 "ahs-Arial") hoặc bạn phải bổ sung cái Style "1" này vào bản vẽ của bạn bạn nhé.

Chúc bạn vui.

cảm ơn anh!Em hiểu rồi ạ!Thanks anh nhiều!
  • 0

#2047 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 29 September 2010 - 10:53 PM

cảm ơn anh!Em hiểu rồi ạ!Thanks anh nhiều!

Chào bạn Truongthanh,
Mình bổ sung đoạn code check style vào trong lisp này. Khi chạy nó sẽ tự kiểm tra xem trong bản vẽ của bạn đã có style "1" hay chưa. Nếu chưa có nó sẽ tạo style "1" giống như cái style "1" mà bạn đang sử dụng trong bản vẽ testnew.dwg. Và như vậy kết quả sẽ luôn hiện tiếng Việt như bạn mong muốn.
Bạn phải cảnh giác nếu như trên file bản vẽ của bạn đã có style "1" nhưng nó lại không phải là font Arial.tif thì text sẽ hiển thị không đúng đâu nhé. Vì thế nên kiểm tra kỹ font text trước khi chạy lisp bạn nhé.
Lisp đây:


(defun c:tktxt ( / ss n i tnlst cnlst tn cn)
(setq ss (ssget (list (cons 0 "text")))
n (sslength ss)
i 0
tnlst (list)
cnlst (list)
)
(while (< i n)
(setq en (ssname ss i)
els (entget en)
txt (cdr (assoc 1 els))
)
(if (= (substr txt 1 1) (chr 216))
(if (wcmatch txt "*-*-*")
(setq tnlst (append tnlst (list txt)))
(setq cnlst (append cnlst (list txt)))
)
)
(setq i (1+ i))
)
(setq cn (strcase (getstring "\n Ban muon thong ke duong ong cap nuoc (y or n): ")))
(if (= cn "Y")
(progn
(chst "1")
(setq pt (getpoint "\n Chon diem dat bang" ))
(setq prtxt "\\U+1ED0NG NH\\U+1EF0A uPVC ")
(crtbl pt)
(seplst cnlst pt)
)
)
(setq tn (strcase (getstring "\n Ban muon thong ke duong ong thoat nuoc (y or n): ")))
(if (= tn "Y")
(progn
(chst "1")
(setq pt (getpoint "\n Chon diem dat bang" ))
(setq prtxt "C\\U+1ED0NG BTCT ")
(crtbl pt)
(seplst tnlst pt)
)
)

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun seplst ( lst p1 / lst1 lst2 lst3 tdd lo p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 cnt )
(setq cnt 0)
(while (/= lst nil)
(setq chuoi (nth 0 lst))
(tach chuoi)
(setq a t1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;(substr (nth 0 lst) 1 4)
lst1 (cdr lst)
lst2 nil
tdd 0
lst2 (append lst2 (list (nth 0 lst)))
)
(foreach b lst1
(tach b )
(if (= t1 a)
(setq lst2 (append lst2 (list b )))
(setq lst3 (append lst3 (list b )))
)
)
(foreach c lst2
(tach c )
(setq tdd (+ tdd (atof t2))
lo t1
)
)
(alert (strcat "\n Tong do dai ong " lo " la " (rtos tdd 2 ) ))
(setq lst lst3
lst3 nil
cnt (1+ cnt)
)
(setq p2 (polar p1 (- (/ pi 2)) (* cnt 5))
p3 (polar p2 0 8)
p4 (polar p3 0 44)
p5 (polar p4 0 20)
p6 (polar p5 0 13)
p7 (polar p2 (- (/ pi 2)) 5)
p8 (polar p3 (- (/ pi 2)) 5)
p9 (polar p4 (- (/ pi 2)) 5)
p10 (polar p5 (- (/ pi 2)) 5)
p11 (polar p6 (- (/ pi 2)) 5)
)
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p7) 2) (+ (cadr p7) 1) ))
(cons 1 (rtos cnt 2 0)) (cons 8 "ahs-tnt-text") (cons 7 "1") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p8) 2) (+ (cadr p7) 1) ))
(cons 1 (strcat prtxt lo)) (cons 8 "ahs-tnt-text") (cons 7 "1") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p9) 4) (+ (cadr p7) 1) ))
(cons 1 (rtos tdd 2 0)) (cons 8 "ahs-tnt-text") (cons 7 "1") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p10) 5) (+ (cadr p7) 1) ))
(cons 1 "m") (cons 8 "ahs-tnt-text") (cons 7 "1") ) )
(command "pline" p2 p7 p11 p6 "")
(command "pline" p3 p8 "")
(command "pline" p4 p9 "")
(command "pline" p5 p10 "")
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun crtbl ( p1 / p2 p3 p4 p5 p6 p7 p8 p9 p10 p11)
(setq p2 (list (+ (car p1) 12.5) (+ (cadr p1) 2))
p3 (polar p1 0 8)
p4 (polar p3 0 44)
p5 (polar p4 0 20)
p6 (polar p5 0 13)
p7 (polar p1 (- (/ pi 2)) 5)
p8 (polar p3 (- (/ pi 2)) 5)
p9 (polar p4 (- (/ pi 2)) 5)
p10 (polar p5 (- (/ pi 2)) 5)
p11 (polar p6 (- (/ pi 2)) 5)
)
(entmake (list (cons 0 "TEXT") (cons 40 3) (cons 50 0) (cons 10 p2) (cons 7 "1")
(cons 1 "%%UB\\U+1EA2NG T\\U+1ED4NG H\\U+1EE2P KH\\U+1ED0I L\\U+01AF\\U+1EE2NG")
(cons 8 "ahs-tnt-text") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p7) 2) (+ (cadr p7) 1) ))
(cons 1 "TT") (cons 8 "ahs-tnt-text") (cons 7 "1") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p8) 14) (+ (cadr p7) 1) ))
(cons 1 "H\\U+1EA0NG M\\U+1EE4C") (cons 8 "ahs-tnt-text") (cons 7 "1") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p9) 1) (+ (cadr p7) 1) ))
(cons 1 "KH\\U+1ED0I L\\U+01AF\\U+1EE2NG") (cons 8 "ahs-tnt-text") (cons 7 "1") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p10) 2) (+ (cadr p7) 1) ))
(cons 1 "\\U+0110\\U+01A0N V\\U+1ECA") (cons 8 "ahs-tnt-text") (cons 7 "1") ) )
(command "pline" p1 p6 p11 p7 p1 "")
(command "pline" p3 p8 "")
(command "pline" p4 p9 "")
(command "pline" p5 p10 "")

)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun tach (txt / i n k m )
(setq i 1
n (strlen txt)
k nil
)
(while (<= i n)
(setq kt (substr txt i 1))
(if (= kt "-")
(progn
(setq k i
i n)
)
)
(setq i (1+ i))
)
(if k
(progn
(setq t1 (substr txt 1 (- k 2))
t2 (substr txt (+ k 3) n)
)
(setq n (strlen t2)
i 1
m nil
)
(while (<= i n)
(setq kt (substr t2 i 1))
(if (= kt "-")
(progn
(setq m i
i n)
)
)
(setq i (1+ i))
)
(if m
(setq t2 (substr t2 1 (- m 2)))
)
)
)

)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun chst (name )
;;;;;;;;(setq name (getstring t "\n Nhap ten style: "))
(if (= (tblsearch "style" name) nil)
(command "style" name "arial" "" 0.8 "" "" "" )
)
)


Hy vọng bạn sẽ hài lòng.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2048 tamkt

tamkt

    biết vẽ ellipse

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

Đã gửi 30 September 2010 - 12:32 AM

Cho em hỏi có cách nào thay đổi chiều dài 1 đoạn thẳng có sẵn bằng 1 lệnh ko ah?

Ví dụ:
- có 1 đường thẳng bất kỳ ( ví dụ dài 1590mm)
- Nhập lệnh Autolisp (ví dụ là lệnh td chẳng hạn )
- Chọn đường thẳng
- Chọn điểm gốc
- Nhập chiều dài cần thay đổi ( ví dụ là 2000 hay 1000 chẳng hạn) thì đường thẳng đó tự động dài ra thành 2000 hay ngắn lại theo số liệu mình nhập.

Em cám ơn nhiều.
  • 0

#2049 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 30 September 2010 - 12:46 AM

Cho em hỏi có cách nào thay đổi chiều dài 1 đoạn thẳng có sẵn bằng 1 lệnh ko ah?

Ví dụ:
- có 1 đường thẳng bất kỳ ( ví dụ dài 1590mm)
- Nhập lệnh Autolisp (ví dụ là lệnh td chẳng hạn )
- Chọn đường thẳng
- Chọn điểm gốc
- Nhập chiều dài cần thay đổi ( ví dụ là 2000 hay 1000 chẳng hạn) thì đường thẳng đó tự động dài ra thành 2000 hay ngắn lại theo số liệu mình nhập.

Em cám ơn nhiều.

Cái này đơn giản nhất quả đất.
Gõ lệnh scale chọn đoạn thẳng chọn điểm gốc xong gõ 2000/1590 để được đoạn 2000 hoặc 1000/1590 để được đoạn 1000. Chúc bạn vui.
  • 1
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2050 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 30 September 2010 - 06:23 AM

Cái này đơn giản nhất quả đất.
Gõ lệnh scale chọn đoạn thẳng chọn điểm gốc xong gõ 2000/1590 để được đoạn 2000 hoặc 1000/1590 để được đoạn 1000. Chúc bạn vui.

Nếu có nhiều đoạn thẳng cần thay đổi như vậy thì nên sử dụng lệnh Len
  • 2

#2051 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1432 Bài viết
Điểm đánh giá: 1425 (rất tốt)

Đã gửi 30 September 2010 - 06:55 AM

Mình thấy bạn cũng giống như bạn phamthanhbinh cách đây vài năm là
mặc dù chưa biết nhiều về lisp nhưng vẫn tích cực viết chương trình.
Mặc dù bạn Tue_NV đã viết rồi nhưng mình cũng sửa lại code của bạn với vài góp ý sau:
- Vẽ ARC có nhiều cách, ta tìm cách nào dễ tính toán là được. Trong lisp này mình chọn (Start, End, Direction)
- Cho hẳn điểm P1 nằm trên đường thứ nhất, P2 nằm trên đường thứ hai thì sẽ bớt nhiều phép so sánh.
- Hạn chế dùng biến GLOBAL, chỉ dùng khi cần thiết.
Các dòng comment là code đầy đủ của tính toán P1&P2 , bạn xem sẽ thấy dễ hiểu hơn

(defun c:ptt ( / ss pg1 pg2 pg3 pg4 p1 p2 giao d om)	
(setq ss (ssget '((0 . "line")))
pg1 (cdr (assoc 10 (entget (ssname ss 0))))
pg2 (cdr (assoc 11 (entget (ssname ss 0))))
pg3 (cdr (assoc 10 (entget (ssname ss 1))))
pg4 (cdr (assoc 11 (entget (ssname ss 1))))
p1 (getpoint "\nchon diem tiep xuc thu nhat:")
giao (inters pg1 pg2 pg3 pg4 nil)
d (distance giao p1)
om (getvar "osmode")
)
(setvar "osmode" 0)
;;;....
(setq p1 (polar giao (angle giao (if (equal giao pg1 1.e-8)pg2 pg1)) d))
(setq p2 (polar giao (angle giao (if (equal giao pg3 1.e-8)pg4 pg3)) d))

(command "arc" p1 "e" p2 "d" giao)
(setvar "osmode" om)
)

Dòng này hơi bị dư ?
(setq p1 (polar giao (angle giao (if (equal giao pg1 1.e-8)pg2 pg1)) d))
Điểm p1 là số liệu đầu vào.
  • 0

#2052 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 30 September 2010 - 07:25 AM

Dòng này hơi bị dư ?
(setq p1 (polar giao (angle giao (if (equal giao pg1 1.e-8)pg2 pg1)) d))
Điểm p1 là số liệu đầu vào.

Dòng đó không bị dư đâu vì nếu không thì tìm P2 lại phêm 1 phép so sánh để chọn đường thẳng còn lại.
Ngược lại nó còn fix lỗi khi chọn điểm P1 không trùng hoàn toàn trên 1 trong 2 đường thẳng nữa

Đúng là mình tìm ra lỗi rồi với hàm equal thì phải cho tham số chính xác nếu không có thì nhiều trường hợp sẽ báo nil
code này đã sửa rồi và test thấy đúng không biết chạy trên máy kác thì thế nào. Cám ơn bạn đã giúp mình nhưng nhờ gợi ý của bác Tue_VN mà mình đã tìm ra rôi. Vì mình không được học cad từ cơ bản nên mới thế này đây

Bạn thử lại khi trong bản vẽ có OSMODE khác 0 xem

Chào bạn Truongthanh,
Sở dĩ cái kết quả cửa lisp do mình viết khác với cái kết quả mà bạn làm bằng Excel là do thằng cu này đây:
"Ø800 - L120- i1.25"
Do cấu trúc text của bạn bị sai (thiếu một khoảng trắng giữa các ký tự chỉ chiều dài và dấu gạch ngang) nên lisp nó đọc kết quả bị sai. Thay vì phải là 120 thì nó chỉ đọc được là 12.
Vì thế nên hai kết quả chênh lệch nhau đúng 108 đơn vị bạn ạ.
Còn cái vụ tại sao bạn chạy lisp thì nó lại vẽ thiếu đường line thì mình đoán là do các biến hễ thống của bạn mà thôi. Bởi vì mình chạy thì nó vẫn ra kết quả ngon lành. Bạn xem đây, không phải chỉ một lần chạy mà chạy rất nhiều lần . Có khác chăng chỉ là cái text nó không ra tiếng Việt là do nó sử dụng style khác mà thôi.
http://www.cadviet.c...truongthanh.jpg

Mình sẽ kiểm tra lại cái style này để cho nó hiển thị đúng.

Và đây là cái kết quả chạy ra sau khi mình đã sửa cái text sai của bạn cho đúng cấu trúc như mình đã mô tả ở bài trước.

Trang upload của diễn đàn trục trặc nên mình không upload ảnh cho bạn thấy được. Mình sẽ upload sau vậy. Bạn cứ thử sửa lại cái text đó và chạy lại xem nhé.

Bạn dùng hàm vl-string-subst để loại bớt các ký tự Ø,L,i và dấu cách trong "Ø800 - L120- i1.25"
sau đó dùng hàm (setq ls (ACET-STR-TO-LIST "-" string)) là sẽ được 1 list (800 120 1.25) mà không cần biết là 3 hay 4 chữ số
  • 3

#2053 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1432 Bài viết
Điểm đánh giá: 1425 (rất tốt)

Đã gửi 30 September 2010 - 03:02 PM

Dòng đó không bị dư đâu vì nếu không thì tìm P2 lại phêm 1 phép so sánh để chọn đường thẳng còn lại.
Ngược lại nó còn fix lỗi khi chọn điểm P1 không trùng hoàn toàn trên 1 trong 2 đường thẳng nữa
.....................

Bác giải thích chưa thuyết phục ! (câu này mới "mót" được)
- "1 phép so sánh" so với 4 lệnh của đoạn (polar giao (angle giao (if (equal giao pg1 1.e-8)pg2 pg1)) d) chắc là lớn hơn ?

- "khi chọn điểm P1 không trùng hoàn toàn trên 1 trong 2 đường thẳng" thì dòng tính khoảng cách "(distance giao p1)" (dùng để tính p1 và p2) cho sai số là bao nhiêu ?
  • 1

#2054 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 30 September 2010 - 04:34 PM

Bác giải thích chưa thuyết phục ! (câu này mới "mót" được)
- "1 phép so sánh" so với 4 lệnh của đoạn (polar giao (angle giao (if (equal giao pg1 1.e-8)pg2 pg1)) d) chắc là lớn hơn ?

- "khi chọn điểm P1 không trùng hoàn toàn trên 1 trong 2 đường thẳng" thì dòng tính khoảng cách "(distance giao p1)" (dùng để tính p1 và p2) cho sai số là bao nhiêu ?

Nếu không gán P1 thì code sẽ là
(setq ang1 (angle giao (if (equal giao pg1 1.e-8) pg2 pg1)))
(setq ang2 (angle giao (if (equal giao pg3 1.e-8) pg4 pg3)))
(setq p2 (polar giao (if (equal (angle giao p1) ang1 1.e-8) ang2 ang1) d))

So sánh thì cách đầu nhiều hơn 1 lệnh polar nhưng ít hơn 1 lệnh angle, ít hơn 1 phép so sánh
Sai số là (1-cos), là 1 vô cùng bé bậc 2 của góc lệch của (giao P1) và đường thẳng.
PS: Mình viết code này và post lên rồi mới thấy là cách làm cũng giống như của bạn Tue_NV
là không dùng điểm P1 và cách vẽ ARC, còn đố vui thì mình cũng chưa đọc
  • 2

#2055 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 30 September 2010 - 05:45 PM

Dòng đó không bị dư đâu vì nếu không thì tìm P2 lại phêm 1 phép so sánh để chọn đường thẳng còn lại.
Ngược lại nó còn fix lỗi khi chọn điểm P1 không trùng hoàn toàn trên 1 trong 2 đường thẳng nữa

Bạn thử lại khi trong bản vẽ có OSMODE khác 0 xem

Bạn dùng hàm vl-string-subst để loại bớt các ký tự Ø,L,i và dấu cách trong "Ø800 - L120- i1.25"
sau đó dùng hàm (setq ls (ACET-STR-TO-LIST "-" string)) là sẽ được 1 list (800 120 1.25) mà không cần biết là 3 hay 4 chữ số

Chào các bác,
Với góp ý của bác ndtnv, mình lọ mọ đọc lại các hàm vl-string-?????? và liều mạng làm thử lại cái lisp đã gửi bạn Truongthanh thì thấy ra được cái lisp mới như sau:

(defun c:tktxt ( / ss n i tnlst cnlst tn cn)
(vl-load-com)
(setq ss (ssget (list (cons 0 "text")))
n (sslength ss)
i 0
tnlst (list)
cnlst (list)
)
(while (< i n)
(setq en (ssname ss i)
els (entget en)
txt (cdr (assoc 1 els))
)
(if (= (substr txt 1 1) (chr 216))
(if (wcmatch txt "*-*-*")
(setq tnlst (append tnlst (list txt)))
(setq cnlst (append cnlst (list txt)))
)
)
(setq i (1+ i))
)
(setq cn (strcase (getstring "\n Ban muon thong ke duong ong cap nuoc (y or n): ")))
(if (= cn "Y")
(progn
(chst "1")
(setq pt (getpoint "\n Chon diem dat bang" ))
(setq prtxt "\\U+1ED0NG NH\\U+1EF0A uPVC ")
(crtbl pt)
(seplst cnlst pt)
)
)
(setq tn (strcase (getstring "\n Ban muon thong ke duong ong thoat nuoc (y or n): ")))
(if (= tn "Y")
(progn
(chst "1")
(setq pt (getpoint "\n Chon diem dat bang" ))
(setq prtxt "C\\U+1ED0NG BTCT ")
(crtbl pt)
(seplst tnlst pt)
)
)

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun seplst ( lst p1 / lst1 lst2 lst3 tdd lo p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 cnt )
(setq cnt 0)
(while (/= lst nil)
(setq chuoi (car (txtfil (nth 0 lst)))
lst1 (cdr lst)
lst2 nil
tdd 0
lst2 (append lst2 (list (nth 0 lst)))
)
(foreach b lst1
(if (= (car (txtfil b )) chuoi)
(setq lst2 (append lst2 (list b )))
(setq lst3 (append lst3 (list b )))
)
)
(foreach c lst2
(setq tdd (+ tdd (atof (cadr (txtfil c))))
lo (car (txtfil c ))
)
)
(alert (strcat "\n Tong do dai ong " lo " la " (rtos tdd 2 ) ))
(setq lst lst3
lst3 nil
cnt (1+ cnt)
)
(setq p2 (polar p1 (- (/ pi 2)) (* cnt 5))
p3 (polar p2 0 8)
p4 (polar p3 0 44)
p5 (polar p4 0 20)
p6 (polar p5 0 13)
p7 (polar p2 (- (/ pi 2)) 5)
p8 (polar p3 (- (/ pi 2)) 5)
p9 (polar p4 (- (/ pi 2)) 5)
p10 (polar p5 (- (/ pi 2)) 5)
p11 (polar p6 (- (/ pi 2)) 5)
)
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p7) 2) (+ (cadr p7) 1) ))
(cons 1 (rtos cnt 2 0)) (cons 8 "ahs-tnt-text") (cons 7 "1") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p8) 2) (+ (cadr p7) 1) ))
(cons 1 (strcat prtxt lo)) (cons 8 "ahs-tnt-text") (cons 7 "1") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p9) 4) (+ (cadr p7) 1) ))
(cons 1 (rtos tdd 2 0)) (cons 8 "ahs-tnt-text") (cons 7 "1") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p10) 5) (+ (cadr p7) 1) ))
(cons 1 "m") (cons 8 "ahs-tnt-text") (cons 7 "1") ) )
(command "pline" p2 p7 p11 p6 "")
(command "pline" p3 p8 "")
(command "pline" p4 p9 "")
(command "pline" p5 p10 "")
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun crtbl ( p1 / p2 p3 p4 p5 p6 p7 p8 p9 p10 p11)
(setq p2 (list (+ (car p1) 12.5) (+ (cadr p1) 2))
p3 (polar p1 0 8)
p4 (polar p3 0 44)
p5 (polar p4 0 20)
p6 (polar p5 0 13)
p7 (polar p1 (- (/ pi 2)) 5)
p8 (polar p3 (- (/ pi 2)) 5)
p9 (polar p4 (- (/ pi 2)) 5)
p10 (polar p5 (- (/ pi 2)) 5)
p11 (polar p6 (- (/ pi 2)) 5)
)
(entmake (list (cons 0 "TEXT") (cons 40 3) (cons 50 0) (cons 10 p2)
(cons 1 "%%UB\\U+1EA2NG T\\U+1ED4NG H\\U+1EE2P KH\\U+1ED0I L\\U+01AF\\U+1EE2NG")
(cons 8 "ahs-tnt-text") (cons 7 "1") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p7) 2) (+ (cadr p7) 1) ))
(cons 1 "TT") (cons 8 "ahs-tnt-text") (cons 7 "1") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p8) 14) (+ (cadr p7) 1) ))
(cons 1 "H\\U+1EA0NG M\\U+1EE4C") (cons 8 "ahs-tnt-text") (cons 7 "1") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p9) 1) (+ (cadr p7) 1) ))
(cons 1 "KH\\U+1ED0I L\\U+01AF\\U+1EE2NG") (cons 8 "ahs-tnt-text") (cons 7 "1") ) )
(entmake (list (cons 0 "TEXT") (cons 40 2) (cons 50 0) (cons 10 (list (+ (car p10) 2) (+ (cadr p7) 1) ))
(cons 1 "\\U+0110\\U+01A0N V\\U+1ECA") (cons 8 "ahs-tnt-text") (cons 7 "1") ) )
(command "pline" p1 p6 p11 p7 p1 "")
(command "pline" p3 p8 "")
(command "pline" p4 p9 "")
(command "pline" p5 p10 "")

)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun txtfil ( txt / n i)

(setq ;;;;;;;;;;;;;;;;;;;;;;;;;; txt (cdr(assoc 1 (entget(car(entsel)))))
n (strlen txt)
i 1
)
(while (<= i n)
(setq a (substr txt i 1))
(if (or (= a "L") (= a "i") (= a " "))
(progn
(setq txt (vl-string-subst "" a txt)
i (1- i)
n (1- n)
)
)
)
(setq i (1+ i))
)
(setq txt (acet-str-to-list "-" txt))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun chst (name )
;;;;;;;;(setq name (getstring t "\n Nhap ten style: "))
(if (= (tblsearch "style" name) nil)
(command "style" name "arial" "" 0.8 "" "" "" )
)
)



Về cơ bản vẫn cho ra kết quả giống hệt cái lisp cũ và khi mình xài cái hàm testtime của bác Giabach để test thử tốc độ chạy của hai cái lisp cũ và mới thì thấy kết quả cũng gần gần như nhau nếu bỏ qua sai số do người thao tác (tốc độ pick chuột ấy mà).
Vậy nên việc dùng cái nào thì tùy bác Truongthanh lựa chọn. Tuy nhiên cái lisp thứ hai này có vẻ như oai hơn vì nó có xài mấy thằng vl-?????. Hề hề hề.
Thế là cũng vọc thêm được một tí về các hàm vl-string-???? , cho dù chưa kỹ lắm nhưng cũng đã biết xài. Hề hề hề ..... Khoái, khoái, khoái........

PS: Cái lisp thứ hai này thì nó chạy chấp luôn cả cái lỗi nhập thiếu khoảng trắng trong text của bạn truongthanh như trường hợp vừa rồi bạn ạ. Hề hề hề. Chỉ cần bạn nhập đúng các ký tự đường kính và chiều dài cũng như gạch nối và ký tự độ dốc.
Tuy nhiên dù dùng lisp nào thì bạn cũng vẫn nên nhập text cho chuẩn mực vì như vậy bản vẽ mới đẹp và thống nhất bạn ạ. Và nó còn OAI nữa, hề hề hề.....
  • 2
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2056 tuannguyen314169

tuannguyen314169

    biết lệnh ddedit

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

Đã gửi 30 September 2010 - 07:30 PM

Cảm ơn Bác bình và các Bác trên diễn đàn đã cho tôi mót được nhiều thứ. Thank you very much
  • 0

#2057 tamkt

tamkt

    biết vẽ ellipse

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

Đã gửi 01 October 2010 - 06:57 AM

Cái này đơn giản nhất quả đất.
Gõ lệnh scale chọn đoạn thẳng chọn điểm gốc xong gõ 2000/1590 để được đoạn 2000 hoặc 1000/1590 để được đoạn 1000. Chúc bạn vui.


E hiểu ý anh, nhưng mà khổ cái là đoạn thẳng đó e ko biết kích thước chính xác, do vậy phải đo, rồi mới scal, rồi xóa cái dim mới đo xong đi, hic, nhiều công đoạn quá.

Em thấy nếu có lisp thí nhanh hơn.
  • 0

#2058 tamkt

tamkt

    biết vẽ ellipse

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

Đã gửi 01 October 2010 - 07:00 AM

Nếu có nhiều đoạn thẳng cần thay đổi như vậy thì nên sử dụng lệnh Len


Hic,em làm thử sao mà kkhông được.
Mong anh giúp em cái lệnh Len
  • 0

#2059 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 01 October 2010 - 07:39 AM

E hiểu ý anh, nhưng mà khổ cái là đoạn thẳng đó e ko biết kích thước chính xác, do vậy phải đo, rồi mới scal, rồi xóa cái dim mới đo xong đi, hic, nhiều công đoạn quá.

Em thấy nếu có lisp thí nhanh hơn.

Của bạn đây. Bạn có thể chọn nhiều đường line cuòng một lúc. Chú ý các đường line này lấy gốc là điểm bắt đầu vẽ line

(defun c:keol ()
(setq ss (ssget '((0 . "line")))
i 0
kt (getreal "\nnhap kich thuoc moi: ")
)
(while (< i (sslength ss))
(setq p1 (cdr (assoc 10 (entget (ssname ss i))))
p2 (cdr (assoc 11 (entget (ssname ss i))))
pm (polar p1 (angle p1 p2) kt)
)
(entmod (subst (cons 11 pm) (cons 11 p2) (entget (ssname ss i))))
(setq i (1+ i))
)
)

  • 1
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2060 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 01 October 2010 - 08:20 AM

Hic,em làm thử sao mà kkhông được.
Mong anh giúp em cái lệnh Len

Bạn làm như sau :
Command: len
LENGTHEN
Select an object or [DElta/Percent/Total/DYnamic]: T -> Gõ T

Specify total length or [Angle] <1.0000)>: 500 -> Gõ chiều dài (ví dụ 500)

Select an object to change or [Undo]: -> Kích vào đầu mút của LINE hoặc PLINE
Select an object to change or [Undo]: -> Kích vào đầu mút của LINE hoặc PLINE tiếp theo
Select an object to change or [Undo]:.......
................................................................................
.........
Tùy chọn Undo để hoàn trả lại chiều dài của LINE hoặc PLINE mà bạn đã pick

-> CAD sẽ tính chiều dài = 500 (điểm gốc của mút tính từ.....Bạn làm xong sẽ biết ha)
Chúc thành công
  • 2