Đến nội dung


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

Viết Lisp theo yêu cầu


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

#2281 dienlicogi17

dienlicogi17

    biết pan

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

Đã gửi 04 July 2009 - 10:51 AM

[quote name='Tue_NV' date='Jul 4 2009, 10:02' post='66250']
1. Không thể loại bỏ những đường gióng có cao độ gần như nhau được. Vì khi chạy Lisp sẽ hiểu là chạy từ đầu đỉnh đến cuối đỉnh của Pline
Lisp này Tue_NV đã chỉnh lại :

(defun c:SCD(/ oldos olddim sty d h mss gtmss PL pr tp po po2 pot LA1 po3 po4 po5 kc kcle pott)
;copyright by Tue_NV
(vl-load-com)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)

(setq olddim (getvar "dimzin"))

(setvar "dimzin" 0)

(setq sty (getvar "textstyle")
d (tblsearch "style" sty))
(setq mss (car(entsel "\n Chon mat so sanh :")))
(HLI mss)
(setq gtmss (getreal "\n Nhap gia tri mat so sanh :"))

(setq PL (car (entsel "\n Chon Pline :")))
(HLI PL)
(setq h (getdist "\n Nhap chieu cao text :"))
(setq pr (vlax-curve-getEndParam PL) i 1)
(setq tp (getint "\n So chu so thap phan :"))
(setq po (vlax-curve-getPointAtParam PL 0))

(setq po2 (vlax-curve-getClosestPointTo mss po))
(setq pot (list (car po2) (- (cadr po2) (/ h 2)) 0))

(command "offset" (* h 6) mss pot "")
(setq LA1 (entlast))
(setq po4 (vlax-curve-getClosestPointTo LA1 po2))
(setq po5 (list (car po4) (- (cadr po4) (* h 5)) 0))

(command "offset" (* h 11) mss pot "")
(setq kc (+ (distance po po2) gtmss))

(Command "line" po po2 "")
(Command "line" po4 po5 "")

(wtxt (rtos kc 2 tp) pot (/ pi 2) h)

(while (<= i pr)

(setq po (vlax-curve-getPointAtParam PL i))

(setq po3 (vlax-curve-getClosestPointTo mss po))
(setq po4 (vlax-curve-getClosestPointTo LA1 po3))
(setq po5 (list (car po4) (- (cadr po4) (* h 5)) 0))

(setq kc (+ (distance po po3) gtmss))
(setq kcle (distance po2 po3))

(setq pot (list (car po3) (- (cadr po3) (/ h 2)) 0))
(setq pott (list (- (car po3) (/ kcle 2)) (- (cadr po3) (* h 7)) 0))

(Command "line" po po3 "")
(Command "line" po4 po5 "")
(wtxt (rtos kc 2 tp) pot (/ pi 2) h)
(wtxt (rtos kcle 2 tp) pott (/ pi 2) h)
(setq po2 po3)
(setq i (1+ i))

)

(setvar "dimzin" olddim)
(setvar "osmode" oldos)
(command "undo" "end")
(Princ)
)

;
(defun HLI(enT)
(sssetfirst (ssadd enT (ssadd)) (ssadd enT (ssadd)))
)
;
(defun wtxt (txt p ang h / sty)
(setq sty (getvar "textstyle"))
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 11 p)
(cons 72 2) (cons 73 2) (cons 50 ang) (cons 40 h) (cons 41 0.8))
)
)


PS : Tue_NV không thích gọi bằng "cậu". Hãy tôn trọng
Hi hi, em xin lỗi. Cám ơn ông anh nhiều nhiều. List này rất hữu dụng cho dân trắc địa bọn em đấy. Nếu ông anh có thể kết hợp thêm một số thứ, nó sẽ trở thành một list hỗ trợ vẽ mặt cắt tuyệt vời. Dân trắc địa chắc lác mắt luôn. :s_big:
  • 0
Hồng Diễn - Mobile: 0936.458.268 - Email: Dienlicogi17@gmail.com

#2282 xuantran15

xuantran15

    biết lệnh ddedit

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

Đã gửi 04 July 2009 - 11:19 AM

1. Không thể loại bỏ những đường gióng có cao độ gần như nhau được. Vì khi chạy Lisp sẽ hiểu là chạy từ đầu đỉnh đến cuối đỉnh của Pline
Lisp này Tue_NV đã chỉnh lại :


(defun c:SCD(/ oldos olddim sty d h mss gtmss PL pr tp po po2 pot LA1 po3 po4 po5 kc kcle pott)
;copyright by Tue_NV
(vl-load-com)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)

(setq olddim (getvar "dimzin"))

(setvar "dimzin" 0)

(setq sty (getvar "textstyle")
d (tblsearch "style" sty))
(setq mss (car(entsel "\n Chon mat so sanh :")))
(HLI mss)
(setq gtmss (getreal "\n Nhap gia tri mat so sanh :"))

(setq PL (car (entsel "\n Chon Pline :")))
(HLI PL)
(setq h (getdist "\n Nhap chieu cao text :"))
(setq pr (vlax-curve-getEndParam PL) i 1)
(setq tp (getint "\n So chu so thap phan :"))
(setq po (vlax-curve-getPointAtParam PL 0))

