tientracdia
-
Số lượng nội dung
145 -
Đã tham gia
-
Lần ghé thăm cuối
Bài đăng được đăng bởi tientracdia
-
-
Do nhu cầu công việc mà Bạn.
Rất mong được bạn giúp. Cám ơn
-
Xin chào Các Pro.
Xin nhờ giúp lisp nội suy cao độ trên tập hợp chọn các điểm. Yêu cầu chọn các điểm texxt ( cao độ ), lisp nhớ các cao độ đó, vẻ các đường thẳng theo qui luật tạo tam giác, chọn điểm cần nội suy thì lisp tính các cao độ trên tam giác để nội suy cao độ liền kề và ghi ra cao độ tại điểm đó.
-
Lisp của bạn đây. Vùng kín hay hở đều chơi hết.File xuất ra gồm có STT X Y và nội dung Text
;========LISP OUTPUT TEXT BEN TRONG PLINE========== ;=============KANGKUNG 28/03/2013================== (defun C:KK() (setq plst (acet-geom-vertex-list (car (entsel "\n Select pline:\n")))) (setq plst1 (vl-sort plst '(lambda (e1 e2) (if (/= (car e1) (car e2)) (< (car e1) (car e2)) (< (cadr e1) (cadr e2)))))) (setq X_min(car (nth 0 plst1)) X_max(car (last plst1))) (setq plst2 (vl-sort plst '(lambda (e1 e2) (if (/= (cadr e1) (cadr e2)) (< (cadr e1) (cadr e2)) (< (car e1) (car e2)))))) (setq Y_min(cadr (nth 0 plst2)) Y_max(cadr (last plst2))) (command "ZOOM" (list X_min Y_min) (list X_max Y_max)) (setq taphop (ssget "CP" plst '((0 . "TEXT")))) (if (not Path) (setq Path(getvar "dwgprefix"))) (setq file(getfiled "Output File" Path "csv" 11) Path file) (setq file_out(open file "W")) (setq index 0) (while (< index (sslength taphop)) (setq TEXT (entget (ssname taphop index))) (if (= (+ (cdr(assoc 72 TEXT)) (cdr(assoc 73 TEXT))) 0) (setq InsertPoint(cdr(assoc 10 TEXT))) (setq InsertPoint(cdr(assoc 11 TEXT)))) (setq String(cdr(assoc 1 TEXT))) (write-line (strcat (rtos (+ index 1) 2 0) "," (rtos (car InsertPoint) 2 3) "," (rtos (cadr InsertPoint) 2 3) "," String) file_out) (setq index (+ index 1)) ) (close file_out) (alert "Well done!") ) (princ "\n Written By KangKung - 28/03/2013\n") (princ "\n Nhap KK de chay chuong trinh\n")Cám ơn bạn KangKung về Lisp trên,
Mính có một file tọa độ điểm gồm : lớp điểm ( dạng point ) là tọa độ x,y ; lớp Số thứ tụ điểm, lớp cao độ , lớp code dạng ghi chú về điểm đó ( dạng text),
Xin nhờ Bạn giúp mình Lisp xuất : điểm point , text ra excel theo từng điểm theo hàng như sau : Số thứ tụ điểm đó - tọa độ X - tọa độ Y - Ghi chú. ( X,Y theo điểm point ).
File gởi kèm
http://www.cadviet.com/upfiles/3/114381_xuat_ra_excel.dwg
Cám ơn
-
Hề hề hề,
Cấu trúc cái lisp bạn gửi khá giống với cái líp của mình. Mình đã test trên bản vẽ bạn gửi thì kết quả rất ngon lành. Vì sao bạn lại test không được nhỉ??? Hãy gửi cái bản vẽ bạn đã test lên để mình kiểm tra nhé. Việc sửa cái lisp bạn gửi không khó nhưng chỉ sợ vẫn không phù hợp yêu cầu của bạn nếu như bạn không gửi cái bản vẽ của bạn lên.
Hề hề hề,...
Xin lỗi, xin thứ lỗi.
Mình nhầm lớp chính của vòng tròn, do mình thay đổi nên lisp xtcd.lsp không nhận ra. Mình đã chỉnh lại xong và chạy tốt.
Cám ơn bạn nhiều nha.
Nhưng mình vẫn lo về cấu trúc lọc màu cũa Bạn. Có cách nào khác nữa không bạn ?
Mong được Bạn giúp.
-
Hề hề hề,
Không xuất được là do bạn chưa làm đúng theo ý của bác Kang Kung. bạn phải sử dụng lisp #3 của bác ấy để chuyển các nhóm tẽt này thành block thuộc tính đã bạn ạ.
Đây là líp có thể xuất thẳng các nhóm text này ra file csv, bạn hãy thử xem sao.
Tuy nhiên mình khuyên bạn nên sử dụng các block thuộc tính thì sẽ thuận lợi cho quá trình sử dụng bản vẽ và số liệu sau này hơn Việc mình làm lisp này chỉ đáp ứng cho nhu cầu trước mắt của bạn chứ không hẳn đã là tối ưu cho bạn. hãy chọn cho mình phương án tối ưu nhất.
(defun c:xtdc ( / sst ssn fn fid pt d t1 t2 t3 t4 )(vl-load-com)(setq sst (acet-ss-to-list (ssget (list (cons 0 "Circle") (cons 8 "Main_CircleKQ") (cons 62 83))))fn (getfiled "Chon file de save" "" "csv" 1)fid (open fn "w"))(foreach en sst(setq pt (cdr (assoc 10 (entget en)))d (cdr (assoc 40 (entget en)))ssn (acet-ss-to-list (ssget "w" (list (- (car pt) d) (- (cadr pt) d)) (list (+ (car pt) d) (+ (cadr pt) d))(list (cons 0 "text")))))(foreach enp ssn(cond((= (cdr (assoc 62 (entget enp))) 3) (setq t1 (cdr (assoc 1 (entget enp)))))((= (cdr (assoc 62 (entget enp))) 130) (setq t2 (cdr (assoc 1 (entget enp)))))((= (cdr (assoc 62 (entget enp))) 2) (setq t3 (cdr (assoc 1 (entget enp)))))((= (cdr (assoc 62 (entget enp))) 31) (setq t4 (cdr (assoc 1 (entget enp)))))(t nil )))(setq txt (strcat t1 (chr 44) t2 (chr 44) t3 (chr 44) t4))(write-line txt fid))(close fid)(princ))Hy vọng bạn hài lòng và hãy lưu ý rằng các bản vẽ bạn sử dụng phải có các text cần xuất có các thuộc tính giống như bản vẽ bạn đã post. Nếu không kết quả có thể không như ý do việc lọc text không đúng. Cụ thể trong lisp này mình sử dụng thuộc tính màu của các text để sắp xếp chúng vào file csv.Lisp này vẩn không thể xuất được bạn ơi.
Nếu như bạn chọn thuộc tính lọc theo màu có thể là bị vướng ở một màu nào của bản vẽ trên.
Líp này bạn có xuất ra được không ?
-
Lisp #6 chỉ đúng với trường hợp cụ thể như bản vẽ của bạn gửi thôi. Nếu bạn muốn xuất ngược xuất xuôi số liệu thì tốt nhất là dùng Block Attribute như Lisp #3. Lisp #3 có ưu điểm nữa là nếu bạn vẽ cho lưới 5m, 10m, 100m ... đều được hết, để làm điều đó bạn chỉ cần chỉnh lại vị trí của các Text trong bản vẽ đính kèm mục #3 thôi.
Tiện đây cho bạn cái lisp xuất số liệu Block Attribute từ CAD sang txt. Bạn dùng Lisp #3 và Lisp này là có thể chuyển đổi số liệu từ CAD sang TXT và ngược lại ngon lành rồi.
http://www.cadviet.com/upfiles/3/71162_output_attribute.lsp
;=====LISP CONVERT ATTRIBUTE TO TEXT========== ;=========KANGKUNG 26/03/2013================= (defun C:KK() (IF (NOT PATH) (SETQ PATH (getvar "dwgprefix"))) (setq taphop(ssget '((0 . "INSERT"))) index 0 tenfileout(getfiled "Output File" PATH "txt" 11)) (SETQ PATH tenfileout tenfile(open tenfileout "W")) (write-line "No. Easting Northing STTO CCTC D.TICH K.LUONG" tenfile) (setq i 0) (while (< index (sslength taphop)) (setq enlist (entget (ssname taphop index))i(1+ i) STT(rtos i 2 0) insert_point(cdr(assoc 10 enlist)) CHUOI (strcat STT "\t" (rtos (car insert_point) 2 3) "\t" (rtos (cadr insert_point) 2 3)) EN2(ENTNEXT(ssname taphop index)) ENLIST2(ENTGET EN2)) (while (/= (cdr(assoc 0 enlist2)) "SEQEND") (SETQ VALUE(cdr(assoc 1 enlist2)) TAG(cdr(assoc 2 enlist2)) CHUOI(STRCAT CHUOI "\t" VALUE) en2(entnext en2) enlist2(entget en2)) ) (write-line CHUOI tenfile) (setq index (+ index 1)) ) (alert (strcat (rtos i 2 0) " objects converted!")) (princ) (close tenfile) (COMMAND "NOTEPAD" tenfileout) ) (princ "\n Written By KangKung - 26/03/2013\n") (princ "\n Nhap KK de chay chuong trinh\n")Vẫn không xuất ra txt được bạn ơi. Bạn xem lại giúp
-
Lisp này tuyệt quá rồi KangKung ơi. Cám ơn nhiều nha. Cho mình xin hỏi thêm tí. Vòng tròn trên mình dùng cho kí hiệu ô lưới 10 m, nếu có sự thay đổi kích cở của vòng tròn ( Ô lưới 5m ) Lisp có bị ảnh hưởng gì không ?? nhờ bạn giúp. Bạn viết Lisp hay qua, xin giải thích giúp mình các dòng lệnh của lisp này để mình học tâp với. ;;----------------------------------------------------------------- Xin phép bạn đừng nghĩ là mình thế này nọ nha... Nhờ bạn giúp mình Lisp : xuất ngược các nội dung từ Cad ( Theo mẫu cũ trên ) ra Excel với các nội dung STTO - CCTC - DIENTICH - KHOILUONG Trong vòng tròn ra Excel theo theo từng hàng, file xuất nằm cùng thư mục và cùng tên của cad . Rất Cám ơn
-
Thêm 1 Lisp nữa cho bạn đây.
http://www.cadviet.com/upfiles/3/71162_update_so_lieu_tu_excel_vao_cad.lsp
Lệnh KK nhé. Sau đó chọn file số liệu (chuyển sang dạng txt ngăn cách bởi dấu tab hoặc space) rồi chọn số liệu trên bản vẽ.
Tuy nhiên để chạy lisp này thì bạn copy file sau đây vào thư mục Support trong CAD
http://www.cadviet.com/upfiles/3/71162_a.dwg
;========LISP UPDATE SO LIEU TU FILE TXT VAO CADU========== ;================KANGKUNG 25/03/2013======================= (defun C:KK() (command "UNDO" "BE") (setq os(getvar "OSMODE")) (setvar "OSMODE" 0) (if (not Path) (setq Path(getvar "dwgprefix"))) (setq file(getfiled "Select File:" Path "txt" 2)) (setq Path file) (setq taphop(ssget '((0 . "TEXT")))) (setq index 0) (setq TEXT_LIST (list)) (while (< index (sslength taphop)) (setq TEXT (entget (ssname taphop index))) (if (/= (read (cdr(assoc 1 TEXT))) (atof (cdr(assoc 1 TEXT)))) (progn (setq String(cdr(assoc 1 TEXT))) (if (= (+ (cdr(assoc 72 TEXT)) (cdr(assoc 73 TEXT))) 0) (setq InsertPoint(cdr(assoc 10 TEXT))) (setq InsertPoint(cdr(assoc 11 TEXT))) ) (setq TEXT_LIST (append (list (list String InsertPoint)) TEXT_LIST)) ) ) (setq index (1+ index)) ) (setq file_in(open file "R")) (setq lst_solieu(list)) (while(setq txt(read-line file_in)) (if (/= txt nil) (setq lst (read (strcat "(" txt ")" )))) (foreach dt TEXT_LIST (if (= (car dt) (vl-princ-to-string(car lst))) (command "insert" "a" (cadr dt) "1" "1" "0" (vl-princ-to-string(car lst)) (vl-princ-to-string(cadr lst)) (vl-princ-to-string(caddr lst)) (vl-princ-to-string(cadddr lst))) ) ) ) (COMMAND "ERASE" TAPHOP "") (close file_in) (setvar "OSMODE" os) ) (princ "\n Written By KangKung - 25/03/2013\n") (princ "\n Nhap KK de chay chuong trinh\n")Lisp của bạn thì xuất nội dung thuộc tính cần phải nhập vào riêng từng ô thì quá lâu khi mình sửa. Mong bạn xem giúp lại.
Mình muốn quét tất cả các ô, chọn file excel, *.cvs hay *.txt dựa vào tên ô và lisp thay thế vào các ô Cad hàng loat.
Rất mong được sự giúp đỡ. CÁm ơn nhiều.
-
Hề hề hề,
Bạn thử dùng cái này xem có phù hợp không nhé. Sử dụng với file bản vẽ bạn gửi nhé. Nếu OK bạn có thể sử dụng và chỉnh sửa cho phù hợp với các bản vẽ khác nhau.
(defun c:upsl ( / oldos ssc fn f str ans txl txt p0 et1 et2 et3 )(vl-load-com)(setq oldos (getvar "osmode"))(setvar "osmode" 0)(command "undo" "be")(setq ssc (acet-ss-to-list (ssget (list (cons 0 "text") (cons 8 "Main_DTOV") (cons 62 3)))))(setq fn (getfiled "Select Data File" "" "csv" 0)f (open fn "r")ans "Y")(while (and (/= (setq str (read-line f)) nil) (= (strcase ans) "Y") (/= ssc nil) )(setq txl (separate str (chr 44)) )(foreach etxt ssc(setq txt (cdr (assoc 1 (entget etxt))))(if (= txt (nth 0 txl))(progn(setq p0 (cdr (assoc 11 (entget etxt))))(setq et1 (ssname (ssget "w" (list (- (car p0) 2.5) (- (cadr p0) 5)) (list (+ (car p0) 2.5) (+ (cadr p0) 2.5))(list (cons 0 "text") (cons 8 "Main_CDTC") (cons 62 130))) 0)et2 (ssname (ssget "w" (list (- (car p0) 2.5) (- (cadr p0) 5)) (list (+ (car p0) 2.5) (+ (cadr p0) 2.5))(list (cons 0 "text") (cons 8 "Main_DTOV") (cons 62 2))) 0)et3 (ssname (ssget "w" (list (- (car p0) 2.5) (- (cadr p0) 5)) (list (+ (car p0) 2.5) (+ (cadr p0) 2.5))(list (cons 0 "text") (cons 8 "Main_KLOV") (cons 62 31))) 0))(entmod (subst (cons 1 (nth 1 txl)) (assoc 1 (entget et1)) (entget et1)))(entmod (subst (cons 1 (nth 2 txl)) (assoc 1 (entget et2)) (entget et2)))(entmod (subst (cons 1 (nth 3 txl)) (assoc 1 (entget et3)) (entget et3)))(setq ssc (vl-remove etxt ssc))))))(close f)(command "undo" "e")(setvar "osmode" oldos)(princ));;;;;;;;;;;;;;;;;;;;;;;;;;;;(defun Separate (S sym / i L ch)(setq i 0 L nil)(while (< i (strlen S))(setq i (1+ i) ch (substr S i 1))(if (= ch sym) (progn(setqL (append L (list (substr S 1 (- i 1))))S (substr S (1+ i) (- (strlen S) i))i 0))))(append L (list S)));;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;Chúc bạn vui.Cám ơn Bạn. Lisp này chỉ thay được nội dung ở Vị trí CDTC và diện tích, còn vị trí Khối lượng không thay được Bạn ợi.
Mong bạn xem giúp mình với.
-
Vấn đề về màu layer
trong AutoLisp
Cám ơn Bạn. Lisp rất hay.
Xin nhờ bạn viết thêm để chuyển màu, kểu đường và lục nét.
Rất cám ơn
Ví dụ trong lisp cua bạn viết là chọn đối tượng và chọn lóp để chuyển dối tượng đó sang lớp khác khôn g thay đổi màu sắt.
Bạn giúp mình viết thêm là khi chọn đối tượng đó chọn lớp muốn chuyển, thêm mục chọn màu sắt để chuyển, chọn đặt loại đường nét mới cho đối tượng đó và cả lực nét ( độ rộng ) của đường nét đó nếu đối tượng là loai đường nét.
Cám ơn
-
Mình có một file excel và Cad, muốn up nội dung từ excel vào cad theo thứ tự của tên ô trên các vòng tròn kí hiệu.
Dựa và tên ô chèn và thay thế nội dung CCTC, dientich, khoiluong và đúng vị trì nó.File gởi kèm:
Rất mong được giúp đỡ. Cám ơn -
Vấn đề về màu layer
trong AutoLisp
Lệnh là: CHUYENLAY
Nó dài thòn thòn là do làm cho hiện cái bảng danh sách layer hiện có trong bản vẽ để bạn chọn làm layer đích chứ còn bạn muốn chỉ định cố định layer đích thì chỉ cần dùng lệnh: CVML
và sửa
(nth (atoi duy:bienluu_tenlayer) dsso)
Thành "tenlayer" là được!
(defun duy:vht_modau (tieudeht / tieudeht) (setq sogan 2) (setq solistgan 1) (setq solistganb 1) (setq soanhgan 1) (setq soanhggan 1) (setq filedcl (open "D:/htd.dcl" "w")) (write-line (strcat "duyhopthoai : dialog { label = " "\"" tieudeht "\"" "\;") filedcl) (setq filelsp (open "D:/ganhtd.lsp" "w")) (write-line (strcat "\(" "defun ght " "\(" "\)") filelsp) (setq filelsps (open "D:/ganhtds.lsp" "w")) (write-line (strcat "\(" "defun ghts " "\(" "\)") filelsps) (write-line (strcat "\(" "setq phepchon " "\(" "start_dialog" "\)" "\)") filelsps) (write-line (strcat "\(" "cond") filelsps) ) (defun duy:vht_ketthuckhongnut (noidung / noidung) (write-line (strcat ": text {alignment = centered" "\;" " label = " "\"" noidung "\"" "\;" "}") filedcl) (write-line (strcat "}") filedcl) (close filedcl) (write-line "\)" filelsp) (close filelsp) (write-line "\))" filelsps) (close filelsps) ) (defun duy:vht_nutthoat (tennut dorong / tennut dorong) (write-line (strcat ": button {alignment = centered" "\;" " is_cancel = true" "\;" " width = " dorong "\;" " label = " "\"" tennut "\"" "\;" " key = " "\"" " accept" "\"" "\;" " is_default = true" "\;" "}") filedcl) ) (defun duy:vht_textso (tieude dorong lisththi vitrimd gtnhan / tieude dorong lisththi vitrimd gtnhan) (write-line (strcat ": popup_list {alignment = centered" "\;" " edit_width = " dorong "\;" " label = " "\"" tieude "\"" "\;" " key = " "\"" "listthu" (itoa solistgan) "\"" "\;" "}") filedcl) (write-line (strcat "\(" "start_list " "\"" "listthu" (itoa solistgan) "\"" "\)") filelsp) (write-line (strcat "\(" "mapcar " "\'" "add_list " lisththi "\)") filelsp) (write-line (strcat "\(" "end_list" "\)") filelsp) (write-line (strcat "\(" "set_tile " "\"" "listthu" (itoa solistgan) "\" " "\(" "itoa " vitrimd "\)" "\)") filelsp) (write-line (strcat "\(" "action_tile " "\"" "listthu" (itoa solistgan) "\" " "\"" "\(setq " gtnhan " \(get_tile " "\\" "\"" "listthu" (itoa solistgan) "\\" "\"" "\)" "\)" "\"" "\)") filelsp) (setq solistgan (+ solistgan 1)) ) (defun duy:vht_nut (tennut hamgoi dorong / tennut hamgoi dorong) (write-line (strcat ": button {alignment = centered" "\;" " width = " dorong "\;" " label = " "\"" tennut "\"" "\;" " key = " "\"" hamgoi "\"" "\;" "}") filedcl) (write-line (strcat "\(" "action_tile " "\"" hamgoi "\" " "\"" "\(" "done_dialog " (itoa sogan) "\)" "\"" "\)") filelsp) (write-line (strcat "\(" "\(" "= phepchon " (itoa sogan) "\) " "\(" "c:" hamgoi "\)" "\)") filelsps) (setq sogan (+ 1 sogan)) ) (defun duy:vht_goihopthoai (/ nda) (setq DCL_ID (load_dialog "D:/htd.dcl")) (new_dialog "duyhopthoai" DCL_ID) (setq fileganhtd (open "D:/ganhtd.lsp" "r")) (repeat 2 (setq nda (read-line fileganhtd)) ) (close fileganhtd) (cond ((= nda "\)") (start_dialog) (unload_dialog dcl_id)) ((/= nda "\)") (load "D:/ganhtd.lsp") (load "D:/ganhtds.lsp") (ght) (ghts)) ) ) (defun duy:taolist (kieu / kieu nl lkq) (setq lkq'()) (setq nl (tblnext kieu T)) (while nl (setq lkq (append lkq (list (cdr (assoc 2 nl))))) (setq nl (tblnext kieu)) ) lkq) (defun c:chuyenlay () (duy:vht_modau "Chuyen layer") (duy:vht_nut "Chon doi tuong" "cvml" "0") (setq dsso (duy:taolist "layer")) (cond ((= nill duy:bienluu_tenlayer) (setq tenlayerluu "0") (setq duy:bienluu_tenlayer "0")) ((/= nill duy:bienluu_tenlayer) (setq tenlayerluu duy:bienluu_tenlayer)) ) (duy:vht_textso "Layer:" "12" "dsso" tenlayerluu "duy:bienluu_tenlayer") (duy:vht_nutthoat "Thoat" "0") (duy:vht_ketthuckhongnut "Viet boi: Duy782006") (duy:vht_goihopthoai) (Princ)) (defun c:cvml () (princ "Chon cac doi tuong muon chuyen layer !") (setq dchon (ssget)) (setq sttd 0) (while (setq LAY (ssname dchon sttd)) (setq kqcolor (cdr (assoc 62 (entget LAY)))) (Cond ((= kqcolor nill) (setq kqcolor (cdr (assoc 62 (entget (TBLOBJNAME "LAYER" (cdr (assoc 8 (entget LAY)))))))) ) ((/= kqcolor nill) (setq kqcolor kqcolor) ) ) (command "chprop" LAY "" "layer" (nth (atoi duy:bienluu_tenlayer) dsso) "color" kqcolor "") (setq sttd (1+ sttd)) ) (princ))Cám ơn Bạn. Lisp rất hay.
Xin nhờ bạn viết thêm để chuyển màu, kểu đường và lục nét.
Rất cám ơn
-
tôi có 1 đoạn lisp này có thể bạn dùng được:
=================================== TAO CAC LOAI KHUNG MAU BAN VE CO SAN: =================================== (defun C:KHUNG (/ ) (command "cmdecho" 0) (command "osnap" "none") (setq DIEMCHEN (getpoint "CHON GOC TRAI-DUOI BAN VE")) (chenkhungCG DIEMCHEN) ;VE CAC KHUNG TY LE CHUAN DE DINH HUONG (setq MSTL (getreal "\nCHON TY LE BAN VE (BAM SO TUONG UNG T/LE:100;200;250;500;1000;2000): ")) ;XOA CAC KHUNG DINH HUONG (repeat 12 (command "_erase" (ssget "L") "")) ;CHEN MAU HO SO VAO (setq DUONGDAN "c:\\program files\\AutoCAD 2004\\Khung\\") (setq LOAIHS "Khung") (setq TENFILE (strcat LOAIHS (rtos MSTL 2 0) ".dwg")) (ChenBlock DUONGDAN TENFILE DIEMCHEN (/ MSTL 1000)) (prompt "\nDA TAO XONG KHUNG BAN VE!")(command "osnap" "End,Mid,Int,Perp")(Princ) );END DEFUN KHUNG =================================== ;SCALE BAN VE LAM TANG CO CHU KICH THUOC THEO TY LE ;;;================================= (defun SCDim( / e ob OName SF LSF) (while (setq e (ssname ssd 0)) (setq ob (vlax-ename->vla-object e) OName (vla-get-ObjectName ob) SF (vla-get-ScaleFactor ob)) (if (not (wcmatch OName "*AngularDimension")) (progn (setq LSF (vla-get-LinearScaleFactor ob)) (command "dimoverride" "dimlfac" (/ LSF k) "" e ""))) (if (/= opt "N") (command "dimoverride" "dimscale" (* SF k) "" e "")) (ssdel e ssd))) ;========== (defun C:SCC( / ss ssd p k opt)(prompt "\nGo lenh: SCC de phong to hoac thu nho ban ve va kich thuoc ") (vl-load-com) (setq ss (ssget) ssd (ssget "p" '((0 . "DIMENSION"))) p (getpoint "\nTAM DIEM KHI SCALE:") k (getreal "\nSCALE LEN MAY LAN:") ;opt (strcase (getstring "\nDim scale overall? [Yes/No] :")) ) (if (= opt "") (setq opt "N")) (if (> k 1) (progn (command "scale" ss "" p k) (SCDim)) (progn (SCDim) (command "scale" ss "" p k)) ) (prompt "\nDA PHONG TO BAN VE VA KICH THUOC!")(Princ) )
VÀ TẠO CÁC FILE MẪU TỈ LỆ: 1/100; 1/200; 1/250; 1/500; 1/1000; 1/2000.LƯU Ý: TẠO 1 FILE MẪU TỈ LỆ 1/1000, SAU ĐÓ COPY THÀNH CÁC FILE NHƯNG VẪN DỮ NGUYÊN TỈ LỆ 1/1000 VÀ CHỈ SỬA CHỮ TỈ LỆ Ở PHẦN NHƯ HÌNH MINH HỌA KÈM THEO" TỶ LỆ: 1/1*** (Đơn vị cm)" BÊN TRONG BẢN VẼ VÀ XỬ DỤNG LỆNH SCC KÈM THEO ĐỂ SCALE DIM CHO ĐÚNG TỈ LỆ NGOÀI RA KHÔNG ĐƯỢC SCALE KHUNG RỒI LƯU FILE VẬY LÀ OK.
BẢN VẼ SẼ TỰ SCALE KHUNG KHI MÌNH GÕ LỆNH: KHUNG -> NHẬP SỐ TƯƠNG ỨNG VỚI TỈ LỆ 100 HOẶC 200 ...., VÀ NÓ SẼ HIỆN LÊN KHUNG NHƯ MÌNH ĐÃ MẶC ĐỊNH!
NHỚ COPY FILE KHUNG CỦA MÌNH THEO ĐÚNG ĐƯỜNG DẪN VÀO Ổ "c:\\program files\\AutoCAD 2004\\Khung\\"SAU ĐÓ SỬA VÀ LƯU FILE VÀO ĐÓ.
BẢN VẼ KÈM THEO ĐÃ CÓ KÍCH THƯỚC CHUẨN THEO TỪNG TỈ LỆ VÀ BẢN VẼ VẪN GIỮ NGUYÊN TỈ LỆ 1/1000:
Cám ơn Bạn, nhưng sao mình chạy file lisp báo lỗi sau
CHON GOC TRAI-DUOI BAN VE; error: no function definition: CHENKHUNGCG
Xin nhờ Bạn giúp.
Cám ơn
-
Mình có sưu tầm lisp trên Cadviet là SWB_1 : Copy đối đượng trong vùng ( Hình chữ nhật )
Làm thế nào sao khi lisp chọn các đối tượng đó xong, Lisp copy , save as đặt tên mới trong cùng thư mục file chọn để copy trước đó.
File lisp :
(defun c:SWB (/ ov vl bit ss cur ssInside ssOutside ssN ssT ssAll curT plSet) ;SWB -> Sellect With Boundary (defun *error* (msg) (if ov (mapcar 'setvar vl ov)) ; reset Sys vars (princ (strcat "\n<< Error: " msg " >>")) ; Print Error Message (princ) ; Exit Cleanly ) (setq vl '("CMDECHO" "OSMODE" "ORTHOMODE") ; Sys Var list ov (mapcar 'getvar vl)) ; Get Old values (mapcar 'setvar vl '(0 0 0)) ; Turn off CMDECHO, OSMODE, ORTHOMODE (command "_.undo" "_m") (initget "T N G") (setq bit (getkword "\nBan muon chon Trong hay Ngoai duong bao, hay Giua 2 duong bao <T/N/G>: " ) ) (cond ((= bit "T") ;chon Trong duong bao (princ"\n<<< Chon duong bao >>> ") (if (and (setq ss (ssget "_:S" '((0 . "LWPOLYLINE,CIRCLE,ELLIPSE")))) (setq ssInside (GetssInside ss)) (> (sslength ssInside) 0)) (sssetfirst ssInside ssInside) ) ) ((= bit "G") ;chon giua 2 duong bao (princ"\n<<< Chon duong bao ngoai >>> ") (setq ssN (ssget "_:S" '((0 . "LWPOLYLINE,CIRCLE,ELLIPSE")))) (princ"\n<<< Chon duong bao trong >>> ") (setq ssT (ssget "_:S" '((0 . "LWPOLYLINE,CIRCLE,ELLIPSE"))) curT (ssname ssT 0) ssT (GetssInside ssT) ssN (GetssInside ssN)) (if (and ssT (> (sslength ssT) 0) ssN (> (sslength ssN) 0) ) (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssT))) (if (ssmemb e ssN) (ssdel e ssN))) ) (if (ssmemb curT ssN) (ssdel curT ssN)) (sssetfirst ssN ssN) ) ((= bit "N") ;chon Ngoai duong bao (initget "T G") (setq bit (getkword "\nChon Tat ca doi tuong ngoai duong bao, hay chi doi tuong Giao voi duong bao <T/G>: " ) ) (princ"\n<<< Chon duong bao >>> ") (setq ss (ssget "_:S" '((0 . "LWPOLYLINE,CIRCLE,ELLIPSE"))) cur (ssname ss 0)) (if (= bit "T") (progn ;chon Tat ca doi tuong ngoai duong bao (setq ssInside (GetssInside ss) ssAll (ssget "x" (list (cons 410 (getvar "ctab")))) ) (if (and ssInside (> (sslength ssInside) 0) ) (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssInside))) (if (ssmemb e ssAll) (ssdel e ssAll))) ) (if (ssmemb cur ssAll) (ssdel cur ssAll)) (sssetfirst ssAll ssAll) ) ;chi chon doi tuong Giao voi duong bao (if (and (setq ssOutside (GetssOutside ss)) (> (sslength ssOutside) 0)) (sssetfirst ssOutside ssOutside) ) );if );;chon Ngoai duong bao );cond (mapcar 'setvar vl ov) ; reset Sys Vars ;(command "zoom" "e") ;(command ".copy" "");_copyclip ;_pasteorig dan theo toa do ;(setq savefile (getfiled "Chon file .dwg:" "" "dwg" 1)) ;(c:vca1) (princ) ) ;;----------------------------- (defun GetssOutside (ss2 / ptLst cur ssInside lstss1 ss1 ssTouching) (if (and (setq lstss1 (gettouching ss2)) (setq ss1 (ssadd)) (mapcar '(lambda (x) (ssadd x ss1)) lstss1) ) (progn ; co ssTouching (break_with ss1 ss2 nil 0) (setq cur (ssname ss2 0) ssTouching (ssadd) ssOutside (ssadd)) (mapcar '(lambda (x) (ssadd x ssTouching)) (gettouching ss2)) ;loc ssTouching -> ssOutside (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssTouching))) (if (or (not(insidep (vlax-curve-getStartPoint e) cur)) (not(insidep (vlax-curve-getEndPoint e) cur)) (not(insidep (vlax-curve-getPointAtParam e (/(+(vlax-curve-getStartParam e)(vlax-curve-getEndParam e))2)) cur)) );or (ssadd e ssOutside) );if );foreach );progn );if (if (ssmemb cur ssOutside) (ssdel cur ssOutside)) ssOutside ) (defun GetssInside (ss2 / ptLst cur ssInside lstss1 ss1 ssTouching) (setq ptLst (GetPtLst (setq cur (ssname ss2 0))) ssInside (ssget "_WP" ptLst ) ) (if (and (setq lstss1 (gettouching ss2)) (setq ss1 (ssadd)) (mapcar '(lambda (x) (ssadd x ss1)) lstss1) ) (progn ; co ssTouching (break_with ss1 ss2 nil 0) (setq ssTouching (ssadd)) (mapcar '(lambda (x) (ssadd x ssTouching)) (gettouching ss2)) ;loc ssTouching -> ssInside (or ssInside (setq ssInside (ssadd)) ) (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssTouching))) (if (and (insidep (vlax-curve-getStartPoint e) cur) (insidep (vlax-curve-getEndPoint e) cur) (insidep (vlax-curve-getPointAtParam e (/(+(vlax-curve-getStartParam e)(vlax-curve-getEndParam e))2)) cur) ) (ssadd e ssInside) );if );foreach );progn );if (if (ssmemb cur ssInside) (ssdel cur ssInside)) ssInside ) (defun GetPtLst (obj / startparam endparam anginc delta div inc pt ptlst) (defun ZClosed (lst) (if (and (vlax-curve-isClosed obj) (not(equal (car lst)(last lst) 1e-6))) (append lst (list (car lst))) lst)) (or (eq (type obj) 'VLA-OBJECT) (setq obj (vlax-ename->vla-object obj))) (setq typ (vlax-get obj 'ObjectName)) (if (or (eq typ "AcDbCircle") (eq typ "AcDbEllipse")) (progn (setq param 0) (while (< param (* pi 2)) (setq pt (vlax-curve-getPointAtParam obj param) ptlst (cons pt ptlst) param (+ (/ (* pi 2) 72) param)) ) (reverse ptlst) ) (progn ;Pline (eq typ "AcDbPolyline") (setq param (vlax-curve-getStartParam obj) endparam (vlax-curve-getEndParam obj) anginc (* pi (/ 7.5 180.0))) (setq tparam param) (while (<= param endparam) (setq pt (vlax-curve-getPointAtParam obj param)) (if (not (equal pt (car ptlst) 1e-12)) (setq ptlst (cons pt ptlst))) (if (and (/= param endparam) (setq blg (abs (vlax-invoke obj 'GetBulge param))) (/= 0 blg)) (progn (setq delta (* 4 (atan blg)) ;included angle inc (/ 1.0 (1+ (fix (/ delta anginc)))) arcparam (+ param inc)) (while (< arcparam (1+ param)) (setq pt (vlax-curve-getPointAtParam obj arcparam) ptlst (cons pt ptlst) arcparam (+ inc arcparam)))) ) (setq param (1+ param)) ) (if (and (apply 'and ptlst) (> (length ptlst) 1)) (ZClosed (reverse ptlst)) ) ) ) ) ;; Copyright (c) 2009, Lee McDonnell ;; (Contact Lee Mac, CADTutor.net) (defun insidep (pt Obj / Obj Tol ang doc spc flag int lin xV yV) (defun vlax-list->3D-point (lst flag) (if lst (cons ((if flag car cadr) lst) (vlax-list->3D-point (cdddr lst) flag)))) (or (eq 'VLA-OBJECT (type Obj)) (setq Obj (vlax-ename->vla-object Obj))) (if (not(vlax-curve-getParamAtPoint Obj pt)) (progn (setq Tol (/ pi 6) ; Uncertainty ang 0.0 flag T) (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object)) spc (if (zerop (vla-get-activespace doc)) (if (= (vla-get-mspace doc) :vlax-true) (vla-get-modelspace doc) (vla-get-paperspace doc)) (vla-get-modelspace doc))) (while (and (< ang (* 2 pi)) flag) (setq flag (and (setq int (vlax-invoke (setq lin (vla-addLine spc (vlax-3D-point pt) (vlax-3D-point (polar pt ang (if (vlax-property-available-p Obj 'length) (vla-get-length Obj) 1.0))))) 'IntersectWith Obj acExtendThisEntity)) (<= 6 (length int)) (setq xV (vl-sort (vlax-list->3D-point int T) '<) yV (vl-sort (vlax-list->3D-point int nil) '<)) (or (<= (car xV) (car pt) (last xV)) (<= (car yV) (cadr pt) (last yV)))) ang (+ ang Tol)) (vla-delete lin)) flag ) T )) ;;; Author: CopyrightŽ© 2006-2008 Charles Alan Butler ;;; Contact @ www.TheSwamp.org ;;=========================================================================== ;; get all objects touching entities in the sscross ;; limited obj types to "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE" ;; returns a list of enames ;;=========================================================================== (defun gettouching (sscros / ss lst lstb lstc objl) (and (setq lstb (vl-remove-if 'listp (mapcar 'cadr (ssnamex sscros))) objl (mapcar 'vlax-ename->vla-object lstb) ) (setq ss (ssget "_A" (list (cons 0 "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE") (cons 410 (getvar "ctab")))) ) (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) (setq lst (mapcar 'vlax-ename->vla-object lst)) (mapcar '(lambda (x) (mapcar '(lambda (y) (if (not (vl-catch-all-error-p (vl-catch-all-apply '(lambda () (vlax-safearray->list (vlax-variant-value (vla-intersectwith y x acextendnone) )))))) (setq lstc (cons (vlax-vla-object->ename x) lstc)) ) ) objl) ) lst) ) lstc ) ;;; Author: CopyrightŽ© 2006-2008 Charles Alan Butler ;;; Contact @ www.TheSwamp.org (defun break_with (ss2brk ss2brkwith self Gap / cmd intpts lst masterlist ss ssobjs onlockedlayer ssget->vla-list list->3pair GetNewEntities oc get_interpts break_obj GetLastEnt LastEntInDatabase ss2brkwithList ) ;; ss2brk selection set to break ;; ss2brkwith selection set to use as break points ;; self when true will allow an object to break itself ;; note that plined will break at each vertex ;; ;; return list of enames of new objects (vl-load-com) (princ "\nCalculating Break Points, Please Wait.\n") ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ;; S U B F U N C T I O N S ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ;; return T if entity is on a locked layer (defun onlockedlayer (ename / entlst) (setq entlst (tblsearch "LAYER" (cdr (assoc 8 (entget ename))))) (= 4 (logand 4 (cdr (assoc 70 entlst)))) ) ;; return a list of objects from a selection set ;| (defun ssget->vla-list (ss) (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss )))) )|; (defun ssget->vla-list (ss / i ename allobj) ; this is faster, changed in ver 1.7 (setq i -1) (while (setq ename (ssname ss (setq i (1+ i)))) (setq allobj (cons (vlax-ename->vla-object ename) allobj)) ) allobj ) ;; return a list of lists grouped by 3 from a flat list (defun list->3pair (old / new) (while (setq new (cons (list (car old) (cadr old) (caddr old)) new) old (cdddr old))) (reverse new) ) ;;===================================== ;; return a list of intersect points ;;===================================== (defun get_interpts (obj1 obj2 / iplist) (if (not (vl-catch-all-error-p (setq iplist (vl-catch-all-apply 'vlax-safearray->list (list (vlax-variant-value (vla-intersectwith obj1 obj2 acextendnone) )))))) iplist ) ) ;;======================================== ;; Break entity at break points in list ;;======================================== (defun break_obj (ent brkptlst BrkGap / brkobjlst en enttype maxparam closedobj minparam obj obj2break p1param p2param brkpt2 dlst idx brkptS brkptE brkpt result GapFlg result ignore dist tmppt #ofpts 2gap enddist lastent obj2break stdist ) (or BrkGap (setq BrkGap 0.0)) ; default to 0 (setq BrkGap (/ BrkGap 2.0)) ; if Gap use 1/2 per side of break point (setq obj2break ent brkobjlst (list ent) enttype (cdr (assoc 0 (entget ent))) GapFlg (not (zerop BrkGap)) ; gap > 0 closedobj (vlax-curve-isclosed obj2break) ) ;; when zero gap no need to break at end points (if (zerop Brkgap) (setq spt (vlax-curve-getstartpoint ent) ept (vlax-curve-getendpoint ent) brkptlst (vl-remove-if '(lambda(x) (or (< (distance x spt) 0.0001) (< (distance x ept) 0.0001))) brkptlst) ) ) (if brkptlst (progn ;; sort break points based on the distance along the break object ;; get distance to break point, catch error if pt is off end ;; ver 2.0 fix - added COND to fix break point is at the end of a ;; line which is not a valid break but does no harm (setq brkptlst (mapcar '(lambda(x) (list x (vlax-curve-getdistatparam obj2break ;; ver 2.0 fix (cond ((vlax-curve-getparamatpoint obj2break x)) ((vlax-curve-getparamatpoint obj2break (vlax-curve-getclosestpointto obj2break x)))))) ) brkptlst)) ;; sort primary list on distance (setq brkptlst (vl-sort brkptlst '(lambda (a1 a2) (< (cadr a1) (cadr a2))))) (if GapFlg ; gap > 0 ;; Brkptlst starts as the break point and then a list of pairs of points ;; is creates as the break points (progn ;; create a list of list of break points ;; ((idx# stpoint distance)(idx# endpoint distance)...) (setq idx 0) (foreach brkpt brkptlst ;; ---------------------------------------------------------- ;; create start break point, then create end break point ;; ((idx# startpoint distance)(idx# endpoint distance)...) ;; ---------------------------------------------------------- (setq dist (cadr brkpt)) ; distance to center of gap ;; subtract gap to get start point of break gap (cond ((and (minusp (setq stDist (- dist BrkGap))) closedobj ) (setq stdist (+ (vlax-curve-getdistatparam obj2break (vlax-curve-getendparam obj2break)) stDist)) (setq dlst (cons (list idx (vlax-curve-getpointatparam obj2break (vlax-curve-getparamatdist obj2break stDist)) stDist) dlst)) ) ((minusp stDist) ; off start of object so get startpoint (setq dlst (cons (list idx (vlax-curve-getstartpoint obj2break) 0.0) dlst)) ) (t (setq dlst (cons (list idx (vlax-curve-getpointatparam obj2break (vlax-curve-getparamatdist obj2break stDist)) stDist) dlst)) ) ) ;; add gap to get end point of break gap (cond ((and (> (setq stDist (+ dist BrkGap)) (setq endDist (vlax-curve-getdistatparam obj2break (vlax-curve-getendparam obj2break)))) closedobj ) (setq stdist (- stDist endDist)) (setq dlst (cons (list idx (vlax-curve-getpointatparam obj2break (vlax-curve-getparamatdist obj2break stDist)) stDist) dlst)) ) ((> stDist endDist) ; off end of object so get endpoint (setq dlst (cons (list idx (vlax-curve-getpointatparam obj2break (vlax-curve-getendparam obj2break)) endDist) dlst)) ) (t (setq dlst (cons (list idx (vlax-curve-getpointatparam obj2break (vlax-curve-getparamatdist obj2break stDist)) stDist) dlst)) ) ) ;; ------------------------------------------------------- (setq idx (1+ IDX)) ) ; foreach brkpt brkptlst (setq dlst (reverse dlst)) ;; remove the points of the gap segments that overlap (setq idx -1 2gap (* BrkGap 2) #ofPts (length Brkptlst) ) (while (<= (setq idx (1+ idx)) #ofPts) (cond ((null result) ; 1st time through (setq result (list (car dlst)) ; get first start point result (cons (nth (1+(* idx 2)) dlst) result)) ) ((= idx #ofPts) ; last pass, check for wrap (if (and closedobj (> #ofPts 1) (<= (+(- (vlax-curve-getdistatparam obj2break (vlax-curve-getendparam obj2break)) (cadr (last BrkPtLst))) (cadar BrkPtLst)) 2Gap)) (progn (if (zerop (rem (length result) 2)) (setq result (cdr result)) ; remove the last end point ) ;; ignore previous endpoint and present start point (setq result (cons (cadr (reverse result)) result) ; get last end point result (cdr (reverse result)) result (reverse (cdr result))) ) ) ) ;; Break Gap Overlaps ((< (cadr (nth idx Brkptlst)) (+ (cadr (nth (1- idx) Brkptlst)) 2Gap)) (if (zerop (rem (length result) 2)) (setq result (cdr result)) ; remove the last end point ) ;; ignore previous endpoint and present start point (setq result (cons (nth (1+(* idx 2)) dlst) result)) ; get present end point ) ;; Break Gap does Not Overlap previous point (t (setq result (cons (nth (* idx 2) dlst) result)) ; get this start point (setq result (cons (nth (1+(* idx 2)) dlst) result)) ; get this end point ) ) ; end cond stmt ) ; while (setq dlst (reverse result) brkptlst nil) (while dlst ; grab the points only (setq brkptlst (cons (list (cadar dlst)(cadadr dlst)) brkptlst) dlst (cddr dlst)) ) ) ) ;; ----------------------------------------------------- ;; (if (equal a ent) (princ)) ; debug CAB ------------- (foreach brkpt (reverse brkptlst) (if GapFlg ; gap > 0 (setq brkptS (car brkpt) brkptE (cadr brkpt)) (setq brkptS (car brkpt) brkptE brkptS) ) ;; get last entity created via break in case multiple breaks (if brkobjlst (progn (setq tmppt brkptS) ; use only one of the pair of breakpoints ;; if pt not on object x, switch objects (if (not (numberp (vl-catch-all-apply 'vlax-curve-getdistatpoint (list obj2break tmppt)))) (progn ; find the one that pt is on (setq idx (length brkobjlst)) (while (and (not (minusp (setq idx (1- idx)))) (setq obj (nth idx brkobjlst)) (if (numberp (vl-catch-all-apply 'vlax-curve-getdistatpoint (list obj tmppt))) (null (setq obj2break obj)) ; switch objects, null causes exit t ) ) ) ) ) ) ) (setq closedobj (vlax-curve-isclosed obj2break)) (if GapFlg ; gap > 0 (if closedobj (progn ; need to break a closed object (setq brkpt2 (vlax-curve-getPointAtDist obj2break (- (vlax-curve-getDistAtPoint obj2break brkptE) 0.00001))) (command "._break" obj2break "_non" (trans brkpt2 0 1) "_non" (trans brkptE 0 1)) (and (= "CIRCLE" enttype) (setq enttype "ARC")) (setq BrkptE brkpt2) ) ) (if (and closedobj (not (setq brkptE (vlax-curve-getPointAtDist obj2break (+ (vlax-curve-getdistatparam obj2break ;;(vlax-curve-getparamatpoint obj2break brkpts)) 0.00001)))) ;; ver 2.0 fix (cond ((vlax-curve-getparamatpoint obj2break brkpts)) ((vlax-curve-getparamatpoint obj2break (vlax-curve-getclosestpointto obj2break brkpts))))) 0.00001))))) (setq brkptE (vlax-curve-getPointAtDist obj2break (- (vlax-curve-getdistatparam obj2break ;;(vlax-curve-getparamatpoint obj2break brkpts)) 0.00001))) ;; ver 2.0 fix (cond ((vlax-curve-getparamatpoint obj2break brkpts)) ((vlax-curve-getparamatpoint obj2break (vlax-curve-getclosestpointto obj2break brkpts))))) 0.00001))) ) ) ; endif ;; (if (null brkptE) (princ)) ; debug (setq LastEnt (GetLastEnt)) (command "._break" obj2break "_non" (trans brkptS 0 1) "_non" (trans brkptE 0 1)) (and *BrkVerbose* (princ (setq *brkcnt* (1+ *brkcnt*))) (princ "\r")) (and (= "CIRCLE" enttype) (setq enttype "ARC")) (if (and (not closedobj) ; new object was created (not (equal LastEnt (entlast)))) (setq brkobjlst (cons (entlast) brkobjlst)) ) ) ) ) ; endif brkptlst ) ; defun break_obj ;;==================================== ;; CAB - get last entity in datatbase (defun GetLastEnt ( / ename result ) (if (setq result (entlast)) (while (setq ename (entnext result)) (setq result ename) ) ) result ) ;;=================================== ;; CAB - return a list of new enames (defun GetNewEntities (ename / new) (cond ((null ename) (alert "Ename nil")) ((eq 'ENAME (type ename)) (while (setq ename (entnext ename)) (if (entget ename) (setq new (cons ename new))) ) ) ((alert "Ename wrong type.")) ) new ) ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ;; S T A R T S U B R O U T I N E H E R E ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ (setq LastEntInDatabase (GetLastEnt)) (if (and ss2brk ss2brkwith) (progn (setq oc 0 ss2brkwithList (ssget->vla-list ss2brkwith)) (if (> (* (sslength ss2brk)(length ss2brkwithList)) 5000) (setq *BrkVerbose* t) ) (and *BrkVerbose* (princ (strcat "Objects to be Checked: " (itoa (* (sslength ss2brk)(length ss2brkwithList))) "\n"))) ;; CREATE a list of entity & it's break points (foreach obj (ssget->vla-list ss2brk) ; check each object in ss2brk (if (not (onlockedlayer (vlax-vla-object->ename obj))) (progn (setq lst nil) ;; check for break pts with other objects in ss2brkwith (foreach intobj ss2brkwithList (if (and (or self (not (equal obj intobj))) (setq intpts (get_interpts obj intobj)) ) (setq lst (append (list->3pair intpts) lst)) ; entity w/ break points ) (and *BrkVerbose* (princ (strcat "Objects Checked: " (itoa (setq oc (1+ oc))) "\r"))) ) (if lst (setq masterlist (cons (cons (vlax-vla-object->ename obj) lst) masterlist)) ) ) ) ) (and *BrkVerbose* (princ "\nBreaking Objects.\n")) (setq *brkcnt* 0) ; break counter ;; masterlist = ((ent brkpts)(ent brkpts)...) (if masterlist (foreach obj2brk masterlist (break_obj (car obj2brk) (cdr obj2brk) Gap) ) ) ) ) ;;============================================================== (and (zerop *brkcnt*) (princ "\nNone to be broken.")) (setq *BrkVerbose* nil) (GetNewEntities LastEntInDatabase) ; return list of enames of new objects )Rất mong được các bạn giúp
-
Lisp mới tạo viewport cho tất cả hình chữ nhật có cạnh nằm ngang, đứng, ... ngồi
hoặc nghiêng. Sơ qua về các đặc điểm của Lisp này:1. Tạo viewport cho tất cả các khung hình chữ nhật
2. Thêm lựa chọn Xref khung tên bản vẽ
3. Các viewport được sắp xếp theo phương đứng thay vì phương ngang như các Lisp trước
Bác nào có nhu cầu thì down về rồi test thử và cho ý kiến nhé.
http://www.cadviet.com/upfiles/3/71162_mtl_rev5.lsp
P/S: Lisp này sẽ giảm rất nhiều thao tác và thời gian cho những ai biên tập bản đồ khu vực rộng đặc biệt là bản đồ dạng tuyến.
@Nhoclangbat: Sẽ post Lisp theo yêu cầu của nhoc sau nhé.
3. Các viewport được sắp xếp theo phương đứng thay vì phương ngang như các Lisp trước
----------------------------------------
Nhờ bạn sửa giúp :
3.1 Để tiện cho việc đánh số tờ, khi chọn các khung hình chử nhật, lisp tính tổng các khung, đánh số từng khung , ghi số 01/ tổng khung ( n) , 2/ n, ..vào giữa từng khung, xoay theo chiều khung .
3.2 Việc sắp xếp các viewport theo vị trí tương đối của các hình chử nhật trên mặt bằng tổng thể, thể hiện chiều ngang và doc. Mục đích để xem xét thứ tự bản vẽ trách nhầm lẫn.
Mong được bạn giúp. Cám ơn
-
Bạn cho mình 1 file mẫu ứng dụng lisp mtll này ra một sản phẩm của bạn được chứ.
Cám ơn nhe.
-
Lisp mới tạo viewport cho tất cả hình chữ nhật có cạnh nằm ngang, đứng, ... ngồi
hoặc nghiêng. Sơ qua về các đặc điểm của Lisp này:1. Tạo viewport cho tất cả các khung hình chữ nhật
2. Thêm lựa chọn Xref khung tên bản vẽ
3. Các viewport được sắp xếp theo phương đứng thay vì phương ngang như các Lisp trước
Bác nào có nhu cầu thì down về rồi test thử và cho ý kiến nhé.
http://www.cadviet.com/upfiles/3/71162_mtl_rev5.lsp
P/S: Lisp này sẽ giảm rất nhiều thao tác và thời gian cho những ai biên tập bản đồ khu vực rộng đặc biệt là bản đồ dạng tuyến.
@Nhoclangbat: Sẽ post Lisp theo yêu cầu của nhoc sau nhé.
2. Thêm lựa chọn Xref và chọn thay đổi tỉ lệ khung tên bản vẽ khi in
--------------------------------------------------------
Vì thường in trên layout, nên mình đặt khung tên bản vẽ với tỉ lệ in là 1:1 với khung nhìn bên trong thì thay đổi để in tỷ lệ 1:500 hoặc 1:200.
Nhờ bạn giúp cho việc khi chọn Xref khung tên bản vẽ sẻ thay đổi theo tỉ lệ tạo các viewport và chèn theo nó.
Ps: Bạn sửa giúp cho việc đặt lại tỷ lệ in theo tỷ lệ bản đồ như ; 100, 200, 500...cho dễ nhớ.
Cám ơn
-
Cám ơn Bạn, rất hay kể cả khi chọn một lượt tất cả khung.
Mình có một yêu cầu là bạn cho tạo lưới khung tọa độ mắt lưới khung cho các hình vừa chọn trên cho đúng yêu cầu xuất bản đồ,.. được chứ bạn.
-
Mình vẫn chưa hiểu ý bạn. Thiết đặt khổ giấy như thế nào? Bạn nói rõ hơn được không?
Mình muốn là sao khi chon khung bên moden, lisp đặt tên layout, đặt tỉ lệ in, và đặt khổ giấy cần in. Lúc đó lisp chuyển nội dung đã chọn trên moden vào trong khung nhìn của khổ giấy mình đặt. mong bạn giúp
-
Hay quá Bạn ơi. Bạn Thật siêu sao. Cảm ơn Bạn Rất rất nhiều. trên forum mình vãn còn một yêu cầu viết lisp ghi chú điểm. bạn xem giúp mình với.
À, cái này thì hay, nếu bổ sung thiết đặt khổ giấy thì tuyệt vời hơn................. Thêm thiết đặt khổ giấy đi bạn. Cám ơn nhiều nhiều... lắm
-
Chào bạn
...........
Còn nếu muốn tạo một Lisp chạy được trên tất cả các bản vẽ thì cũng không khó tuy nhiên khá mất thời gian vì cần phải viết lệnh tạo ra các đối đối tượng TEXT, Polyline, Hatch, Style, … và xác định vị trí của chúng trong cái sơ hoạ mốc nữa để cho vào trong Code. Để sang tuần sau nếu có thời gian mình sẽ hoàn chỉnh cho bạn Lisp này. Trong thời gian chưa có Lisp mới bạn có thể dùng Lisp cũ mà vẫn đảm bảo kết quả như mong muốn.
...............
Cám ơn Bạn trước nha, có ý tưởng rất hay mong bạn sớm hoàn chỉnh để giúp đở anh em.
-
bạn tải lại lsp #30 hoàn chỉnh hơn còn vụ khung nhìn nằm ngang thì ko đc vì lsp này có rác dụng chọn khung bạn vẽ sẵn bên model xuất qua layout mà, việc chọn khung bên model có tác dụng bạn định sẵn khi xuất qua layout nó sẽ chọn đúng các đối tượg mà bạn định sẵn bên model , nếu sữa lại vd bạn vẽ khung chữ nhật đứng bên model mà xuất qua layout thi nằm ngang thì sẽ mất đi 1 phần đối tượng mà bạn mún thấy, vì thế mún nó nằm ngang thì bên model bạn vẽ cho nó nằm ngang đc rùi ^^
Lisp mlt đặt tỉ lệ in và nêm thêm thiết đặt khổ giấy đi bạn.
Cám ơn
-
Nhoc xí xọn tiếp sức trong lúc bạn KangKung đi vắng vậy, bảo đảm tải về chạy ok, bạn thích đặt tên layout là gì cũng đc ^^
;========LISP TAO VIEWPORT TREN LAYOUT BANG CACH CHON O MODEL======== ;===============REV3===================== (defun C:mtl() (command "UNDO" "BE") (setvar "OSMODE" 0) (setq taphop(ssget)) (if (= Tyle nil) (setq Tyle1 1) (setq Tyle1 Tyle)) (setq Tyle (getreal (strcat "\n Ty le: <" (rtos Tyle1 2 0) "> "))) (if (= Tyle nil) (setq Tyle Tyle1)) (setq soluong (sslength taphop)) (setq index 0) (setq i 0) (setq ten (getstring "\n Nhap ten layout:")) (command "layout" "N" ten) (command "LAYOUT" "S" ten) (command "ERASE" "ALL" "") (command "MODEL") (setq X 0) (command "ZOOM" "E") (while (< index soluong) (setq i(1+ i)) (setq khung(ssname taphop index)) (setq lst(acet-geom-vertex-list khung)) (command "COPYCLIP" khung "") (command "LAYOUT" "S" ten) (command "PASTECLIP" (list X 0)) (command "SCALE" (entlast) "" (list X 0) (/ 1 tyle)) (command "MVIEW" "O" (entlast)) (command "MSPACE") (command "ZOOM" (nth 0 lst) (nth 2 lst)) (command "PSPACE") (setq X(+ X 50 (/ (abs(- (car (nth 2 lst)) (car (nth 0 lst)))) tyle))) (command "ZOOM" "W" (list 0 0) (list (+ X 100) 0)) (setq index (+ index 1)) ) (command "MODEL") (command "UNDO" "END") (setvar "OSMODE" 15359) (princ) )
Cám ơn Bạn, Bài viết rất hay.
NHờ Bạn giúp cho khi khung nhìn không nằm ngang, khi ta chọn thì xuất qua Layout và xoay khung nhìn đó nằm lại ngang có được không bạn ?
-
Hề hề hề,
Y nghĩa của các dòng code mà mình đã viết thực ra chỉ là cái mình mót được từ mọi người ở trên diễn đàn chứ có phải cao siêu gì đâu. Chỉ là bạn cần dành chút thời gian để tìm hiểu về lisp và làm thử vài lần sẽ quen thôi mà.
Cụ thể như sau:
1/- (defun c:xt2ex (/ oldos sslst tlst filename f sslst1 C1 C2 C3 C4 C5 C6 C7 C8 )
Khai báo tên lệnh lisp, đặt các biến sử dụng là biến cục bộ để nó bị triệt tiêu sau khi chạy lisp
2/- (vl-load-com) load các hàm vl- và các lệnh sử dụng trong express tool
3/- (command "undo" "be") đánh dấu nơi bắt đầu đặt lệnh undo
4/- (setq oldos (getvar "osmode")) Lấy giá trị biến hệ thống osmode hiện hành
5/- (setvar "osmode" 0) Đặt biến hệ thống osmode về 0 để tránh truy bắt nhầm điểm.
6/- (setq sslst (acet-ss-to-list (ssget (list (cons 0 "circle") (cons 62 63) (cons 8 "main_circleKQ"))))
tlst "" )
Đặt tên biến sslst là một danh sách tên các đối tượng vòng tròn được chọn bởi lệnh ssget. Về cú pháp và chức năng của lệnh này bạn tham khảo trong Help Developer của CAD,
Đặt biến tlst là một chuỗi trống (không chứa ký tự nào)
7/- (setq filename (getfiled "Select a File" "" "csv" 1)) Đặt biến filename là tên file được chọn từ hộp thoại của lệnh Getfiled. Xem thêm Help developer để hiểu về lệnh này.
8/- (setq f (open filename "w")) Mở file có filename đã chọn để ghi nội dung mới vào file và lưu biến thao tác này là f.
9/- (write-line "Main_STT,Main_H_Dap,Main_S_Dap,Main_V_Dap,Main_H_Dao,Main_S_Dao,Main_V_Dao,Main_S_O," f)
Ghi một dòng text vào file đã mở, dấu , dùng ngăn cách giữa các cột trong file
10/- (foreach e sslst
Mở hàm foreach để lặp qua tất cả các đối tượng có trong danh sách các ename đã được chọn ở phía trên (biến sslst)
Các nhiệm vụ cần làm trong mỗi lần lặp được liệt kê như sau:
a/- (setq sslst1 (acet-ss-to-list (ssget "w" (list (- (cadr (assoc 10 (entget e))) (cdr (assoc 40 (entget e))))
(- (caddr (assoc 10 (entget e))) (cdr (assoc 40 (entget e))))
)
(list (+ (cadr (assoc 10 (entget e))) (cdr (assoc 40 (entget e))))
(+ (caddr (assoc 10 (entget e))) (cdr (assoc 40 (entget e))))
)
(list (cons 0 "text")) )) )
Lấy một danh sách các đối tượng text có trong mỗi vòng tròn. Tham khảo thêm về lệnh ssget với tham số "w" trong help developer.
b/- (setq C1 nil C2 nil C3 nil C4 nil C5 nil C6 nil C7 nil C8 nil), Đặt các biến C1 ..... C8 về giá trị nil (chả có gì)
c,d,e,f,g,h,i,k/- (foreach en sslst1
(if (= (cdr (assoc 8 (entget en))) "Main_STT")
(setq C1 (cdr (assoc 1 (entget en))) )
)
)
Tạo 8 vòng lặp qua các đối tượng text được chọn trong danh sách sslst1 để lấy giá trị của 8 biến C1 ... C8 theo tên các lớp của mỗi text
l/- (setq tlst (strcat (if C1 C1 " ") (chr 44) (if C2 C2 " ") (chr 44) (if C3 C3 " ") (chr 44) (if C4 C4 " ") (chr 44)
(if C5 C5 " ") (chr 44) (if C6 C6 " ") (chr 44) (if C7 C7 " ") (chr 44) (if C8 C8 " ") (chr 44) ))
Đặt biến tlst là một chuỗi gồm giá trị các biến từ C1 đến C8 với dấu ngăn cách cột là ","
m/- (write-line tlst f) Ghi giá trị chuổi này vào file đã mở f ở trên
n/- (setq tlst "") Trả biến tlst về chuỗi trống.
11/- ) Kết thúc vòng lặp foreach.
12/- (close f) Đóng file f đã mở phía trên.
13/- (setvar "osmode" oldos) Trả biến hệ thống osmode về giá trị ban đầu trước khi chạy lisp
14/- (command "undo" "e") Đánh dấu nơi kết thúc của lệnh undo. Điều này để giúp người dùng khi cần có thể khôi phục nhanh bản vẽ đã bị lisp làm thay đổi.
15/- (princ) Xóa sạch biến cuối cùng do lisp tạo ra và trả về nil. Thoát êm
16/- ) Kết thúc lệnh lisp (defun c:xt2ex .... đã bắt đầu phía trên.
Nói thì như vậy nhưng thực tế để vận dụng tốt các hàm lisp phía trên cũng cần có thời gian để đọc và thực hành. Bạn chớ có sợ nó rậm rì rắc rối, Bước đấu có thể hơi ngại ngùng như khi gặp gái trinh, nhưng cứ thọc vào bạn sẽ thấy khoái dần và nổi hứng với nó không chừng. Cứ từ từ mà vọc. Dục tốc bất đạt. Mưa dần thấm đất, rồi sẽ tời lúc nó nhũn ra như con chi chi, bạn tha hồ mà thọc mà ngoáy, mà mấn mà mò, chả còn biết sợ là gì nữa đâu.
Hề hề hề,...
Cám ơn bạn đã hướng dẫn. Lisp này mình chọn tất cả và xuất ra file cvs, mình muốn nhờ bạn chỉnh thêm tí, vì công việc phát sing mình phải chọn từng ô để xuất ra file. lần nhất chọn lần lược 1 hoăc 2 ô, xuất ra file. Sau đó mình chọn thêm các ô khác nửa sẻ xuất ra file ghi nối vào file cũ .
Xin được bạn giúp. Cám ơn
[ yêu cầu ] Nội suy điểmcao độ trên tập hợp điểm
trong AutoLisp
Đã đăng · Trả lời báo cáo
XIN LỖI, DO MÌNH UP FILE BI LỖI HOÀI
http://www.cadviet.com/upfiles/3/114381_noisuy_1.rar