lenhatanh 2 Báo cáo bài đăng Đã đăng Tháng 6 19, 2011 Em nhờ các bác sửa cho em đoạn lisp "Gán Text cho các đường đồng mức" sau: (em đã gán được Text cho các đường Đ.Mức nhưng không vẽ được hình chữ nhật hoặc hình ô van bao quanh Text - để che một phần đường ĐM dưới Text). - Yêu cầu của em là các hình này (hình chữ nhật hoặc hình ô van) bao quanh Text và quay (xoay or cùng chiềU) theo chiều của các đường Đ.Mức... Xin cảm ơn các Bác trước ! Link đến Files ACAD và Video ví dụ: http://www.mediafire.com/?fczlrdmn9a92l6z#1 (defun C:Du-text (/ n cdo che pi1 pi2 pi3 Am sokytu caotext daitext AM pi1a pi1b pi3a pi3b) (setq cdo (getreal "\nCao Do Bat Dau Cua Duong Dong_Muc...: ")) (setq che (getreal "\nChenh Cao or Buoc nhay Cua Duong D.Muc...: ")) (while (setq n 1) (command "Osmode" 512) (setq pi1 (getpoint "\nDiem Dat Text <Esc to Cancel>...: ")) (setq pi2 (getpoint "\nDiem Thu Hai <Esc to Cancel>...: ")) (setq AM (angle pi1 pi2)) (setq sokytu (strlen (rtos cdo 2 2)) caotext (getvar "Textsize") daitext (* sokytu caotext) pi3 (polar pi1 AM daitext)) (cond ((> (cadr pi1) (cadr pi2)) (setq pi1a (polar pi1 (- (Du-rtd (- 6.28319 AM)) 90) (+ (* caotext 0.5) 0.1)) pi1b (polar pi1 (Du-rtd AM) (+ (* caotext 0.5) 0.1)) pi3a (polar pi3 (/ pi 2) (+ (* caotext 0.5) 0.1)) pi3b (polar pi3 (-(/ pi 2)) (+ (* caotext 0.5) 0.1)))) ((< (cadr pi1) (cadr pi2)) (setq pi1a (polar pi1 (/ pi 2) (+ (* caotext 0.5) 0.1)) pi1b (polar pi1 (-(/ pi 2)) (+ (* caotext 0.5) 0.1)) pi3a (polar pi3 (/ pi 2) (+ (* caotext 0.5) 0.1)) pi3b (polar pi3 (-(/ pi 2)) (+ (* caotext 0.5) 0.1)))) ((= (cadr pi1) (cadr pi2)) (setq pi1a (polar pi1 (- pi) (+ (* caotext 0.5) 0.1)) pi1b (polar pi1 0.0 (+ (* caotext 0.5) 0.1)) pi3a (polar pi3 (- pi) (+ (* caotext 0.5) 0.1)) pi3b (polar pi3 0.0 (+ (* caotext 0.5) 0.1)))) (T (setq pi1a (polar pi1 (/ pi 2) (+ (* caotext 0.5) 0.1)) pi1b (polar pi1 (-(/ pi 2)) (+ (* caotext 0.5) 0.1)) pi3a (polar pi3 (/ pi 2) (+ (* caotext 0.5) 0.1)) pi3b (polar pi3 (-(/ pi 2)) (+ (* caotext 0.5) 0.1)))) ) (command "Layer" "M" "Wipeout" "") (command "Osmode" 0 "_Wipeout" pi1a pi3a pi3b pi1b "") (command "layer" "M" "Text_Cai" "") (command "_text" "J" "ML" (polar pi1 AM 0.05) (Du-rtd AM) (rtos cdo 2 2)) (setq n (+ n 1) cdo (+ cdo che)) ) (command "layer" "S" "0" "") (command "Osmode" 33 "color" "Bylayer" "cmdecho" 1 "ortho" "on" "redraw") ) Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
hugo007 1 Báo cáo bài đăng Đã đăng Tháng 6 19, 2011 Hàm getkword thì được bác phamthanhbinh ạ. E dùng giống như bác nói: chonfont (getkword "\nChon Font<vhelvcn.ttf> :") Mà sao nó vẫn không hiểu.Thanks. Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
phamthanhbinh 3.146 Báo cáo bài đăng Đã đăng Tháng 6 19, 2011 E dùng giống như bác nói: chonfont (getkword "\nChon Font<vhelvcn.ttf> :") Mà sao nó vẫn không hiểu.Thanks. Bạn phải dùng kết hợp với hàm initget nữa mới được. bạn hãy tham khảo trong help của CAD sẽ rõ hơn. Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
codered8x 18 Báo cáo bài đăng Đã đăng Tháng 6 19, 2011 Nhờ các bác giải thik hộ em cái đoạn code này với, nghĩ bại não ko ra. Mục đích của hàm này là loại bỏ các phần tử trong danh sách tại các vị trí được xác định bởi giá trị của các phần tử trong danh sách khác. (defun LM:RemoveItems ( items lst ) (if (and lst items) (if (zerop (car items)) (LM:RemoveItems (mapcar '1- (cdr items)) (cdr lst)) (cons (car lst) (LM:RemoveItems (mapcar '1- items) (cdr lst))) ) lst ) ) Ví dụ : _$ (LM:RemoveItems '(1 3 5) '("A" "B" "C" "D" "E" "F")) ("A" "C" "E") Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
gasmanc 1 Báo cáo bài đăng Đã đăng Tháng 6 20, 2011 @790312 : Bài viết 3818 là bài viết của Tue_NV viết để thay đổi bề rộng chiều cao , Style của chữ trong Block ATT, chẳng ăn nhập gì với DIMENSION STYLE cả, chẳng hiểu yêu cầu của bạn là như thế nào nữa @zizpo_hetxang : Khi xoay thì dữ liệu nhập vào ngoài góc xoay còn có tâm xoay? Nếu xoay bên trái thì xoay tại đâu? Xoay bên phải thì xoay tại đâu? bạn nên gửi file .dwg, kết quả và viết rõ hơn vấn đề của bạn @gasmanc : Bước thứ 2 cũng cần thiết đấy bạn. Không có bước 2 sao có bước 3 được. Hằng số mà bạn nói ấy luôn luôn bằng nhau khi duyệt qua từng cặp Text và point à? Không biết hằng số đấy có bằng nhau không? Hay là có quy luật? Có lẽ bạn nên upload 1 file .dwg chứa một số đối tượng để người viết Lisp cho bạn có thể test để kiểm tra, Hơn nữa bạn nên nói rõ hơn về kết quả bạn muốn nhé. Còn kết quả thì Minh họa 1 vài kết quả đạt được thôi Bài toán mình muốn giải quyết là muốn trừ tất cả cao độ trên bản vẽ đi 1 hằng số cố định. Tuy vậy mình muốn tách ra làm 3 bài toán nhỏ để phục vụ những yêu cầu riêng biệt. Mong các bạn giúp đỡ Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
funnyzui 1 Báo cáo bài đăng Đã đăng Tháng 6 20, 2011 Xin lisp liên quan đến chương trình thống kê thép. xin chào các ae cadviet, funnyzui muốn xin các bạn viết cho 1 cái lisp có thể quét chọn 1 lần nhiều đối tượng (là block_thuộc tính) để update lại các giá trị thuộc tính của nó, thay vì như hiện giờ mình phải pick từng đối tượng 1 để update lại các cây thép có sự thay đổi về chiều dài, số lượng cấu kiện,... File cad bên dưới, có ghi rõ nội dung và hình ảnh minh họa: thongkethep.dwg File lisp của chương trình thống kê mà funnzyzui đang sử dụng: http://www.cadviet.com/upfiles/3/chinh.rar thongke_3.lsp Bài viết về lệnh TTB.vlx và lệnh SCK.vlx có liên quan: http://www.cadviet.com/forum/index.php?showtopic=13203&view=findpost&p=99749 http://www.cadviet.com/forum/index.php?showtopic=5497&view=findpost&p=67668 Mong các ae trên diễn đàn bớt chút thời gian để nghiên cứu giúp. Nếu có thể nhanh chóng như lisp SCK.vlx của TUE_NV thì quá tốt. Xin cám ơn các ae! Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
gasmanc 1 Báo cáo bài đăng Đã đăng Tháng 6 20, 2011 @gasmanc : Bước thứ 2 cũng cần thiết đấy bạn. Không có bước 2 sao có bước 3 được. Hằng số mà bạn nói ấy luôn luôn bằng nhau khi duyệt qua từng cặp Text và point à? Không biết hằng số đấy có bằng nhau không? Hay là có quy luật? Có lẽ bạn nên upload 1 file .dwg chứa một số đối tượng để người viết Lisp cho bạn có thể test để kiểm tra, Hơn nữa bạn nên nói rõ hơn về kết quả bạn muốn nhé. Còn kết quả thì Minh họa 1 vài kết quả đạt được thôi Sáng nay mình post bài nhưng bị nhầm. sau đó mất điện nên ko làm gì được. Bây giờ mình up lên 1 file mới kèm yêu cầu cụ thể. các bạn giúp đỡ nhé. http://www.mediafire.com/?f5oie0lea8r4aya Bài toán này có thể gộp về 1 yêu cầu đơn giản hơn là (cộng)trừ tất cả các số thập phân (số nguyên ở trên, số thập phân ở dưới) cho duy nhất 1 hằng số cố định. miêu tả cụ thể trong bản vẽ. Lần trước mình nêu ra 3 yêu cầu nhỏ bởi vì có những lúc mình chỉ cần làm 1 trong 3 bước đó nên nêu yêu cầu như vậy. còn về khoảng cách tại sao yêu cầu là 0.4 thì có 2 nguyên nhân: thứ nhất là do yêu cầu bản vẽ phải như thế, thứ 2 là mình nghĩ nên có 1 khoảng cách cụ thể để lisp lọc được những con số cần nối với nhau. Ở đây cụ thể là chân text A và đầu text B có cùng giá trị Y, cách nhau 0.8 thì nối với nhau thành A.B; tránh trường hợp như 1 số lisp nối text khác, bị nối nhầm khi nhiều text ở gần nhau. Nếu có thể, các bạn giúp mình 2 lisp: 1. cộng (trừ) tất cả câc cao độ trên bình đồ cho 1 hằng số, in luôn ra kết quả thay thế các số đó. 2. lisp lần lượt thực hiện 3 bước theo yêu cầu trong bản vẽ. thanks Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
gasmanc 1 Báo cáo bài đăng Đã đăng Tháng 6 20, 2011 Mình có sẳn cái này dùng nối. (Defun c:HTR () (if (null kichthuocchontex)(setq kichthuocchontex "1")) (setq kichthuocchontext (atof kichthuocchontex)) (setvar "MODEMACRO" "CHINH CAO DO HIEN TRANG") (command "-layer" "new" "SOCAODOSUACHUA" "color" "50" "SOCAODOSUACHUA" "") (princ "\nPHAM QUOC DUY Binh Son - Quang ngai") (Princ "\nHay chon vung :") (setq XX (ssget '((0 . "POINT,CIRCLE")))) (setq L 0) (setq M (sslength XX)) (while (< L M) (setq DT (ssname XX L)) (setq DT (entget DT)) (setq TEXT (cdr (assoc 10 DT))) (setq luubatdiem (getvar "osmode")) (setvar "osmode" 0) (setq x (car TEXT)) (setq y (cadr TEXT)) (setvar "osmode"luubatdiem) (setq luubatdiem (getvar "osmode")) (command "-layer" "set" "SOCAODOSUACHUA" "") (setvar "osmode" 0) (command "select" "W" (list (+ x 0)(- y 0)) (list (- x (* kichthuocchontext 10))(+ y (* kichthuocchontext 3))) "" "") (setq SS (ssget "p" '((0 . "TEXT")))) (setq DTDTT (ssname SS 0)) (setq DTTT (entget DTDTT)) (setq NOIDUNGVIET (cdr (assoc 1 DTTT))) (command "select" "W" (list (+ x (* kichthuocchontext 10))(- y 0)) (list (+ x 0)(+ y (* kichthuocchontext 3))) "" "") (setq yy (ssget "p" '((0 . "TEXT")))) (setq DTDTTS (ssname yy 0)) (setq DTTTS (entget DTDTTS)) (setq NOIDUNGVIETS (cdr (assoc 1 DTTTS))) (setq chuoivietlai (strcat NOIDUNGVIET "." NOIDUNGVIETS)) (command "TEXT" "c" (list (+ x 0)(- y 0)) (* kichthuocchontext 1) 0 chuoivietlai) (setq NOIDUNGVIET nil) (setq NOIDUNGVIETS nil) (setq chuoivietlai nil) (setvar "osmode"luubatdiem) (setq L (1+ L)) ) (setvar "MODEMACRO" "**CHUC BAN LAM VIEC HIEU QUA** PHAM QUOC DUY - BINH SON - QUANG NGAI") (Princ) ) -Kết quả sẽ viết lên layer SOCAODOSUACHUA. Phải kiểm tra chứ có khi text dính thì nó ra kết quả sai nhé. Đây là lisp mình làm sẳn để nối text do lúc xưa các ông tướng địa hình hay ma số dẩn đến kết quả z của các point không trúng. -Trường hợp của bạn thì mình đoán là ma thêm khối lượng địa hình. nếu tin tưởng z của point thì viết líp như này hay hơn. +nâng hoặc hạ z của point giá trị do mình nhập. +Đọc z của point viết ra text trước và sau. không phải mình định ma Z đâu. Mình có một bình đồ số được đo theo một mốc với trị số mộc là a. về sau người ta yêu cầu phải đo theo trị số mốc khác. Do đó số liệu cần phải sửa trên bản cad để in. số lượng các điểm này quá nhiều mà không thể làm các khác được vì file số liệu bị chết hoặc người ta không giao cho mình. Do đó mình mới cần lisp đáp ứng yêu cầu cụ thể của mình. Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
hugo007 1 Báo cáo bài đăng Đã đăng Tháng 6 20, 2011 Bạn phải dùng kết hợp với hàm initget nữa mới được. bạn hãy tham khảo trong help của CAD sẽ rõ hơn. E dùng như vầy mà vẫn chưa được: (initget "vhelvcn.ttf") (setq tbl (tblnext "STYLE" T) FontName (getkword "\nT\U+00EAn Font<vhelvcn.ttf> :") Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
phamthanhbinh 3.146 Báo cáo bài đăng Đã đăng Tháng 6 20, 2011 E dùng như vầy mà vẫn chưa được: (initget "vhelvcn.ttf") (setq tbl (tblnext "STYLE" T) FontName (getkword "\nT\U+00EAn Font<vhelvcn.ttf> :") Hề hề hề, Mình xin mượn hoa cúng Phật vậy. Bạn hãy tham khảo đoạn code sau đây của bác hochoaihetdot nha: (if (not key_ctnc1) (setq key_ctnc1 "C")) (initget "c t n h") (setq key_ctnc (getkword (strcat "\Cong/Tru/Nhan/cHia [C/T/N/H] <" key_ctnc1 ">: "))) (if (not key_ctnc) (setq key_ctnc key_ctnc1) (setq key_ctnc1 key_ctnc)) Nếu thấy ưng ý thì thank bác ấy vài phát nghen. Hề hề hề 1 Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
phamthanhbinh 3.146 Báo cáo bài đăng Đã đăng Tháng 6 20, 2011 Cám ơn bác PhamThanhBinh đã sửa giúp và chỉ dẫn, cám ơn mọi người Lisp chay rất tốt, rất đúng yêu cầu... Chúc mọi người vui, khỏe, mong Chủ đề và diễn đàn luôn phát triển. (Tiện đây cho em hỏi làm sao add được tên như sau: "phamthanhbinh, on 19 June 2011 - 09:49 PM, said:" lên tiêu đề của phần trích dẫn ?) Hề hề hề, Lisp chạy tốt nhưng chửa ngon đâu. Nếu bạn bỏ cái hàm (cond .....) đi được mới ngon cơ. Với khả năng của bạn, mình nghĩ bạn dư sức làm điều đó mà. Muốn Add cái đó lên thì bạn chỉ cần click vào nút trả lời phía dưới cái bài viết bạn trích là OK mà. Hề hề hế,... 1 Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
lenhatanh 2 Báo cáo bài đăng Đã đăng Tháng 6 21, 2011 Hề hề hề, Lisp chạy tốt nhưng chửa ngon đâu. Nếu bạn bỏ cái hàm (cond .....) đi được mới ngon cơ. Với khả năng của bạn, mình nghĩ bạn dư sức làm điều đó mà. Muốn Add cái đó lên thì bạn chỉ cần click vào nút trả lời phía dưới cái bài viết bạn trích là OK mà. Hề hề hế,... Cám ơn Bác đã giúo đỡ và khích lệ... Em đang thử đây. Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
lenhatanh 2 Báo cáo bài đăng Đã đăng Tháng 6 21, 2011 Em nhờ các Bác sửa dùm em Lisp "Ve_MCN" địa hình (đã chỉnh sửa, chạy và vẽ được mặt cắt ngang ĐH) nhưng yêu cầu sau khi nhập các điểm xong, xuất hiện lại hộp thoại (trước khi vẽ MCN) thì trên hộp thoại thể hiện 03 listbox: "TT" - số điểm, "CD" - Cao độ điểm và "KC" - Khoảng cách giũa các điểm. (hiện nay chưa thể hiện được) Link đến các file: *.DCL, *.Lsp, *.avi...: http://www.mediafire.com/?d893l266ptycwt3 ;------------------------------------------ (defun Get_tt (/ g:tt) (set_tile "error" "") (setq g:tt (get_tile "tt")) (setq tt g:tt) ) ;------------------------------------------ (defun Get_cd (/ g:cd) (set_tile "error" "") (setq g:cd (get_tile "cd")) (setq cd g:cd) ) ;------------------------------------------ (defun Get_kc (/ g:kc) (set_tile "error" "") (setq g:kc (get_tile "kc")) (setq kc g:kc) ) ;------------------------------------------ (defun Get_nd (/ filename) (set_tile "error" "") (setq filename (getfiled "Write Text to File" "C:/My Documents/" "dhn" 1)) (setq tfw filename) ) ;------------------------------------------ (defun Get_li() (start_list "tt" 3) (foreach ch1 ltt (add_list ch1)) (end_list) (start_list "cd") (foreach ch2 lcd (add_list (rtos ch2 2 2))) (end_list) (start_list "kc") (foreach ch3 lkc (add_list (rtos ch3 2 2))) (end_list) (mode_tile "start" 0) (start_dialog) ) ;---------------------------------------------------------------------------------------------------------- (defun nhapdiem (/ Tex en cd cdi kc di ldi ldii n i io hso E Eo total Ele Elist d1 d2 di1 di2 ldinew tfile) (setq tfile (open tfw "w") ldi '() lcd '() lkc '() ltt '() tti 1) (setq tbd (getreal "\n Tile Cua Binh Do: ")) (setq tim (getreal "\n Khoang Cach Tu Mep Den Tim Kenh: ")) (while (setq di (getpoint "\n Pick point...(<Retern>to end) :")) (setq ldi (cons di ldi) ltt (cons (itoa tti) ltt)) (command "color" 40 "donut" "0" "0.15" di "") (initget 128 "G D T") (if (not E) (setq E "T")) (setq Eo (getkword "\n Enter or Select Text Elevations or Select Plyline (Go/Duong/<Text>) : ")) (if Eo (setq E Eo)) (cond ((= E "G") (setq cdo (getreal "\n Cao Do Dau...<0.0>: ")) (setq chc (getreal "\n Chenh Cao Do...<0.5>: ")) (setq cd (atof cdo)) (setq cdi (getreal (strcat "\n Cao do...(<Retern>to end) <" cdo ">:"))) (if cdi (progn (setq cd cdi cdo (rtos (+ cdi (atof chc)) 2 2)) ) (setq cdo (rtos (+ (atof cdo) (atof chc)) 2 2)) ) (setq lcd (cons cd lcd)) (write-line (rtos cd 2 2) tfile) ) ((= E "T") (prompt "\n Selec Elevation Texts...: ") (setq Ele (ssget)) (setq total (- (sslength Ele) 1)) (while (>= total 0) (setq Elist (entget (ssname Ele total))) (cond ((= "TEXT" (cdr (assoc 0 Elist))) (setq cd (atof (cdr (assoc 1 Elist))) lcd (cons cd lcd)) (write-line (rtos cd 2 2) tfile) ) (T nil) ) (setq total (1- total)) ) ) (T (setq en (entget (car (entsel "\CHON DUONG DONG MUC")))) (setq cd (cdr (assoc 39 en)) lcd (cons cd lcd)) (write-line (rtos cd 2 2) tfile) ) ) (setq tti ( + tti 1)) ) (setq n (length ldi) ldi (reverse ldi) i 1 hso (/ tbd 1000.0) ldii ldi) (while (< i n) (setq d1 (nth 0 ldii) d2 (nth 1 ldii)) (setq kc (* (distance d1 d2) hso) lkc (cons kc lkc)) (write-line (rtos kc 2 2) tfile) (setq i (+ i 1) ldii (cdr ldii)) ) (write-line (rtos tim 2 2) tfile) (close tfile) (setq lcd (reverse lcd) lkc (reverse lkc) ltt (reverse ltt)) (command "color" 6 "OSMODE" 0) (setq n (length ldi) io 0 di1 (list (car (nth io ldi)) (cadr (nth 0 ldi)) (nth io lcd)) ldinew (cons di1 ldinew)) (command "PLINE" di1) (while (< io n) (setq di2 (list (car (nth (+ io 1) ldi)) (cadr (nth (+ io 1) ldi))) ldinew (cons di2 ldinew)) (command di2) (setq io (+ io 1)) ) (command "") (setq ma (eval (cons 'MAX lcd)) mi (eval (cons 'MIN lcd)) mss (rtos (- mi 2.0) 2 0)) ) ;******************************************************************************************* (defun vemcn (/ tex a aa tiled tilen ms kcc li2 li22 cdd li1 li11 poin tfw x xx d1 d2 lis1 lis2 ld1 ld2 total k1 k2 to tot tota tee teee) (setq d1 nil k1 nil k2 nil di nil total nil to nil tot nil tota nil tee nil teee nil) (initget 32) (setq tex (getvar "textsize") a (* 6.0 tex) aa (* 3.0 tex)) (setq tvd (getreal "\n Tile Dung Ve MCN: ")) (setq tvn (getreal "\n Tile Ngang Ve MCN: ")) (setq tiled (/ 1000.0 tvd) tilen (/ 1000.0 tvn) ms (atof mss)) (setq kcc (reverse lkc)) (while kcc (setq li2 (cons (* (nth 0 kcc) tilen) li2)) (setq kcc (cdr kcc)) ) (setq li22 (cons 0 li2) cdd (reverse lcd)) (while cdd (setq li1 (cons (* (- (nth 0 cdd) ms) tiled) li1)) (setq cdd (cdr cdd)) ) (setq li11 (reverse li1)) (COMMAND "LUPREC" 4 "COLOR" 8 "osnap" "None" "PLINETYPE" 1) (setq poin (getpoint "\n Start point... : ")) (setq x (car poin) li11 li1 li22 (cons 0 li2) n (length lkc) i 1 ld1 nil ld2 nil lis1 nil lis2 nil) (while (<= i n) (setq d1 (list x (+ (cadr poin) (nth 0 li11)))) (setq xx (nth 1 li22)) (setq d2 (list (+ x xx) (+ (cadr poin) (nth 1 li11)))) (setq ld1 (cons d1 ld1) ld2 (cons d2 ld2)) (setq li22 (cdr li22) x (+ x (nth 0 li22))) (setq li11 (cdr li11) i (+ i 1)) ) (command "line" poin (setq d1 (polar poin (/ pi 2) (nth 0 li1))) "") (setq lis1 (reverse ld1) lis2 (reverse ld2)) (command "color" 3) (mapcar '(lambda (pt1 pt2) (command ".Pline" pt1 pt2 "")) lis1 lis2) (COMMAND "COLOR" 7) (setq total (eval (cons + li2))) (setq k1 (polar poin (- (/ pi 2)) a)) (setq k2 (polar k1 (- (/ pi 2)) aa)) (command "line" poin (polar poin 0.0 total) "") (command "color" 8 "line" k1 (polar k1 0.0 total) "") (command "line" k2 (polar k2 0.0 total) "" "color" 7) (command ".TEXT" (list (+ (car poin) 0.2)(+ (cadr poin) 0.2)) "0" (strcat "MSS: " (rtos ms 2 2))) (setq li11 (reverse li1) li22 li2) (command ".TEXT" "J" "MC" (setq tee (polar poin (- (/ pi 2)) (/ a 2))) "90" (rtos (nth 0 lcd) 2 2)) (command "color" 8 "line" k1 k2 "") (while li22 (setq to (nth 0 li22)) (command "copy" "L" "" k1 (polar k1 0.0 to)) (setq li22 (cdr li22)) ) (setq li22 (reverse li2) kcc (reverse lkc) cdd (reverse lcd)) (setq teee (polar tee (- (/ pi 2)) (+ (/ a 2) (/ aa 2)))) (while li22 (setq tot (eval (cons + li22))) (setq tota (- (eval (cons + li22)) (/ (nth 0 li22) 2))) (COMMAND "COLOR" 8) (command "line" (setq di (polar poin 0.0 tot)) (polar di (/ pi 2) (nth 0 li11)) "") (COMMAND "COLOR" 7) (command ".TEXT" "J" "MC" (polar tee 0.0 tot) "90" (rtos (nth 0 cdd) 2 2)) (command ".TEXT" "J" "MC" (polar teee 0.0 tota) "0" (rtos (nth 0 kcc) 2 2)) (setq li11 (cdr li11) cdd (cdr cdd)) (setq li22 (cdr li22) kcc (cdr kcc)) ) ) ;------------------------------------------------------------------------------------------ ;----------------------------- Chuong trinh chinh ----------------------------------------- (defun C:Ve-MCN (/ gii mss cdo tt tti tk tim tfr tfw Nhim done datafile filename) (if (= (getvar "cmdecho") 1) (setvar "cmdecho" 0)) (setq datafile nil filename nil ltt nil lkc nil lcd nil) (setq gii (load_dialog "Ve_Mcn.dcl")) (setq done 3) (while (> done 1) (if (not (new_dialog "vemcn" gii)) (exit)) (action_tile "tt" "(Get_tt)") (action_tile "cd" "(Get_cd)") (action_tile "kc" "(Get_kc)") (action_tile "nd" "(Get_nd)(done_dialog 2)") (action_tile "start" "(done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq done (start_dialog)) (cond ((= done 1) (vemcn)) ((= done 2) (nhapdiem)(Get_li)) ) );---dong while (unload_dialog gii) (command "color" "bylayer" "ortho" "on" "osmode" 33 "REDRAW") ) Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
zizpo_hetxang 0 Báo cáo bài đăng Đã đăng Tháng 6 21, 2011 Hề hề hề, Trước hết cám ơn bạn đã dùng lisp do mình viết. Thứ nữa là việc còn lại một số đối tượng không xoay như bản vẽ bạn post là do các polyline của bạn khá phức tạp. Nó có thể có nhiều giao điểm với đường cắt chứ không phải chỉ có một giao điểm. Do vậy mình đã không xét tới trường hợp này. Để mình xét thêm rồi nếu được sẽ bổ sung sau. Bạn cần lưu ý thêm với vái lisp của mình là khi lisp yêu cầu bạn Chon điểm tiếp theo thì bạn cứ việc chọn liên tục sao cho cái polyline mà bạn thấy nó tạo ra bao kín hoặc cắt qua các đối tượng bạn cần xoay. Khi bạn không chọn nữa nó sẽ tự động khép kín lại. Tất cả các đối tượng nằm trong hoặc trên polyline này sẽ được chọn với điều kiện toàn bộ vùng chọn đều thấy được trên màn hình. Một lần nữa cám ơn phản hồi của bạn. Đây là lisp mình đã bổ sung để đảm bảo cắt sạch các polyline. Bạn dùng thử xem sao nhé. Mình đả thử với bản vẽ 111_2 bạn gửi thì thấy ngon lành. Các trường hợp khác mong bạn test thêm. (defun c:xbd (/ p0 pn en en0 en1 ssl ssp en2 en3 pc p p1 p2 pk plst pls ssq gq ans) (vl-load-com) (command "undo" "be") (setq p0 (getpoint "\n Chon diem dau duong cat ") pn (getpoint p0 "\n Chon diem cuoi duong cat ")) (command "line" p0 pn "") (setq en0 (entlast) ssl (ssget "X" (list (cons 0 "*LINE")))) (ve0 ssl) (setq ssp (acet-ss-to-list (ssget "F" (list p0 pn) (list (cons 0 "*LINE"))))) (foreach en2 ssp (setq pls (acet-geom-intersectwith en0 en2 0)) (setq en en2) (if pls (foreach pc pls (command "break" en pc "@") (setq en (entlast)) ) ) ) (setq p (getpoint p0 "\n Chon phia can xoay")) (command "offset" "1" en0 p "") (setq en1 (entlast) p1 (cdr (assoc 10 (entget en1))) pk (cdr (assoc 11 (entget en1))) ) (setq plst (list)) (setq plst (append (list p1) plst)) (command "pline" (while p1 (setq p2 (getpoint p1 "\n Chon diem tiep theo")) (if p2 (progn (setq plst (append (list p2) plst)) (command p1 p2) (setq p1 p2) ) (progn (setq plst (append (list pk) plst)) (command p1 pk ) (setq p1 nil) ) ) ) ) (setq en3 (entlast)) (setq ssq (ssget "CP" plst)) (setq ans (getstring "\n Chon tam quay < A or B >: ")) (setq gq (getreal "\n Nhap goc quay theo do: ")) (command "copy" en0 "" p0 p0) (if (= (strcase ans) "A") (command "rotate" ssq (entlast) "" p0 gq) (command "rotate" ssq (entlast) "" pn gq) ) (command "erase" en1 en3 "") (command "undo" "e") ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun ve0 (ss) (defun suadinhPl(thongtin / index doituong doituongmoi toado) (setq doituong (assoc '38 thongtin) doituongmoi (cons 38 0.) ) (subst doituongmoi doituong thongtin) ) (defun suadinh (thongtin / index doituong doituongmoi toado) (setq thongtinmoi nil) (foreach doituong thongtin (if (and (>= (car doituong) 10) (<= (car doituong) 36) ) (setq doituongmoi (list (car doituong) (cadr doituong) (caddr doituong) 0.0 ) ) (setq doituongmoi doituong) ) (setq thongtinmoi (append thongtinmoi (list doituongmoi))) ) (setq thongtinmoi thongtinmoi) ) (defun tendoituong (ssdt /) (cdr (assoc '0 (entget ssdt))) ) ;;--------------------------------------------- (setq tapdoituong ss ;;;;; (ssget) sodt (sslength tapdoituong) index 0 ta (chr 8) stxoa (strcat ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta ta) stxuly "Xu ly duoc: " ptcu nil ) (repeat sodt (setq ssdt (ssname tapdoituong index) pt (* (/ (* index 1.0) sodt) 100.0) index (1+ index) ) (if (/= pt ptcu) (progn (princ (strcat stxoa stxuly (rtos pt 2 0) "%")) (setq ptcu pt) ) ) (if (or (= (tendoituong ssdt) "SPLINE") (= (tendoituong ssdt) "LINE") (= (tendoituong ssdt) "CIRCLE") (= (tendoituong ssdt) "ARC") (= (tendoituong ssdt) "POLYLINE") (= (tendoituong ssdt) "ELLIPSE") (= (tendoituong ssdt) "TEXT") (= (tendoituong ssdt) "DIMENSION") (= (tendoituong ssdt) "ATTDEF") (= (tendoituong ssdt) "SOLID") (= (tendoituong ssdt) "INSERT") (= (tendoituong ssdt) "ATTRIB") (= (tendoituong ssdt) "HATCH") ) (progn (setq thongtin (entget ssdt) thongtin (suadinh thongtin) ) (entmod thongtin) ) ) (if (= (tendoituong ssdt) "LWPOLYLINE") (progn (setq thongtin (entget ssdt) thongtin (suadinhPL thongtin) ) (entmod thongtin) ) ) (princ) ) ) Hy vọng bạn vừa ý. Chú ý khi chọn điểm tạo polyline sao cho phù hợp với ý bạn nhé. làm phiền bác giúp em chỗ này tý. - khi chương trình yêu cầu nhập góc + người dùng nhập góc- nhập góc xong ơ chổ này em muốn nhờ bác thêm giùm cho một đoạn nữa là ban đã ưng ý chúa nếu chưa thì tiếp tục nhập vào góc mới chương trình xoay lại. giống như lệnh undo cad nhưng mà không undo lại toần bộ mà chỉ phần góc để xoay thôi. cảm ơn bác rất là nhiều Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
duy782006 1.551 Báo cáo bài đăng Đã đăng Tháng 6 21, 2011 Hề hề hề, 1/- Về cái lisp thứ nhất: Khi lisp thông báo "Chon tap hop diem can thay dổi cao do" tức là bạn hiểu việc làm tiếp theo của bạn là phải chọn tập hợp các điểm mà bạn muốn thay đổi cao độ của nó. Khi bạn đọc xong thông báo và hiểu được mình cần làm gi thì bạn nhấn nút OK trên thông báo để tắt n1o đi và lisp tiếp tục chạy. Khi lisp thông báo điểm chọn 1 là nhắc bạn phải chọn một điểm trên màn hình mà điểm đó là một đầu của ô chữ nhật sẽ bao quanh các đối tượng được chọn. Khi lisp thông báo điểm chọn 2 là nhắc bạn chọn điểm mút thứ hai của ô chữ nhật sẽ bao quanh các đối tượng cần chọn. Sau khi bạn đã chọn được hai điểm này thì lisp sẽ chọn tất cả các đối tượng nằm trong ô chữ nhật có đường chéo là đoạn thẳng nối hai điểm bạn vừa chọn, tất nhiên các đối tượng được chọn phải thỏa mãn điều kiện lọc của hàm SSget trong lisp. Bác cứ cho chọn đối tượng kiểu bình thường í bác ạ nó dể chịu hơn cứ chọn kiểu gì thì chọn sau khi kết thúc chọn thì bác thực hiện lọc ra từ kết quả vừa chọn cho nó hay. Kiểu như lọc text từ tập hợp vừa chọn thì như này này bác. (setq SS (ssget "p" '((0 . "TEXT")))) 1 Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
phamthanhbinh 3.146 Báo cáo bài đăng Đã đăng Tháng 6 21, 2011 làm phiền bác giúp em chỗ này tý. - khi chương trình yêu cầu nhập góc + người dùng nhập góc- nhập góc xong ơ chổ này em muốn nhờ bác thêm giùm cho một đoạn nữa là ban đã ưng ý chúa nếu chưa thì tiếp tục nhập vào góc mới chương trình xoay lại. giống như lệnh undo cad nhưng mà không undo lại toần bộ mà chỉ phần góc để xoay thôi. cảm ơn bác rất là nhiều Hề hề hề, Bạn hãy bổ sung đoạn code sau : (setq an1 (getstring "Ban da hai long??? <Y or N>: ")) (while (= (strcase an1) "N") (command "undo" "1") (setq gq (getreal "/n Nhap goc quay moi: ")) (if (= (strcase ans) "A") (command "rotate" ssq (entlast) "" p0 gq) (command "rotate" ssq (entlast) "" pn gq) ) (setq an1 (getstring "\n Ban da hoan toan hai long <Y or N>: ")) ) vào ngay trên dòng code: (command "erase" en1 en3 "") Hy vọng đúng ý bạn. 1 Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
phamthanhbinh 3.146 Báo cáo bài đăng Đã đăng Tháng 6 21, 2011 (Đă chỉnh sửa) Bác cứ cho chọn đối tượng kiểu bình thường í bác ạ nó dể chịu hơn cứ chọn kiểu gì thì chọn sau khi kết thúc chọn thì bác thực hiện lọc ra từ kết quả vừa chọn cho nó hay. Kiểu như lọc text từ tập hợp vừa chọn thì như này này bác. (setq SS (ssget "p" '((0 . "TEXT")))) Hề hề hề, Sở dĩ mình làm vầy là vì muốn sử dụng một vùng chọn cho cả hai tập đối tượng là tập psl và tsl bác Duy ạ. Như vậy sẽ hạn chế bớt được các đối tượng ngoại lai do hai vùng chọn khác nhau. Cũng vì hai tập chọn này khác nhau nên không dùng với tham số p được. Nếu muốn sử dụng như bác gợi ý thì sẽ phải làm thành ba tập chọn. Tập chọn thứ nhất là tất cả các đối tượng trong vùng chọn, tập chọn thứ hai là tập chọn chỉ gồm các point có trong tập chọn thứ nhất, tập chọn thứ 3 chỉ gồm các text trong tập chọn thứ nhất. Và các bước kế tiếp sẽ áp dụng với tập chọn thứ hai và tập chọn thứ ba bác nhể. Để lisp chạy mát ga hơn, nhất là trong trường hợp vùng chọn lớn và số đối tượng cực nhiều thì mình đang nghĩ tới giải pháp lấy tập chọn tsl tùy theo mỗi point thuộc tập psl bác ạ. Như vậy lisp sẽ phóng một phát từ Sài gòn ra Quảng ngãi trong vài giây bác hỉ???? Hề hề hề,.... Bác thử xem cái ni mình đã sửa lại theo ý trên: ;; free lisp from cadviet.com ;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=13203&st=3840 (defun c:chgev (/ ) (vl-load-com) (command "undo" "be") (setq UC (getvar "ucsname")) (command "ucs" "World") (alert "\n Chon tap hop diem can thay doi cao do") (setq psl (acet-ss-to-list (ssget (list (cons 0 "POINT"))))) ;;;; (setq tsl (acet-ss-to-list (ssget "W" pt1 pt2 (list (cons 0 "TEXT"))))) (setq hs (getreal "\n Nhap hang so tinh toan: ")) (if (not key_ctnc1) (setq key_ctnc1 "C")) (initget "c t n h") (setq key_ctnc (getkword (strcat "\Cong/Tru/Nhan/cHia [C/T/N/H] <" key_ctnc1 ">: "))) (if (not key_ctnc) (setq key_ctnc key_ctnc1) (setq key_ctnc1 key_ctnc)) (foreach p psl (setq p0 (cdr (assoc 10 (entget p)))) (setq pt1 (list (- (car p0) 1) (- (cadr p0) 2))) (setq pt2 (list (+ (car p0) 1) (+ (cadr p0) 2))) (setq tsl (acet-ss-to-list (ssget "C" pt1 pt2 (list (cons 0 "TEXT"))))) (foreach txt tsl (setq p1 (cdr (assoc 11 (entget txt)))) (if (= (cadr p1) (cadr p0)) (progn (if (equal (- (car p0) (car p1)) 0.4 0.001) (progn (setq el1 (entget txt)) (setq t1 (cdr (assoc 1 el1))) ) ) (if (equal (- (car p1) (car p0)) 0.4 0.001) (progn (setq el2 (entget txt)) (setq t2 (cdr (assoc 1 el2 ))) ) ) ) ) ) (if (and t1 t2) (progn (setq num (congtrunhanchia key_ctnc (atof (strcat t1 "." t2)) hs)) ;;;;;;;;;;;; (- (atof (strcat t1 "." t2)) hs)) (setq htxt (rtos num 2 2) vt (vl-string-position (ascii ".") htxt) t3 (substr htxt 1 vt) t4 (substr htxt (+ vt 2)) el1 (subst (cons 1 t3) (assoc 1 el1) el1) el2 (subst (cons 1 t4) (assoc 1 el2) el2) ) (entmod el1) (entmod el2) ) ) ) (command "ucs" uc) (command "undo" "e") (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;; (defun congtrunhanchia (pheptinh sohang1 sohang2 / kq) (cond ((= (strcase pheptinh) "C") (setq kq (+ sohang1 sohang2))) ((= (strcase pheptinh) "T") (setq kq (- sohang1 sohang2))) ((= (strcase pheptinh) "N") (setq kq (* sohang1 sohang2))) ((= (strcase pheptinh) "H") (setq kq (/ sohang1 sohang2))) ) kq ) Chỉnh sửa Tháng 6 21, 2011 theo phamthanhbinh Bổ sung thêm lisp đã chỉnh sửa Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
zizpo_hetxang 0 Báo cáo bài đăng Đã đăng Tháng 6 21, 2011 Hề hề hề, Bạn hãy bổ sung đoạn code sau : (setq an1 (getstring "Ban da hai long??? <Y or N>: ")) (while (= (strcase an1) "N") (command "undo" "1") (setq gq (getreal "/n Nhap goc quay moi: ")) (if (= (strcase ans) "A") (command "rotate" ssq (entlast) "" p0 gq) (command "rotate" ssq (entlast) "" pn gq) ) (setq an1 (getstring "\n Ban da hoan toan hai long <Y or N>: ")) ) vào ngay trên dòng code: (command "erase" en1 en3 "") Hy vọng đúng ý bạn. tuyệt cú mèo rồi bác. cảm ơn Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
hakhoailang 2 Báo cáo bài đăng Đã đăng Tháng 6 21, 2011 trong lúc thiết kế em gặp phải vấn đề như sau : 1 ) em thiết kế lại độ dốc của cống cho phù hợp với đường tự nhiên mới . nhưng lại phải tính lại độ dốc 1 cách thủ công là vẽ đường ngang dài 100 và bê đường chéo của đọc dốc cần tính lại rồi đo diểm cuối của đường ngang và điển của đường chéo để tính độ dốc . nhờ các bác viết hộ em cái lip với cái ý tưởng như sau : + kích vào độ dốc mới + kích vào text cần thay ( với font của cái độ dốc cũ ) + nếu không có text thì kích vào điểm bất kỳ để tạo têxt 2 ) khi thiết kế xong mặt cắt ngang có những điểm mình cần tính cao độ nhưng phải làm bằng thủ công nên em muốn nhờ các bác viết hộ cái lip tính cao độ với ý tưởng như sau : + chọn điển gốc và nhập cao độ điểm đó + kick vào điểm cần tính cao độ + kick vào teext cần thay + nếu không có text thì kích vào điểm bất kỳ để tạo têxt + kick điểm tiếp theo + kick hết diểm ấn enter đẻ kết thúc lệnh http://www.cadviet.com/upfiles/3/liptinhcaodovadodoc.dwg thank các bác ! Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
phamthanhbinh 3.146 Báo cáo bài đăng Đã đăng Tháng 6 21, 2011 trong lúc thiết kế em gặp phải vấn đề như sau : 1 ) em thiết kế lại độ dốc của cống cho phù hợp với đường tự nhiên mới . nhưng lại phải tính lại độ dốc 1 cách thủ công là vẽ đường ngang dài 100 và bê đường chéo của đọc dốc cần tính lại rồi đo diểm cuối của đường ngang và điển của đường chéo để tính độ dốc . nhờ các bác viết hộ em cái lip với cái ý tưởng như sau : + kích vào độ dốc mới + kích vào text cần thay ( với font của cái độ dốc cũ ) + nếu không có text thì kích vào điểm bất kỳ để tạo têxt 2 ) khi thiết kế xong mặt cắt ngang có những điểm mình cần tính cao độ nhưng phải làm bằng thủ công nên em muốn nhờ các bác viết hộ cái lip tính cao độ với ý tưởng như sau : + chọn điển gốc và nhập cao độ điểm đó + kick vào điểm cần tính cao độ + kick vào teext cần thay + nếu không có text thì kích vào điểm bất kỳ để tạo têxt + kick điểm tiếp theo + kick hết diểm ấn enter đẻ kết thúc lệnh http://www.cadviet.com/upfiles/3/liptinhcaodovadodoc.dwg thank các bác ! Hề hề hề, Quả là có khoai thật. Bạn hãy suy nghĩ kỹ và trình bày thật mạch lạc cái vấn đề của bạn nhé. Mình đã đọc và đã xem cái bản vẽ bạn post lên mà vẫn chả hiểu bạn muốn gì nữa. Này nhé: kích vào độ dốc mới là kích vào cái chi vậy??? vào text độ dốc hay vào cái đường có dộ dốc??? font của dộ dốc cũ là font chi vậy??? phải chăng bạn muốn nói cái text độ dốc mới có cùng font với text độ dốc cũ???? Cái cách tính cao độ của bạn là như thế nào?? Dựa vào tọa độ trên bản vẽ và tọa độ gốc của điểm gốc bạn chọn. ....................... Hy vọng rằng bạn sẽ bổ sung thêm dăm điều kiện nữa để bài toán bạn đặt ra đỡ khoai hơn nhé.... Hề hề hề Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
hakhoailang 2 Báo cáo bài đăng Đã đăng Tháng 6 21, 2011 Hề hề hề, Quả là có khoai thật. Bạn hãy suy nghĩ kỹ và trình bày thật mạch lạc cái vấn đề của bạn nhé. Mình đã đọc và đã xem cái bản vẽ bạn post lên mà vẫn chả hiểu bạn muốn gì nữa. Này nhé: kích vào độ dốc mới là kích vào cái chi vậy??? vào text độ dốc hay vào cái đường có dộ dốc??? font của dộ dốc cũ là font chi vậy??? phải chăng bạn muốn nói cái text độ dốc mới có cùng font với text độ dốc cũ???? Cái cách tính cao độ của bạn là như thế nào?? Dựa vào tọa độ trên bản vẽ và tọa độ gốc của điểm gốc bạn chọn. ....................... Hy vọng rằng bạn sẽ bổ sung thêm dăm điều kiện nữa để bài toán bạn đặt ra đỡ khoai hơn nhé.... Hề hề hề hihi đa tạ bác đã quan tâm . em đã viết lại mong muốn của mình rồi đây http://www.cadviet.com/upfiles/3/bosungdieukien.dwg mong bác giúp đỡ củ khoai hà này , cũng vì do kiến thức hạn hẹp , kỹ thuật lại yếu , muốn nhanh thì phải dung đến lip thank bác nhiều . Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
phamthanhbinh 3.146 Báo cáo bài đăng Đã đăng Tháng 6 21, 2011 hihi đa tạ bác đã quan tâm . em đã viết lại mong muốn của mình rồi đây http://www.cadviet.com/upfiles/3/bosungdieukien.dwg mong bác giúp đỡ củ khoai hà này , cũng vì do kiến thức hạn hẹp , kỹ thuật lại yếu , muốn nhanh thì phải dung đến lip thank bác nhiều . Hề hề hề, Vẫn còn chút khoai hà bạn ạ. Việc chọn điểm trên Cad để ghi ra cao độ không khó xong cách tính cái cao độ ấy ra sao thì mới có cái mà ghi chứ bạn... Nếu chỉ là dựa vào tọa độ của điểm trên bản vẽ để so sánh với tọa độ của điểm mốc rồi ghi ra thì không khó song nó còn liên quan tới vấn đề gì khác nữa thì sao??? Tỷ như cái tỷ lệ của bản vẽ và cái cách nội suy cao độ chẳng hạn.... Hề hề hề, hãy suy nghĩ thêm bạn nhé. Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
gasmanc 1 Báo cáo bài đăng Đã đăng Tháng 6 22, 2011 Hề hề hề, Cách chạy lisp thứ nhất mình đã nói khá rõ rồi. bạn cứ chạy đúng như thế là Ok vì mình đã chạy thử với cả hai bản vẽ bạn pót lên rồi. Kết quả ngon Nếu bạn vẫn chưa thông thì có thể dùng cái lisp mình đã sửa trong bài post số 3863 phía trên. Lisp mới này sẽ chạy nhanh hơn lisp trước nhất là khi vùng chọn có nhiều point. Với lisp thứ hai, mình đang nghĩ cách giải quyết vấn đề khác với cách bạn nghĩ nhiều. Đó là chả nối hai thằng làm một làm gì mà ngược lại là chuyển từ hai text thành 3 text, tức là thêm một thằng cu text "." nữa và đặt thằng cu này vào trung cái point. Vấn đề cộng trừ nhân chia chi đó thì đã giải quyết được trong lisp thứ nhất rồi. Tuy nhiên cũng cần chút thời gian chứ chẳng thể có ngay cho bạn được. Hề hề hề, hãy chịu khó đợi thêm chút nữa hỉ..... Và đây là cái lisp chuyển các text về thẳng hàng dạng A.B thỏa mãn yêu cầu của bạn nhưng không phải là một text mà là bao gồm 3 text riêng biệt.Lisp này cũng thực hiện các phép tính với hằng số cho trước như lisp cũ và trả ra là kết quả đã được tính toán. Nếu bạn muốn giá trị cao độ không đổi thì nhập hằng số tính toán là 0 với phép tính là cộng hay trừ hoặc nhập hằng số tính toán là 1 với các phép tính là nhân hay chia. Bạn hãy dùng thử và cho ý kiến nha. ;; free lisp from cadviet.com ;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=13203&st=3840 (defun c:chgev (/ psl tsl hs key_ctnc1 key_ctnc p0 p1 el1 el2 t1 t2 t3 t4 ts htxt num vt ) (vl-load-com) (command "undo" "be") (setq UC (getvar "ucsname")) (command "ucs" "World") (alert "\n Chon tap hop diem can thay doi cao do") (setq psl (acet-ss-to-list (ssget (list (cons 0 "POINT"))))) ;;;; (setq tsl (acet-ss-to-list (ssget "W" pt1 pt2 (list (cons 0 "TEXT"))))) (setq hs (getreal "\n Nhap hang so tinh toan: ")) (if (not key_ctnc1) (setq key_ctnc1 "C")) (initget "c t n h") (setq key_ctnc (getkword (strcat "\Cong/Tru/Nhan/cHia [C/T/N/H] <" key_ctnc1 ">: "))) (if (not key_ctnc) (setq key_ctnc key_ctnc1) (setq key_ctnc1 key_ctnc)) (foreach p psl (setq p0 (cdr (assoc 10 (entget p)))) (setq pt1 (list (- (car p0) 1) (- (cadr p0) 2))) (setq pt2 (list (+ (car p0) 1) (+ (cadr p0) 2))) (setq tsl (acet-ss-to-list (ssget "C" pt1 pt2 (list (cons 0 "TEXT"))))) (foreach txt tsl (setq p1 (cdr (assoc 11 (entget txt)))) (if (= (cadr p1) (cadr p0)) (progn (if (equal (- (car p0) (car p1)) 0.4 0.001) (progn (setq el1 (entget txt)) (setq t1 (cdr (assoc 1 el1))) ) ) (if (equal (- (car p1) (car p0)) 0.4 0.001) (progn (setq el2 (entget txt)) (setq t2 (cdr (assoc 1 el2 ))) ) ) ) ) ) (if (and t1 t2) (progn (entmake (list (cons 0 "text") (assoc 8 el2) (cons 10 p0) (cons 11 p0) (assoc 40 el2) (assoc 7 el2) (cons 1 ".") (cons 72 1))) (setq ts (entlast)) (setq el2 (subst (cons 73 0) (assoc 73 el2) el2) el2 (subst (cons 10 (cdr (assoc 11 el2))) (assoc 10 el2) el2)) (entmod el2) (setq num (congtrunhanchia key_ctnc (atof (strcat t1 "." t2)) hs)) ;;;;;;;;;;;; (- (atof (strcat t1 "." t2)) hs)) (setq htxt (rtos num 2 2) vt (vl-string-position (ascii ".") htxt) t3 (substr htxt 1 vt) t4 (substr htxt (+ vt 2)) el1 (subst (cons 1 t3) (assoc 1 el1) el1) el2 (subst (cons 1 t4) (assoc 1 el2) el2) ) (entmod el1) (entmod el2) ) ) ) (command "ucs" uc) (command "undo" "e") (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;; (defun congtrunhanchia (pheptinh sohang1 sohang2 / kq) (cond ((= (strcase pheptinh) "C") (setq kq (+ sohang1 sohang2))) ((= (strcase pheptinh) "T") (setq kq (- sohang1 sohang2))) ((= (strcase pheptinh) "N") (setq kq (* sohang1 sohang2))) ((= (strcase pheptinh) "H") (setq kq (/ sohang1 sohang2))) ) kq ) Chúc bạn vui cảm ơn bạn. Cách giải quyết vấn đề bằng cách cho thêm 1 text "." rất hay. Mình đã test thử. lisp chạy ngon. Mình cũng đã tìm ra nguyên nhân tại sao lisp 1 không chạy. Đó là do nó không làm việc trong cad 2005. Chạy trên bản 04 thì ok rồi. chờ tin bạn hoàn thành lisp thứ 2. hì hì. Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
hakhoailang 2 Báo cáo bài đăng Đã đăng Tháng 6 22, 2011 Hề hề hề, Vẫn còn chút khoai hà bạn ạ. Việc chọn điểm trên Cad để ghi ra cao độ không khó xong cách tính cái cao độ ấy ra sao thì mới có cái mà ghi chứ bạn... Nếu chỉ là dựa vào tọa độ của điểm trên bản vẽ để so sánh với tọa độ của điểm mốc rồi ghi ra thì không khó song nó còn liên quan tới vấn đề gì khác nữa thì sao??? Tỷ như cái tỷ lệ của bản vẽ và cái cách nội suy cao độ chẳng hạn.... Hề hề hề, hãy suy nghĩ thêm bạn nhé. http://www.cadviet.com/upfiles/3/bosungdieukien.dwg anh có thể giúp em về phần độ dốc cái cống đã vì hiện tại em cần cái đó lắm. còn cái cao độ thì em đã nhờ bạn em viết 1 cái lip cũng đúng như mong muốn vì bạn em cũng đã từng gặp trường hợp như vậy nhưng cũng chỉ mò mẫm hay mót gì đó nên nó ko hoàn chỉnh . em đua code nó lên đây anh xem và rút gon cho em cái . hoặc lược bỏ phần không cần thiết vì khi chạy nó thì nó chống với tất cả các lip khác mới đau em ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setq sc 1) (setvar "dimzin" 0) (defun c:os () (setvar "osmode" 545)) ;;;;;=============================== ;; Silent load. (princ) (defun c:e1 () (command "erase" "all" "")) (defun c:+++++ () (command "'.zoom" "8x")) (defun c:++++++ () (command "'.zoom" "16x")) (defun c:++++ () (command "'.zoom" "4x")) (defun c:+++ () (command "'.zoom" "2x")) (defun c:++ () (command "'.zoom" "1.5x")) (defun c:+ () (command "'.zoom" "1.2x")) (defun c:- () (command "'.zoom" "0.9x")) (defun c:-- () (command "'.zoom" "0.5x")) (defun c:--- () (command "'.zoom" "0.2x")) (defun c:---- () (command "'.zoom" "0.1x")) (defun c:----- () (command "'.zoom" "0.05x")) (defun c:------ () (command "'.zoom" "0.01x")) (defun c:1 () (ssget) (command "change" "p" "" "p" "c" "1" "")) (defun c:2 () (ssget) (command "change" "p" "" "p" "c" "2" "")) (defun c:3 () (ssget) (command "change" "p" "" "p" "c" "3" "")) (defun c:4 () (ssget) (command "change" "p" "" "p" "c" "4" "")) (defun c:5 () (ssget) (command "change" "p" "" "p" "c" "5" "")) (defun c:6 () (ssget) (command "change" "p" "" "p" "c" "6" "")) (defun c:7 () (ssget) (command "change" "p" "" "p" "c" "7" "")) (defun c:8 () (ssget) (command "change" "p" "" "p" "c" "8" "")) (defun c:9 () (ssget) (command "change" "p" "" "p" "c" "9" "")) (defun c:10 () (ssget) (command "change" "p" "" "p" "c" "10" "")) (defun c:11 () (ssget) (command "change" "p" "" "p" "c" "11" "")) (defun c:0 () (ssget) (command "change" "p" "" "p" "c" "BY LAYER" "")) ;********************************************************************** (defun c:goc () (setvar "cmdecho" 0) ;(setq osm (getvar "osmode")) (if (= sc nil)(setq sc (getreal (strcat"\nChon ty le ve (=kt ve/kt Autocad):")))) (prompt "\n*****Chu y: Ty le hien tai la*****:")(princ sc) ;(if (/= sc2 nil)(setq sc sc2)) (command ".zoom" "e") ;(setq sspl (SSGET "c" '(10.5 20.25) '(10.5 27.5) (LIST(CONS 0 "lwpolyline"))));su dung khi ban ve co 1 cn o toa do co dinh ;(if (= th nil) (setq th (ssget "w" '(10.5 19.25 0) '(11.5 18.00 0) (list(cons 0 "TEXT"))))) (command "zoom" "p") (if (and (= a nil)(/= sspl nil))(setq a (cdr(assoc 10 (entget (ssname sspl 0)))))) (IF (= a nil) (setq a (Getpoint "\n Chon mot diem lam chuan (co cao do):")) (progn (setq kitu nil) (initget "Co Khong") (setq kitu (getkword "\n Ban co chon lai diem chuan khong?[Co/Khong]:<K>")) (If (= kitu "Co")(setq a (Getpoint "\n Chon lai diem lam chuan (co cao do):"))) ) ) ;(if (and(= nil g)(/= nil th)) (setq g (atof (cdr (ASSOC 1 (ENTGET (SSNAME th 0))))))) (IF (= nil g) (progn (prompt "Khong co cao do tai vi tri can tim!") (setq g (Getreal "\n Nhap cao do diem chuan [bang ban phim/Chon tren man hinh]:<Chon>" )) (if (= nil g) (progn (setq sscd (entsel "\n Moi ban chon cao do tren man hinh:")) (setq g (atof (cdr (assoc 1 (entget (car sscd)))))) (prompt (strcat "\n Cao do da chon:<"(rtos g 2 3) ">:")) ) ) ) (If(= kitu "Co") (progn (setq g (Getreal "\n Nhap lai cao do diem chuan [bang ban phim/Chon tren man hinh]:<Chon>" )) (if (= nil g) (progn (setq sscd (entsel "\n Moi ban chon lai cao do tren man hinh:")) (setq g (atof (cdr (assoc 1 (entget (car sscd)))))) (prompt (strcat "\n Cao do da chon:<"(rtos g 2 3) ">:")) ) ) ) ) ) ) ;;============Tinh cao do khi biet cao do diem chon lam c:goc==================== (defun c:tcd () (PROMPT "\n(Lenh tinh toa do & K/C 1 diem bat ky)") (c:goc) (setq xa (* sc (car a))) (setq ya (* sc (cadr a))) (setq l1 xa) (setq l3 ya) (While (setq b (Getpoint "\n Chon diem can tinh:")) (setq xb (* sc (car B))) (setq x (- xb xa)) (setq yb (* sc (cadr B))) (setq y (+ g (- yb ya))) (setq ypr (rtos y 2 3)) (setq l2 xb) (setq l4 yb) (setq dy (- l4 l3)) (setq l3 l4) (setq l (- l2 l1)) (setq ypr1 (rtos L 2 3)) (setq l1 l2) (Prompt "\nCao do diem vua chon:") (princ (rtos y 2 3)) (Prompt "\nK/C x le:") (princ (rtos l 2 3)) (Prompt " _ K/C x den diem goc:") (princ (rtos x 2 3)) (if (= 0 l) (Prompt " _ Do doc doan vua chon: E%") (Progn (setq dd (* 100 (/ dy l))) (Prompt " _ Do doc doan vua chon:")(princ (rtos dd 2 3))(princ "%") ) ) ;(setq pt2 (getpoint "\nDiem ghi cao do vua tinh duoc :")) ;(command "TEXT" pt2 "" "90" ypr) ;(setq pt3 (getpoint "\nDiem ghi K/C le vua tinh duoc :")) ;(command "TEXT" pt3 "" "90" ypr1) ;(setq a '(0 0 0) g 0) (setq thchon (nentselp"\nChon text can thay the:")) (if (/= nil thchon) (progn (setq ens (car thchon)) (COMMAND "CHANGE" ens "" "" "" "" "" ""(rtos y 2 2)) (COMMAND "CHANGE" ens "" "p" "c" "6" "") ) ) (princ) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
phamthanhbinh 3.146 Báo cáo bài đăng Đã đăng Tháng 6 22, 2011 cảm ơn bạn. Cách giải quyết vấn đề bằng cách cho thêm 1 text "." rất hay. Mình đã test thử. lisp chạy ngon. Mình cũng đã tìm ra nguyên nhân tại sao lisp 1 không chạy. Đó là do nó không làm việc trong cad 2005. Chạy trên bản 04 thì ok rồi. chờ tin bạn hoàn thành lisp thứ 2. hì hì. Hề hề hề, Bạn chờ cái chi nữa nhỉ??? Với hai cái lisp mình đã gửi, nếu bạn chú ý khi dùng thì hoàn toàn có thể thỏa mãn cả 3 yêu cầu bạn đã đặt ra rồi. Này nhé: Với yêu cầu 1: Bạn chạy cái lisp thứ 2 nhưng khi lisp hỏi nhập hằng số tính toán thì bạn nhập 0 và chọn phép tính cộng là OK. Với yêu cầu 2: Bạn chạy cái lisp thứ 2 và nhập hằng số tính toán, phép tính theo ý bạn là Ok Với yêu cầu 3: Bạn chạy cái lisp thứ 1 là OK. Vậy thì bạn còn chờ chi nữa mà không dùng thử chúng coi sao hỉ??? 1 Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