(setq po2 (vlax-curve-getClosestPointTo mss po))
(setq pot (list (car po2) (- (cadr po2) (/ h 2)) 0))

(command "offset" (* h 6) mss pot "")
(setq LA1 (entlast))
(setq po4 (vlax-curve-getClosestPointTo LA1 po2))
(setq po5 (list (car po4) (- (cadr po4) (* h 5)) 0))

(command "offset" (* h 11) mss pot "")
(setq kc (+ (distance po po2) gtmss))

(Command "line" po po2 "")
(Command "line" po4 po5 "")

(wtxt (rtos kc 2 tp) pot (/ pi 2) h)

(while (<= i pr)

(setq po (vlax-curve-getPointAtParam PL i))

(setq po3 (vlax-curve-getClosestPointTo mss po))
(setq po4 (vlax-curve-getClosestPointTo LA1 po3))
(setq po5 (list (car po4) (- (cadr po4) (* h 5)) 0))

(setq kc (+ (distance po po3) gtmss))
(setq kcle (distance po2 po3))

(setq pot (list (car po3) (- (cadr po3) (/ h 2)) 0))
(setq pott (list (- (car po3) (/ kcle 2)) (- (cadr po3) (* h 7)) 0))

(Command "line" po po3 "")
(Command "line" po4 po5 "")
(wtxt (rtos kc 2 tp) pot (/ pi 2) h)
(wtxt (rtos kcle 2 tp) pott (/ pi 2) h)
(setq po2 po3)
(setq i (1+ i))

)

(setvar "dimzin" olddim)
(setvar "osmode" oldos)
(command "undo" "end")
(Princ)
)

;
(defun HLI(enT)
(sssetfirst (ssadd enT (ssadd)) (ssadd enT (ssadd)))
)
;
(defun wtxt (txt p ang h / sty)
(setq sty (getvar "textstyle"))
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 11 p)
(cons 72 2) (cons 73 2) (cons 50 ang) (cons 40 h) (cons 41 0.8))
)
)


PS : Tue_NV không thích gọi bằng "cậu". Hãy tôn trọng
@Xuantran : Tue_NV không hiểu file của bạn bị lỗi gì nữa. Bạn hãy lấy file này của Tue_NV test thử.
File test thử đây : http://www.cadviet.com/upfiles/Coc.dwg
Chiều cao chữ bạn chọn khoảng bằng 2 tronh hình vẽ thôi nhé
:blink:

Không hiểu sao khi test bằng cad 2004 thì rat tot, nhưng khi chuyển qua cad 2007 thì thì nó báo lỗi như thế bác Tue NV ạ. :s_big:
  • 0
Hình đã gửi
Thu đi cho lá vàng bay
Lá rơi cho đám cưới về......

#2283 aliosa

aliosa

    biết vẽ polygon

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

Đã gửi 04 July 2009 - 04:38 PM

Xin viết giúp lisp với nội dung sau:
Có:
- Một đường tim (bất kỳ) là tổ hợp của các đường (Polyline, Arc, splile,line) trên đường tim ta xác định các vị trí nhất định (theo tệp số liệu)
- Tệp số liệu dạng .CSV với các số liệu theo dạng sau:
+ cột 1:NO_ Số thứ tự.
+cột 2:DIST_ Khoảng cách (tính từ điểm điểm đầu đường tim, giá trị này bất kỳ)
+cột 3: OFFSET L_Khoảng cách offset sang trái đường tim (giá trị này có thể thay đổi)
+cột 4: OFFSET R_Khoảng cách offset sang phải đường tim (giá trị này có thể thay đổi)
VD:
NO,DIST,OFFSET L,OFFSET R
0,0,40,40
1,20,40,40
2,40,45,40
3,60,40,43
4,80,60,40
5,100,40,40
Yêu cầu
Viết một chương trình vẽ một đường tròn vào bên trái và bên phải đường tim đã có theo khoảng cách offset đã ghi trong trong tệp số liệu tương ứng tại các vị trí theo khoảng cách đã cho. (lưu ý bán kính của đường trong không khống chế ). Mục đích ở đây là xác định được vị trí của các điểm sau khi đã offset từ tim ra một khoảng các nhất định.
Xin nhờ các bạn chỉ giúp.
Hình đã gửi
http://www.cadviet.c...files/Tuyen.zip
  • 0

#2284 HoangSon614

HoangSon614

    biết lệnh properties

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

Đã gửi 05 July 2009 - 09:57 AM

Chào bạn Tue_NV!
Mình đang cần cái lisp đánh trục tự động nhưng mình tìm hoài không thấy, làm phiền bạn nếu có cho mình xin hoặc nếu được viết giúp mình với cấu trúc như sau:
Khởi động, lisp hỏi:
Cho biết vị trí cần chèn >>pick điểm
Góc xoay (độ): do use nhập vào
Kí hiệu trục: (do use nhập vào)
Bạn lưu ý dùm mình là thêm hàm While vào (ở đây có nghĩa là khi lisp hỏi vị trí cần chèn>>pick chọn điểm>>nhập góc xoay và ký hiệu xong 1 trục thì quay lại từ đầu để nhập cho điểm tiếp theo (nhưng phải tăng dần từ 1->2->3 hoặc từ A->B->C) đến khi không nhập nữa nhấn Enter là OK)
Cố gắng giúp mình nha. Cảm ơn bạn, chờ tin bạn.
Mình gửi kèm file Cad mẫu bạn xem (lưu ý đường kính vòng tròn D=10, text -Vni-Helve: 4.5)
http://www.cadviet.c.../Vi_du_truc.dwg
  • 0

#2285 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 05 July 2009 - 04:05 PM

Chào bạn Tue_NV!
Mình đang cần cái lisp đánh trục tự động nhưng mình tìm hoài không thấy, làm phiền bạn nếu có cho mình xin hoặc nếu được viết giúp mình với cấu trúc như sau:
Khởi động, lisp hỏi:
Cho biết vị trí cần chèn >>pick điểm
Góc xoay (độ): do use nhập vào
Kí hiệu trục: (do use nhập vào)
Bạn lưu ý dùm mình là thêm hàm While vào (ở đây có nghĩa là khi lisp hỏi vị trí cần chèn>>pick chọn điểm>>nhập góc xoay và ký hiệu xong 1 trục thì quay lại từ đầu để nhập cho điểm tiếp theo (nhưng phải tăng dần từ 1->2->3 hoặc từ A->B->C) đến khi không nhập nữa nhấn Enter là OK)
Cố gắng giúp mình nha. Cảm ơn bạn, chờ tin bạn.
Mình gửi kèm file Cad mẫu bạn xem (lưu ý đường kính vòng tròn D=10, text -Vni-Helve: 4.5)
http://www.cadviet.c.../Vi_du_truc.dwg

Đầu tiên bạn lưu file tdv.dwg này vào chính ổ C thì Lisp mới chạy được
http://www.cadviet.com/upfiles/tdv.dwg
Đây là Lisp Tue_NV viết theo đúng ý của HoangSon

;copyright by Tue_NV
(defun c:danhtruc()
(setq tileve 1)
(setq po (getpoint "\n Diem chen :"))
(setq caochu (* 4.5 tileve))
(INITGET "0 90")
(setq gocxoay (getreal "\n Nhap goc xoay <0 90> : "))

(command ".INSERT" "c:\\tdv.dwg" po 1 1 gocxoay)
(if (= gocxoay 0)
(progn
(setq pot (list (car po) (* (- (cadr po) 7) tileve) 0))
(setq bdau (getint "\n So bat dau :"))
(wtxt (rtos bdau 2 0) pot 0 caochu)
(if po
(progn
(while (setq po (getpoint "\n Diem chen tiep theo :"))
(setq pot (list (car po) (* (- (cadr po) 7) tileve) 0))
(setq bdau (1+ bdau))
(command ".INSERT" "c:\\tdv.dwg" po 1 1 gocxoay)
(wtxt (rtos bdau 2 0) pot 0 caochu)
);while
);progn
);if
);progn
);if

(if (= gocxoay 90)
(progn
(setq pot (list (* (+ (car po) 7) tileve) (cadr po) 0))
(setq bdau (getstring "\n Ki tu bat dau :"))
(wtxt bdau pot 0 caochu)
(if po
(progn
(while (setq po (getpoint "\n Diem chen tiep theo :"))
(setq pot (list (* (+ (car po) 7) tileve) (cadr po) 0))
(setq bdau (chr (1+ (ascii bdau))))
(command ".INSERT" "c:\\tdv.dwg" po 1 1 gocxoay)
(wtxt bdau pot 0 caochu)
);while
);progn
);if
);progn
);if

(princ)
)
;
;
(defun wtxt (txt p ang h / sty)
(setq sty (getvar "textstyle"))
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 11 p)
(cons 72 1) (cons 73 2) (cons 50 ang) (cons 40 h) (cons 41 0.8))
)
)

:blink:

Xin viết giúp lisp với nội dung sau:
Có:
- Một đường tim (bất kỳ) là tổ hợp của các đường (Polyline, Arc, splile,line) trên đường tim ta xác định các vị trí nhất định (theo tệp số liệu)

Chào aliosa :
Hai lwòi góp ý với bạn :
- 1 Cùng một câu hỏi mà bạn lại post ở 3 topic là điều hoàn toàn không nên làm chút nào và phải tránh
- 2 Tue_NV đọc bài của bạn vẫn chưa hiểu bạn nói gì thì làm sao mà giúp cho bạn được. Bạn nên nói rõ ràng ra và nên upload file .dwg minh hoạ điều bạn nói.
Chúc vui vẻ :s_big:
  • 2

#2286 Phiphi-

Phiphi-

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 434 Bài viết
Điểm đánh giá: 175 (tàm tạm)

Đã gửi 05 July 2009 - 07:48 PM

...
Bạn đã sử dụng thử lệnh Burst chưa? 1 lệnh phụ trợ của Express
...

Lệnh BURST dùng phá các Attributes rồi chuyển thành các Text.
Vậy xin hỏi bác Tue_NV là nếu như mình muốn chuyển các Text này thành lại các Attributes mà không phải dùng lệnh ATT thì liệu Lisp có thể thực hiện được yêu cầu này không vậy?
Nếu có được Lisp thì việc tạo lại các Attibutes rồi Block lại sẽ tiết kiệm khá nhiều thời gian. Nhờ các Bác góp ý thêm. Thank you.
  • 0

#2287 HoangSon614

HoangSon614

    biết lệnh properties

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

Đã gửi 06 July 2009 - 06:23 AM

Đầu tiên bạn lưu file tdv.dwg này vào chính ổ C thì Lisp mới chạy được
http://www.cadviet.com/upfiles/tdv.dwg
Đây là Lisp Tue_NV viết theo đúng ý của HoangSon


;copyright by Tue_NV
(defun c:danhtruc()
(setq tileve 1)
(setq po (getpoint "\n Diem chen :"))
(setq caochu (* 4.5 tileve))
(INITGET "0 90")
(setq gocxoay (getreal "\n Nhap goc xoay <0 90> : "))

(command ".INSERT" "c:\\tdv.dwg" po 1 1 gocxoay)
(if (= gocxoay 0)
(progn
(setq pot (list (car po) (* (- (cadr po) 7) tileve) 0))
(setq bdau (getint "\n So bat dau :"))
(wtxt (rtos bdau 2 0) pot 0 caochu)
(if po
(progn
(while (setq po (getpoint "\n Diem chen tiep theo :"))
(setq pot (list (car po) (* (- (cadr po) 7) tileve) 0))
(setq bdau (1+ bdau))
(command ".INSERT" "c:\\tdv.dwg" po 1 1 gocxoay)
(wtxt (rtos bdau 2 0) pot 0 caochu)
);while
);progn
);if
);progn
);if

(if (= gocxoay 90)
(progn
(setq pot (list (* (+ (car po) 7) tileve) (cadr po) 0))
(setq bdau (getstring "\n Ki tu bat dau :"))
(wtxt bdau pot 0 caochu)
(if po
(progn
(while (setq po (getpoint "\n Diem chen tiep theo :"))
(setq pot (list (* (+ (car po) 7) tileve) (cadr po) 0))
(setq bdau (chr (1+ (ascii bdau))))
(command ".INSERT" "c:\\tdv.dwg" po 1 1 gocxoay)
(wtxt bdau pot 0 caochu)
);while
);progn
);if
);progn
);if

(princ)
)
;
;
(defun wtxt (txt p ang h / sty)
(setq sty (getvar "textstyle"))
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 11 p)
(cons 72 1) (cons 73 2) (cons 50 ang) (cons 40 h) (cons 41 0.8))
)
)

Cảm ơn Tue_NV nhiều lắm, chạy OK luôn, nhưng mình muốn Tue_NV chỉnh lại 1tý dùm mình là gán kiểu text là Vni-Helve. Thanhk bạn lần nữa....
  • 0

#2288 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 06 July 2009 - 08:48 AM

Cảm ơn Tue_NV nhiều lắm, chạy OK luôn, nhưng mình muốn Tue_NV chỉnh lại 1tý dùm mình là gán kiểu text là Vni-Helve. Thanhk bạn lần nữa....

Muốn vầy thì chỉnh lại Code một chút

;; free lisp from cadviet.com

;copyright by Tue_NV
(defun c:danhtruc(/ tileve po caochu sty gocxoay pot bdau)
(setq tileve 1)
(setq po (getpoint "\n Diem chen :"))
(setq caochu (* 4.5 tileve))
(setq sty (getvar "textstyle"))
(Command "Style" "CADVIET" "Vhelvcn.ttf" "0" "1" "0" "n" "n")
(INITGET "0 90")
(setq gocxoay (getreal "\n Nhap goc xoay <0 90> : "))

(command ".INSERT" "c:\\tdv.dwg" po 1 1 gocxoay)
(if (= gocxoay 0)
(progn
(setq pot (list (car po) (* (- (cadr po) 7) tileve) 0))
(setq bdau (getint "\n So bat dau :"))
(wtxt (rtos bdau 2 0) pot 0 caochu)
(if po
(progn
(while (setq po (getpoint "\n Diem chen tiep theo :"))
(setq pot (list (car po) (* (- (cadr po) 7) tileve) 0))
(setq bdau (1+ bdau))
(command ".INSERT" "c:\\tdv.dwg" po 1 1 gocxoay)
(wtxt (rtos bdau 2 0) pot 0 caochu)
);while
);progn
);if
);progn
);if

(if (= gocxoay 90)
(progn
(setq pot (list (* (+ (car po) 7) tileve) (cadr po) 0))
(setq bdau (getstring "\n Ki tu bat dau :"))
(wtxt bdau pot 0 caochu)
(if po
(progn
(while (setq po (getpoint "\n Diem chen tiep theo :"))
(setq pot (list (* (+ (car po) 7) tileve) (cadr po) 0))
(setq bdau (chr (1+ (ascii bdau))))
(command ".INSERT" "c:\\tdv.dwg" po 1 1 gocxoay)
(wtxt bdau pot 0 caochu)
);while
);progn
);if
);progn
);if
(Setvar "textstyle" sty)
(princ)
)
;
;
(defun wtxt (txt p ang h / sty)
(setq sty (getvar "textstyle"))
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 11 p)
(cons 72 1) (cons 73 2) (cons 50 ang) (cons 40 h) (cons 41 0.8))
)
)

:s_big:

Lệnh BURST dùng phá các Attributes rồi chuyển thành các Text.
Vậy xin hỏi bác Tue_NV là nếu như mình muốn chuyển các Text này thành lại các Attributes mà không phải dùng lệnh ATT thì liệu Lisp có thể thực hiện được yêu cầu này không vậy?
Nếu có được Lisp thì việc tạo lại các Attibutes rồi Block lại sẽ tiết kiệm khá nhiều thời gian. Nhờ các Bác góp ý thêm. Thank you.

Chào Phiphi
Lisp vẫn có thể thực hiện được yêu cầu này với điều kiện như thế này:
-> Với mỗi Text
ta lấy điểm chèn của nó -> thành điểm chèn của ATTDEF
ta lấy các canh chỉnh của text -> thành canh chỉnh của ATTDEF
ta lấy nội dung của nó -> thành nội dung của ATTDEF (đây chính là Tagval)
Chỉ còn Tagname là ta chưa có.
Vậy khi sử dụng hàm while -> qua mỗi Text ta phải nhập cho nó 1 Tagname thì mới có thể thực hiện Lisp dượcĐó là một số ý kiến của Tue_NV. Các bác có ý kiến nào hay xin bổ sung. Thanks
  • 1

#2289 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 06 July 2009 - 09:05 AM

Các huynh cho đệ 1 lisp như sau:
- Tạo 1 file text tên là C:\Ketqua.txt nếu chưa có; ghi ở chế độ ghi thêm (thêm dòng vào nội dung có sẵn).
- Chọn đối tượng text thứ nhất, ghi giá trị text này vào file C:\Ketqua.txt và thêm dấu TAB (chưa xuống dòng).
- Chọn đối tượng text thứ 2, ghi giá trị text thứ 2 này vào cùng dòng với giá trị text thứ nhất và thêm dấu TAB.
- Chọn 1 loạt đối tượng là Line, Pline... ghi tổng giá trị chiều dài và xuống dòng (gọi hàm tính tổng chiều dài các đường- Lisp trên cadviet).

Mỗi lần thực hiện lệnh lại ghi thêm 1 dòng.
VD:
có 02 đối tượng text là "Diem 1" và "Diem 2", giữa 2 đối tượng text này có vài đường thẳng.
Khi gõ lệnh như trên sẽ ghi thêm vào file text 1 dòng như sau:

Diem 1 Diem 2 128.5
Mong các huynh giúp đỡ, đệ đã đọc thử bài liên kết Acad và Txt cũng như mã nguồn lisp tính tổng các đối tượng được chọn rồi như vẫn không làm được. :blink: :s_big:

Chào duongthanh85
Bạn chạy thử Lisp này :
(Defun C:tdd (/ fname obj1 obj2 txt1 txt2 ss len)
(setq fname "C:\\Ketqua.txt" )
(if (setq fname (open fname "a")) ;open file
(progn
(while
(and
(setq obj1 (entsel "\nChon text thu nhat :"))
(setq obj2 (entsel "\nChon text thu hai :"))
(princ "\nChon doi tuong do chieu dai :")
(setq ss (ssget))
)
(setq txt1 (cdr (assoc 1 (entget (car obj1))))
txt2 (cdr (assoc 1 (entget (car obj2))))
len (totalLen ss))
(if (and txt1 txt2 len)
(write-line (strcat txt1 "\t" txt2 "\t" (rtos len)) fname) )
)
(close fname) ;close file
)
)
(princ)
)
;; ---------------- Lisp chieu dai MLine --------------------------
(defun mllength (mline / entl a dist plst)
(cond ((= (type mline) 'ENAME)
(setq entl (entget mline)
a 0
dist 0
)
(foreach n entl
(if (member (car n) '(10 11))
(setq plst (cons (cdr n) plst))
)
)
(repeat (1- (length plst))
(setq dist (+ dist (distance (nth a plst) (nth (1+ a) plst)))
a (1+ a))
)
)
)
(setq mlst plst)
dist
)
;; ---------------- Lisp tong chieu dai --------------------------
(defun totalLen (ss / e e_type len)
(setq len 0)
(foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(setq e_type (cdr (assoc 0 (entget e))))
(cond
((wcmatch e_type "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE" )
(setq len (+ len (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))) )
((wcmatch e_type "MLINE")
(setq len (+ len (mllength e))))
( t nil)
)
)
len
)

  • 2

#2290 HoangSon614

HoangSon614

    biết lệnh properties

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

Đã gửi 06 July 2009 - 11:45 AM

Muốn vầy thì chỉnh lại Code một chút


;; free lisp from cadviet.com

;copyright by Tue_NV
(defun c:danhtruc(/ tileve po caochu sty gocxoay pot bdau)
(setq tileve 1)
(setq po (getpoint "\n Diem chen :"))
(setq caochu (* 4.5 tileve))
(setq sty (getvar "textstyle"))
(Command "Style" "CADVIET" "Vhelvcn.ttf" "0" "1" "0" "n" "n")
(INITGET "0 90")
(setq gocxoay (getreal "\n Nhap goc xoay <0 90> : "))

(command ".INSERT" "c:\\tdv.dwg" po 1 1 gocxoay)
(if (= gocxoay 0)
(progn
(setq pot (list (car po) (* (- (cadr po) 7) tileve) 0))
(setq bdau (getint "\n So bat dau :"))
(wtxt (rtos bdau 2 0) pot 0 caochu)
(if po
(progn
(while (setq po (getpoint "\n Diem chen tiep theo :"))
(setq pot (list (car po) (* (- (cadr po) 7) tileve) 0))
(setq bdau (1+ bdau))
(command ".INSERT" "c:\\tdv.dwg" po 1 1 gocxoay)
(wtxt (rtos bdau 2 0) pot 0 caochu)
);while
);progn
);if
);progn
);if

(if (= gocxoay 90)
(progn
(setq pot (list (* (+ (car po) 7) tileve) (cadr po) 0))
(setq bdau (getstring "\n Ki tu bat dau :"))
(wtxt bdau pot 0 caochu)
(if po
(progn
(while (setq po (getpoint "\n Diem chen tiep theo :"))
(setq pot (list (* (+ (car po) 7) tileve) (cadr po) 0))
(setq bdau (chr (1+ (ascii bdau))))
(command ".INSERT" "c:\\tdv.dwg" po 1 1 gocxoay)
(wtxt bdau pot 0 caochu)
);while
);progn
);if
);progn
);if
(Setvar "textstyle" sty)
(princ)
)
;
;
(defun wtxt (txt p ang h / sty)
(setq sty (getvar "textstyle"))
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 11 p)
(cons 72 1) (cons 73 2) (cons 50 ang) (cons 40 h) (cons 41 0.8))
)
)

Đúng như ý rồi, cảm ơn Tue_NV nhiều...
  • 0

#2291 aliosa

aliosa

    biết vẽ polygon

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

Đã gửi 06 July 2009 - 05:22 PM


Chào aliosa :
Hai lwòi góp ý với bạn :
- 1 Cùng một câu hỏi mà bạn lại post ở 3 topic là điều hoàn toàn không nên làm chút nào và phải tránh
- 2 Tue_NV đọc bài của bạn vẫn chưa hiểu bạn nói gì thì làm sao mà giúp cho bạn được. Bạn nên nói rõ ràng ra và nên upload file .dwg minh hoạ điều bạn nói.
Chúc vui vẻ


Chào bạn Tue_NT.
Thành thật xin lỗi vì đã post lộn xộn quá. Nhưng là lần đầu tiên post bài. Mình cũng không có kinh nghiệm lắm lên mới xẩy ra tình trạng vậy. Mình muốn xóa đi lăm nhưng không biết cách xóa. Hic
Bản vẽ mình có post theo đường lick cuối bài.
Ý mình muốn hỏi là làm sao xác định được một vị trí điểm cách một đường cong cho trước một khoảng (l) cho trước.
  • 0

#2292 Phiphi-

Phiphi-

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 434 Bài viết
Điểm đánh giá: 175 (tàm tạm)

Đã gửi 06 July 2009 - 07:04 PM

Chào Phiphi
Lisp vẫn có thể thực hiện được yêu cầu này với điều kiện như thế này:
-> Với mỗi Text
ta lấy điểm chèn của nó -> thành điểm chèn của ATTDEF
ta lấy các canh chỉnh của text -> thành canh chỉnh của ATTDEF
ta lấy nội dung của nó -> thành nội dung của ATTDEF (đây chính là Tagval)
Chỉ còn Tagname là ta chưa có.
Vậy khi sử dụng hàm while -> qua mỗi Text ta phải nhập cho nó 1 Tagname thì mới có thể thực hiện Lisp dượcĐó là một số ý kiến của Tue_NV. Các bác có ý kiến nào hay xin bổ sung. Thanks

Vì yêu cầu của ATT là không được có SPACE giữa các Text nên PP nghỉ dùng Lisp để chèn các gạch nối (_) thay các SPACE. Sau đó dùng chính các Text này làm thành các Tagname.
Như vậy tất cả đều được Lisp xử lý toàn bộ tự động. Mong Bác Tue_NV ra tay giúp. Thank you.
  • 0

#2293 nh0ckut3t0cv4ngh03

nh0ckut3t0cv4ngh03

    biết pan

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

Đã gửi 06 July 2009 - 09:00 PM

Bạn có thể post yêu cầu về autolisp ở topic này.


Dear Mr Hoanh
Anh viết giúp em đoạn lisp này (Em làm nhưng không được, em không phải là dân chuyên nghiệp về autolisp em chỉ hay chỉnh sửa lisp của các tác giả khác để phù hợp và thuận tiện cho công việc của mình thôi):
(setq X (list X1 X2 X3 X4 X5 X6)) ;Dầy bản nối
(setq Y (list Y1 Y2 Y3 Y4 Y5 Y6)) ;Độ dài dầm theo thiết kế
Em muốn tính
(setq Z (+ (+ Y1 X1) (+ Y2 X1 X2) (+ Y3 X2 X3) (+ Y4 X3 X4) (+ Y5 X4 X5) (+ Y6 X5 X6))
)

hoặc là :
(setq Z (+ Y1 Y2 Y3 Y4 Y5 Y6 X6 (* 2 (+ X1 X2 X3 X4 X5)))
)

nhưng đấy chỉ là 6 số, nhưng em muốn có rất nhiều số nữa thì có cách nào để tính được Z không anh ?

Mong sớm nhận được hồi âm của anh.
Thanks !
  • 0

#2294 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 06 July 2009 - 09:47 PM

Dear Mr Hoanh
Anh viết giúp em đoạn lisp này (Em làm nhưng không được, em không phải là dân chuyên nghiệp về autolisp em chỉ hay chỉnh sửa lisp của các tác giả khác để phù hợp và thuận tiện cho công việc của mình thôi):
(setq X (list X1 X2 X3 X4 X5 X6)) ;Dầy bản nối
(setq Y (list Y1 Y2 Y3 Y4 Y5 Y6)) ;Độ dài dầm theo thiết kế
Em muốn tính
(setq Z (+ (+ Y1 X1) (+ Y2 X1 X2) (+ Y3 X2 X3) (+ Y4 X3 X4) (+ Y5 X4 X5) (+ Y6 X5 X6))
)

hoặc là :
(setq Z (+ Y1 Y2 Y3 Y4 Y5 Y6 X6 (* 2 (+ X1 X2 X3 X4 X5)))
)

nhưng đấy chỉ là 6 số, nhưng em muốn có rất nhiều số nữa thì có cách nào để tính được Z không anh ?

Mong sớm nhận được hồi âm của anh.
Thanks !

Nhiều hơn nữa vẫn tính được như thường.
Để Tue_NV phân tích :
Tổng Z theo của bạn chính là tổng của các phần tử trong 3 List
1. List L1 (X1 X2 X3 X4 X5 X6)
2. List L2 (Y1 Y2 Y3 Y4 Y5 Y6)
3. List L3 (X1 X2 X3 X4 X5)
Mời bạn xem code này :
(defun c:NL(/ x L1 L2 L3 L4 S)
(vl-load-com)
(setq L1 (list 1 2 3 4 5 6))
(setq L2 (list 11 12 13 14 15 16))
(setq L3 (vl-remove (last L1) L1))
(setq L4 (append L1 L2 L3))
(setq S 0)
(foreach x L4
(setq S (+ S x))
)
(alert (strcat "ket qua la :" (rtos S 2 0)))
)
Ví dụ trong code là :
List L1 (1 2 3 4 5 6)
List L2 (11 12 13 14 15 16)
List L3 (1 2 3 4 5)
Còn List L4 là nối các List L1 L2 L3 lại với nhau -> Sau đó tính tổng các phần tử của List L4.
Kết quả tính tổng nằm trong biến S

Bạn có thể thêm nhiều phần tử List vào list L1 L2 và List L3 được tính toán từ list L1
Mong bạn hiểu :blink:

@PP : Tue_NV đang viết. Chờ nhé : :s_big:
  • 2

#2295 TRUNGNGAMY

TRUNGNGAMY

    biết lệnh block

  • Members
  • PipPipPipPipPipPip
  • 401 Bài viết
Điểm đánh giá: 91 (tàm tạm)

Đã gửi 07 July 2009 - 12:46 AM

Dear Mr Hoanh
Anh viết giúp em đoạn lisp này (Em làm nhưng không được, em không phải là dân chuyên nghiệp về autolisp em chỉ hay chỉnh sửa lisp của các tác giả khác để phù hợp và thuận tiện cho công việc của mình thôi):
(setq X (list X1 X2 X3 X4 X5 X6)) ;Dầy bản nối
(setq Y (list Y1 Y2 Y3 Y4 Y5 Y6)) ;Độ dài dầm theo thiết kế
Em muốn tính
(setq Z (+ (+ Y1 X1) (+ Y2 X1 X2) (+ Y3 X2 X3) (+ Y4 X3 X4) (+ Y5 X4 X5) (+ Y6 X5 X6))
)

hoặc là :
(setq Z (+ Y1 Y2 Y3 Y4 Y5 Y6 X6 (* 2 (+ X1 X2 X3 X4 X5)))
)

nhưng đấy chỉ là 6 số, nhưng em muốn có rất nhiều số nữa thì có cách nào để tính được Z không anh ?

Mong sớm nhận được hồi âm của anh.
Thanks !

Bạn cũng có thể làm như vậy :
(setq Z (eval (append (list '+) X Y X (list (* -1 (last X))))))
tránh việc dùng hàm (vl-remove) có thể dẫn đến kq sai khi có một số phần tử trong X bằng "last" X
  • 1

#2296 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 07 July 2009 - 08:07 AM

Bạn cũng có thể làm như vậy :
(setq Z (eval (append (list '+) X Y X (list (* -1 (last X))))))
tránh việc dùng hàm (vl-remove) có thể dẫn đến kq sai khi có một số phần tử trong X bằng "last" X

Chào bạn TRUNGNGAMY
Phép cộng có tính chất giao hoán cho nên khi dùng hàm (vl-remove) luôn đúng khi có một số phần tử trong X bằng "last" X
Điều này bạn hiểu không?

Vậy nên Lisp của Tue_NV luôn luôn chạy đúng khi có một số phần tử trong X bằng "last" X.
Vấn đề của mình là chỉ khai trừ một phần tử có giá trị bằng last X và vì phép cộng có tính giao hoán nên bài toán của Tue_NV luôn luôn đúng, không hề có sự nhầm lẫn ở đây.

Ý mình muốn hỏi là làm sao xác định được một vị trí điểm cách một đường cong cho trước một khoảng (l) cho trước.

Bạn xem bài viết này : http://www.cadviet.c...amp;#entry60982
  • 0

#2297 TRUNGNGAMY

TRUNGNGAMY

    biết lệnh block

  • Members
  • PipPipPipPipPipPip
  • 401 Bài viết
Điểm đánh giá: 91 (tàm tạm)

Đã gửi 07 July 2009 - 10:04 AM

Chào bạn TRUNGNGAMY
Phép cộng có tính chất giao hoán cho nên khi dùng hàm (vl-remove) luôn đúng khi có một số phần tử trong X bằng "last" X
Điều này bạn hiểu không?

Vậy nên Lisp của Tue_NV luôn luôn chạy đúng khi có một số phần tử trong X bằng "last" X.
Vấn đề của mình là chỉ khai trừ một phần tử có giá trị bằng last X và vì phép cộng có tính giao hoán nên bài toán của Tue_NV luôn luôn đúng, không hề có sự nhầm lẫn ở đây.
Bạn xem bài viết này : http://www.cadviet.c...amp;#entry60982

Mình thử thì nó ra như vậy
Command: (vl-load-com)

Command: (setq l1 (list 1 2 3 4 4 3 2 1))
(1 2 3 4 4 3 2 1)

Command: (vl-remove (last l1) l1)
(2 3 4 4 3 2)
Bạn nghiên cứu lại xem
  • 2

#2298 aliosa

aliosa

    biết vẽ polygon

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

Đã gửi 07 July 2009 - 10:09 AM

Bạn xem giúp mình chút nữa.
Sau khi xách định được một điểm trên đường cong, từ điểm đó dịch sang trái (hoặc phải) một khoảng nữa.
File bản vẽ gửi kèm:
http://www.cadviet.com/upfiles/XD.dwg
Như hình vẽ:
Hình đã gửi
  • 0

#2299 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 07 July 2009 - 10:27 AM

Mình thử thì nó ra như vậy
Command: (vl-load-com)

Command: (setq l1 (list 1 2 3 4 4 3 2 1))
(1 2 3 4 4 3 2 1)

Command: (vl-remove (last l1) l1)
(2 3 4 4 3 2)
Bạn nghiên cứu lại xem

Chào bạn TRUNGNGAMY
Cảm ơn bạn TRUNGNGAMY nhiều lắm. Lúc đầu mình nghĩ khi dùng hàm (vl-remove) thì nó chỉ loại trừ 1 phần tử thôi. Ai ngờ nó loại trừ hết các phần tử giống nhaủ trong List. Thành thật xin lỗi bạn TRUNGNGAMY và cả bạn nh0ckut3t0cv4ngh03 nữa do Tue_NV không chú ý tới điều này
Cảm ơn bạn TRUNGNGAMY một lần nữa

Bạn xem giúp mình chút nữa.
Sau khi xác định được một điểm trên đường cong, từ điểm đó dịch sang trái (hoặc phải) một khoảng nữa.
File bản vẽ gửi kèm:
http://www.cadviet.com/upfiles/XD.dwg
Như hình vẽ:
Hình đã gửi

Chào bạn Aliosa
Sau khi xác định được một điểm trên đường cong -> Bạn muốn xác định điểm tiếp theo là điểm đó dịch sang trái (hoặc phải) một khoảng nữa thì bạn sử dụng hàm polar

Cú pháp của hàm polar : (polar pt ang dist)
Bạn có thể đọc hàm này trong Help
  • 0

#2300 aliosa

aliosa

    biết vẽ polygon

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

Đã gửi 07 July 2009 - 10:49 AM

Chào bạn TRUNGNGAMY
Cảm ơn bạn TRUNGNGAMY nhiều lắm. Lúc đầu mình nghĩ khi dùng hàm (vl-remove) thì nó chỉ loại trừ 1 phần tử thôi. Ai ngờ nó loại trừ hết các phần tử giống nhaủ trong List. Thành thật xin lỗi bạn TRUNGNGAMY và cả bạn nh0ckut3t0cv4ngh03 nữa do Tue_NV không chú ý tới điều này
Cảm ơn bạn TRUNGNGAMY một lần nữa
Chào bạn Aliosa
Sau khi xác định được một điểm trên đường cong -> Bạn muốn xác định điểm tiếp theo là điểm đó dịch sang trái (hoặc phải) một khoảng nữa thì bạn sử dụng hàm polar

Cú pháp của hàm polar : (polar pt ang dist)
Bạn có thể đọc hàm này trong Help

Mình thấy lệnh polar không ổn lắm. Vì bản chất ở đây là từ điểm mình đã xác định được trên đường cong rồi từ đó mình phải xác định được vector pháp tuyến của đường cong tại điểm đó. Sau đó mới xác định vị trí điểm cần tìm trên véc tơ pháp tuyến đó theo khoảng cách đã cho trước. (hic, mình chưa biết lệnh xác định vector pháp của đường cong trong lisp)
Nếu dùng lệnh polar thì mình phải biết góc trước nhưng ở đây chưa có góc, mà chỉ biết khoảng cách thôi.
  • 0