longbyoongho
-
Số lượng nội dung
57 -
Đã tham gia
-
Lần ghé thăm cuối
Bài đăng được đăng bởi longbyoongho
-
-
Tình hình là e phải thống kê 1 bản vẽ san nền vì có nhiều chi tiết quá nên cứ hoa hết cả mắt lên. Bác nào viết hộ e cái lisp thống kê text trong block att với.
Đây là hình minh họa cho thắc mắc của e:
Yêu cầu của e như sau:
1- chọn chiều cao cho text và tự động lưu giá trị cho lần nhập thứ 2.
2- cho phép lựa chọn số cột và tên tiêu đề của mỗi cột. Thứ tự tiêu đề theo chiều kim đồng hồ ở đây e thể hiện theo màu cho các bác dễ nhìn còn khi viết lisp thì chỉ cần bác cho text và line theo layer hiện hành là ok.
3- xuất bảng có độ rộng hàng và cột phù hợp với chiều cao text lựa chọn ở bước 1.
Thanks các bác, trong quá trình sử dụng có gì phát sinh e sẽ hỏi tiếp a. :D
-
Bạn dùng thử xem sao;; free lisp from cadviet.com ;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=12702 (prompt"\n[cmd : TDN] - THONG KE TOA DO by Thaistreetz - huuthais@yahoo.com\n") ---------------------------------------------- (defun C:tdn () (setvar "cmdecho" 0 ) (command "Undo" "Begin") (setq om (getvar "osmode")) (if (not h) (setq h 1)) (setq caot1 (getreal (strcat "\nCao text < " (rtos h 2 2) " >:"))) (if caot1 (setq h caot1)) (setq tapx '() tapy '() stt '()) (setq bit1 (cond (bit1) ("Yes"))) (initget "Yes No") (setq Tmp1 (strcat "\nTu dong ghi ten nut? [Yes/No] <" bit1 ">: ") bit1 (cond ((getkword Tmp1)) (bit1))) (if (eq bit1 "Yes") (progn (setq ten (getstring "\nTen Nut:")) (if (not i) (setq i 1)) (setq i1 (getreal (strcat"\nSTT cua nut bat dau < " (rtos i 2 0) " >: "))) (if i1 (setq i i1)) (setvar "osmode" 125) (setq lacol (getvar "CEColor") k (- i 1)) (While (setq D1 (getpoint (strcat"\nPick diem thu "(rtos (+ k 1) 2 0)""))) (Progn (setvar "osmode" 0) (setq DX (getpoint (strcat"\nDiem dat text thu "(rtos (+ k 1) 2 0)"") D1) DY (getpoint (strcat"\nHuong goc nghieng cua text "(rtos (+ k 1) 2 0)"") Dx) angr (angle Dx Dy) angd (/ (* 180 angr) pi) x (rtos (car D1) 2 4) y (rtos (cadr D1) 2 4) TX (strcat "X:"(rtos (Car D1) 2 4)) TY (strcat "Y:"(rtos (Cadr D1) 2 4)) tapx (append tapx (list x)) tapy (append tapy (list y)) k (+ 1 k) N (strcat ten (rtos k 2 0)) stt (append stt (list N)) );setq (setq dt (* 0.5 (- (strlen N) 2) h));;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (if (>= (car DY) (car DX)) (progn (setq D2 (polar Dx angr (* 0.7 h))) (command "text" "BL" D2 h angd tX) (setq TB (textbox (entget(entlast))) LC (car TB) RC (cadr TB) di (distance LC RC) PT3 (polar D2 angr (+ di (* 0.4 h))) pt4 (polar D2 (- angr (* pi 0.5)) (* 1.35 h)) pt5 (polar pt4 angr di) C (polar PT3 0 (* 1.5 h)) );setq (command "text" "F" PT4 PT5 h ty "pline" D1 DX PT3 "" "circle" (polar PT3 angr (+ (* 1.5 h ) dt)) (+ (* 1.5 h) dt) "text" "m" (polar PT3 angr (+ (* 1.5 h) dt )) h angd N "CECOLOR" 8 "circle" (polar PT3 angr (+ (* 1.5 h) dt)) (+ (* 1.35 h) dt) );command (setvar "CECOLOR" lacol) );progn );if (if (< (car DY) (car DX)) (progn (setq D2 (polar Dx angr (* 0.7 h))) (command "text" "BR" D2 h (+ angd 180) tx) (setq TB (textbox (entget(entlast))) LC (car TB) RC (cadr TB) di (distance LC RC) PT3 (polar D2 angr (+ di (* 0.4 h))) pt4 (polar D2 (+ angr (* pi 0.5)) (* 1.35 h)) pt5 (polar pt4 angr di) C (polar PT3 0 (* 1.5 h)) );setq (command "text" "F" PT5 PT4 h TY "pline" D1 DX PT3 "" "circle" (polar PT3 angr (+ (* 1.5 h) dt)) (+ (* 1.5 h) dt) "text" "m" (polar PT3 angr (+ (* 1.5 h) dt)) h (+ angd 180) N "CECOLOR" 8 "circle" (polar PT3 angr (+ (* 1.5 h) dt)) (+ (* 1.35 h) dt) );command (setvar "CECOLOR" lacol) );progn );if );progn (setvar "osmode" 125) );while (setq i (+ k 1)) );progn );if (if (eq bit1 "No") (progn (setvar "osmode" 125) (setq lacol (getvar "CEColor") i 1 k (- i 1)) (While (setq D1 (getpoint (strcat"\nPick diem thu "(rtos (+ k 1) 2 0)""))) (Progn (setvar "osmode" 0) (progn (setq LOOP T) (while (= LOOP T) (while (null (setq ten (nentsel "\nChon mot text lam ten nut: "))) (princ "\nChua tim thay doi tuong la text, chon lai !"));while (setq Source_text (entget (car ten))) (if (or (= (cdr (assoc '0 Source_text)) "TEXT") (= (cdr (assoc '0 Source_text)) "MTEXT") (= (cdr (assoc '0 Source_text)) "ATTRIB"));or (progn (setq N (cdr (assoc 1 Source_text))) (setq LOOP nil));progn (progn (princ "Phai chon mot text lam ten nut !") (setq LOOP T));progn )if );while );progn (setq DX (getpoint (strcat"\nDiem dat text cua nut "N"") D1) DY (getpoint (strcat"\nHuong goc nghieng cua text") Dx) angr (angle Dx Dy)) (setq angd (/ (* 180 angr) pi) x (rtos (car D1) 2 4) y (rtos (cadr D1) 2 4) TX (strcat "X:"(rtos (Car D1) 2 4)) TY (strcat "Y:"(rtos (Cadr D1) 2 4)) tapx (append tapx (list x)) tapy (append tapy (list y)) k (+ 1 k) stt (append stt (list N)) );setq (setq dt (* 0.5 (- (strlen N) 2) h));;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (if (>= (car DY) (car DX)) (progn (setq D2 (polar Dx angr (* 0.7 h))) (command "text" "BL" D2 h angd tX) (setq TB (textbox (entget(entlast))) LC (car TB) RC (cadr TB) di (distance LC RC) PT3 (polar D2 angr (+ di (* 0.4 h))) pt4 (polar D2 (- angr (* pi 0.5)) (* 1.35 h)) pt5 (polar pt4 angr di) C (polar PT3 0 (* 1.5 h)) );setq (command "text" "F" PT4 PT5 h ty "pline" D1 DX PT3 "" "circle" (polar PT3 angr (+ (* 1.5 h) dt)) (+ (* 1.5 h) dt) "text" "m" (polar PT3 angr (+ (* 1.5 h) dt)) h angd N "CECOLOR" 8 "circle" (polar PT3 angr (+(* 1.5 h) dt)) (+ (* 1.35 h) dt) );command (setvar "CECOLOR" lacol) );progn );if (if (< (car DY) (car DX)) (progn (setq D2 (polar Dx angr (* 0.7 h))) (command "text" "BR" D2 h (+ angd 180) tx) (setq TB (textbox (entget(entlast))) LC (car TB) RC (cadr TB) di (distance LC RC) PT3 (polar D2 angr (+ di (* 0.4 h))) pt4 (polar D2 (+ angr (* pi 0.5)) (* 1.35 h)) pt5 (polar pt4 angr di) C (polar PT3 0 (* 1.5 h)) );setq (command "text" "F" PT5 PT4 h TY "pline" D1 DX PT3 "" "circle" (polar PT3 angr (+ (* 1.5 h) dt)) (+ (* 1.5 h) dt) "text" "m" (polar PT3 angr (+ (* 1.5 h) dt)) h (+ angd 180) N "CECOLOR" 8 "circle" (polar PT3 angr (+ (* 1.5 h) dt)) (+ (* 1.35 h) dt) );command (setvar "CECOLOR" lacol) );progn );if );progn (setvar "osmode" 125) );while (setq i (+ k 1)) );progn );if (setq bit (cond (bit) ("Yes"))) (initget "Yes No") (setq Tmp (strcat "\nXuat bang toa do? [Yes/No] <" bit ">: ") bit (cond ((getkword Tmp)) (bit))) (if (eq bit "Yes") (progn (setq di (- di (* 0.4 h)) kc (* 2 di) PT (getpoint"\nVi tri dat bang") PTC (list (+ (* 2 kc) (- di h h h h) (car PT)) (cadr PT)) p1 (list (car PT) (+ (cadr PT)(* 2 h))) p2 (list (car PTC) (+ (cadr PTC)(* 2 h))) p3 (list (car p1) (+ (cadr p1)(* 2 h))) p4 (list (car p2) (+ (cadr p2)(* 2 h))) PTD (list (+ (/ di 2) (car PT)) (+ h (cadr PT))) PTX (list (+ di (/ di 2) (- 0 h) (car PTD)) (cadr PTD)) PTY (list (+ kc (- h h h h) (car PTX)) (cadr PTX)) p11 (list (+ (/ di 2) (car p1)) (+ (* 1.1 h) (cadr p1))) p22 (list (+ di (/ di 2) (- 0 h) (car p11)) (- (cadr p11) (* 0.1 h))) p33 (list (+ kc (- h h h h) (car p22)) (cadr p22)) L1 (list (+ di (car p3))(cadr p3)) L2 (list (+ kc (- 0 h h)(car L1))(cadr L1)) PTB (list (+ (- (* 2 h)) (* 0.5 (+ (* 2 kc) di)) (car PT)) (+ (cadr P3) (* 1.8 h))) n (length tapx) k 0 );setq (setvar "osmode" 0) (command "CECOLOR" 3 "line" p1 p2 "" "line" p3 p4 "" "CECOLOR" 2 "text" "m" p11 h 0 "Ten diem" "text" "m" p22 h 0 "Toa do X" "text" "m" p33 h 0 "Toa do Y" "text" "m" pTB (* 1.3 h) 0 "%ºng thong ke toa do diem") (while (< k n) (setq xx (nth k tapx) yy (nth k tapy) tstt(nth k stt)) (command "CECOLOR" 2 "text" "m" PTD h 0 tstt "text" "m" PTX h 0 xx "text" "m" PTY h 0 yy "CECOLOR" 3 "line" PT PTC "") (setq PT (list (car PT) (- (cadr PT)(* 2 h))) PTC (list (+ (* 2 kc) (- di h h h h) (car PT)) (cadr PT)) PTD (list (+ (/ di 2) (car PT)) (+ h (cadr PT))) PTX (list (+ di (/ di 2) (- 0 h) (car PTD)) (cadr PTD)) PTY (list (+ kc (- h h h h) (car PTX)) (cadr PTX)) k (+ 1 k));setq );while (if (= k n) (setq PT (list (car PT) (+ (cadr PT)(* 2 h))) PTC (list (+ (* 2 kc) (- di h h h h) (car PT)) (cadr PT)) L11 (list (+ di (car PT))(cadr PT)) L22 (list (+ kc (- 0 h h) (car L11))(cadr L11)) );setq );if (command "CECOLOR" 3 "line" p3 PT "" "line" p4 PTC "" "line" L1 L11 "" "line" L2 L22 "") );progn );if (setvar "CECOLOR" lacol) (setvar "osmode" om) (prompt"\n[TDN - THONG KE TOA DO] by Thaistreetz - huuthais@yahoo.com\n") (command "Undo" "End") (setvar "cmdecho" 1) (princ) );DONG toa doTrong đó có dòng (setq dt (* 0.5 (- (strlen N) 2) h)) để điểu chỉnh độ to của vòng tròn theo chiều dài tên Nút Nếu muốn bạn có thể sửa lại. Bạn dùng thử và phản hồi lại nhé!!
Bạn có thể thêm dòng chọn "chọn số chữ số thập phân" được không vì đôi khi có những bản vẽ chỉ cần chính xác đến 3 chữ số đằng sau dấu "," thôi. Thanks :D
-
Cảm ơn bạn vì bản vẽ này giúp mình fát hiện ra 4 điểm còn thiếu sót có thể dẫn đến việc lisp không chạy ra kết quả theo ý muốn. 4 điểm đó gồm:
1. Phải thiết lập UCS với giá trị world (như anh Duy đã nói)
2. Phải thiết lập Angbase về giá trị 0
3. Style của các text phải để heigh text có giá trị mặc định là 0.
4. Tất cả các text cần canh lề không được để ở chế độ màu là byblock
Đây là code mình đã sửa lại để phù hợp với những bản vẽ không được thiết lập các điều kiện như 3 điều kiện đầu tiên. vì thời gian này mình bận quá nên ko có thời gian nghiên cứu sửa nốt điều kiện thứ 4. (nó cũng tương đối ít gặp) nên bạn trước khi sử dụng bạn chỉ cần đổi lại màu text khác màu byblock là OK ko vấn đề gì. Nhờ các bác trên diễn đàn sửa nốt giúp mình phần này vậy.
(defun c:ft()(setq txt (ssget '((0 . "*TEXT"))))(setq mau (entget (car (entsel "\nChon text chuan"))))(command "undo" "begin")(setq oldos (getvar "osmode"))(setq olcol (getvar "CEColor"))(setq ollay (getvar "Clayer"))(setq olstyle (getvar "textstyle"))(setq TB (textbox mau) LC (car TB) RC (cadr TB) di (distance LC RC) i 0)(setq h (cdr(assoc 40 mau)))(setq x1 (cdr(assoc 10 mau)))(setq x2 (list (+ (car x1) (* di 0.5) (* -0.03 h)) (cadr x1)))(setq x3 (list (+ (car x1) di (* -0.06 h)) (cadr x1)))(setq canle (cond (canle) ("Left")))(initget "Left Center Right Fit")(setq canle (cond ((getkword (strcat "\Vi tri can le [Left/Center/Right/Fit/]<" canle ">"))) (canle)))(setq oldang (getvar "Angbase"))(command "angbase" 0 "ucs" "w")(repeat (sslength txt)(setq txt_ent (entget (ssname txt i)))(setq txt_val (cdr(assoc 1 txt_ent)))(setq txt_st (cdr(assoc 7 txt_ent)))(setq txt_lay (cdr(assoc 8 txt_ent)))(setq txt_h (cdr(assoc 40 txt_ent)))(setq txt_fctr (cdr(assoc 41 txt_ent)))(setq txt_clr (cdr(assoc 62 txt_ent)))(setq y1 (cdr(assoc 10 txt_ent)))(if (cdr(assoc 43 txt_ent)) (setq txt_fctr 1 y1 (list (car y1) (- (cadr y1) txt_h))))(setq pt1 (list (car x1) (cadr y1)))(setq pt2 (list (car x2) (cadr y1)))(setq pt3 (list (car x3) (cadr y1)))(command "-style" txt_st "" 0 txt_fctr "" "" "" "" "clayer" txt_lay "color" txt_clr "osmode" 0)(if (eq canle "Left") (command "text" pt1 txt_h 0 txt_val))(if (eq canle "Center") (command "text" "C" pt2 txt_h 0 txt_val))(if (eq canle "Right") (command "text" "R" pt3 txt_h 0 txt_val))(if (eq canle "Fit") (command "text" "F" pt1 pt3 txt_h txt_val))(setq i (+ i 1))(command "color" "bylayer"));repeat(command "ucs" "p")(setvar "textstyle" olstyle)(setvar "angbase" oldang)(setvar "Clayer" ollay)(setvar "CECOLOR" olcol)(setvar "osmode" oldos)(command "erase" txt "")(prompt"\n[CAN LE TEXT] by Thaistreetz - huuthais@yahoo.com\n")(command "undo" "end"));defun;=================================================================;dan deu khoang cach cac hang text theo phuong Y;=================================================================(defun ss2ent (ss / sodt index lstent)(setq sodt (if ss (sslength ss) 0) index 0)(repeat sodt(setq ent (ssname ss index) index (1+ index) lstent (cons ent lstent));setq);repeat(reverse lstent))(defun c:df()(setq oldos (getvar "osmode"))(setq ss (ssget '((0 . "*TEXT"))) lst (ss2ent ss) lst (vl-sort lst '(lambda (e1 e2) (< (cadr (assoc 10 (entget e1))) (cadr (assoc 10 (entget e2)))))) lst (vl-sort lst '(lambda (e1 e2) (> (caddr (assoc 10 (entget e1))) (caddr (assoc 10 (entget e2)))))));setq(command "undo" "begin")(setvar "osmode" 15359)(setq kc (getdist "\n Nhap khoang cach giua cac text"))(setq ddau (cdr(assoc 10 (entget(car lst)))) i 0 a2 (ssadd))(setq mau (entget (car (entsel "\nChon text chuan"))))(setq ptmau (cdr(assoc 10 mau)))(setq ym (cadr ptmau))(foreach e lst(setq ent (entget e))(setq dcuoi (cdr(assoc 10 ent)))(setq yi (cadr dcuoi))(setq ddauu (list (car dcuoi) (- (cadr ddau) (* i kc))))(if (= yi ym) (setq ptgoc (list (car dcuoi) (- (cadr ddau) (* i kc)))))(setvar "osmode" 0)(command "move" e "" dcuoi ddauu)(setq a2 (ssadd e a2))(setq i (1+ i)));foreach(command "move" a2 "" ptgoc ptmau)(setvar "osmode" oldos)(prompt"\n[Paragraph TEXT] by Thaistreetz - huuthais@yahoo.com\n")(command "undo" "end")(Princ));=========================================================================;dan deu khoang cach cac text theo phuong X;=========================================================================(defun c:dfx()(setq oldos (getvar "osmode"))(setq ss (ssget '((0 . "*TEXT"))) lst (ss2ent ss) lst (vl-sort lst '(lambda (e1 e2) (< (cadr (assoc 10 (entget e1))) (cadr (assoc 10 (entget e2)))))) lst (vl-sort lst '(lambda (e1 e2) (> (caddr (assoc 10 (entget e1))) (caddr (assoc 10 (entget e2)))))));setq(command "undo" "begin")(setvar "osmode" 15359)(setq kc (getdist "\n Nhap khoang cach giua cac text"))(setq ddau (cdr(assoc 10 (entget(car lst)))) i 0 di 0 a2 (ssadd))(setq mau (entget (car (entsel "\nChon text chuan"))))(setq ptmau (cdr(assoc 10 mau)))(setq xm (car ptmau))(foreach e lst(setq ent (entget e))(setq pti (cdr(assoc 10 ent)))(setq xi (car pti))(setq ddauu (list (+ (car ddau) di (* i kc)) (cadr ddau)))(if (= xi xm) (setq ptgoc (list (+ (car ddau) di (* i kc)) (cadr ddau))))(setq TBi (textbox ent) LCi (car TBi) RCi (cadr TBi) dii (distance LCi RCi) di (+ di dii))(setvar "osmode" 0)(command "move" e "" pti ddauu)(setq a2 (ssadd e a2))(setq i (1+ i)));foreach(command "move" a2 "" ptgoc ptmau)(setvar "osmode" oldos)(prompt"\n[Dan deu khoang cach TEXT theo phuong ngang] by Thaistreetz - huuthais@yahoo.com\n")(command "undo" "end")(Princ));========================================================================;Sap xep text thang hang (co cung tung do Y);========================================================================(defun c:dx()(setq oldos (getvar "osmode"))(setq txt (ssget '((0 . "TEXT"))))(command "undo" "begin")(setq ym (cadr (cdr(assoc 10 (entget (car (entsel "\nChon text chuan")))))) i 0)(repeat (sslength txt)(setq txt_pt (cdr(assoc 10 (entget (ssname txt i)))))(setq ptcuoi (list (car txt_pt) ym))(setvar "osmode" 0)(command "move" (ssname txt i) "" txt_pt ptcuoi)(setq i (+ i 1)));repeat(setvar "osmode" oldos)(prompt"\n[sap xep text thang hang] by Thaistreetz - huuthais@yahoo.com\n")(command "undo" "end")(Princ))@A Tue_NV: vấn đề anh nêu em cũng đã biết ngay trong quá trình viết lisp rồi anh ạ. và đây cũng là chủ đích của em... em có cùng quan điểm với anh Duy, thích sử dụng Dtext hơn là Mtext nên viết code thế này tiện thể covert Mtext về Dtext luôn. Và lisp này viết ra mục đích chủ yếu để áp dụng với Mtext thôi anh ạ.
@TuongTrang: Mình cũng đang xài cad2010 và mình vẫn chạy được lisp này như thường. bạn hứng thú thì cứ test bét nhè chè đỗ đen đi, ko vấn đề gì sất <_< .
Về câu hỏi của bạn... Đúng là Mtext đã hỗ trợ các kiểu canh lề từ ngay từ ngày ... Mtext đc sinh ra, cái này thì ai cũng biết. còn với Dtext, mỗi text là một đối tượng riêng lẻ nên theo như hiểu biết của mình thì Cad không có lệnh nào để canh lề cho các đối tượng Dtext riêng lẻ này. cũng chính vì thế nên mình mới viết lisp này để canh lề cho Dtext.
Mình cũng đang hiểu câu hỏi của bạn theo một hướng khác, hình như bạn đang muốn đề cập đến vấn đề convert tất cả các đối tượng Dtext được chọn trở lại Mtext và canh lề cho các dòng trong Mtext mới được tạo ra. Cái này mình chưa làm được và có lẽ mình cũng không muốn làm... vì nhu cầu này hình như rất ít người cần và cũng một fần vì chủ quan của mình, dù thế nào thì mình cũng thích dùng Dtext hơn trong mọi trường hợp.
Lisp bạn viết rất hay nhưng lệnh DX dùng để gom tất cả các text vào 1 text được chọn thì mình thấy không cần thiết, cũng có thể mình không hiểu ý đồ của bạn vậy mình muốn bạn sửa lệnh DX hoặc thêm 1 lệnh mới có tác dụng căn đều từng text theo môi trường của nó được không ( ví dụ: căn text vào chính giữa hình tròn, hình đa giác...). Thanks :D
-
Cám ơn bạn rất nhiều :D
-
Đã modify. Vẫn link cũ:
Hay quá cám ơn bạn nhiều, phiền bạn chút nữa nhé bạn có thể thêm phần chọn chữ số thập phân được không? ví dụ 1.00, 1.000 ...
Được như vậy thì thật là hoàn hảo. Thanks
-
http://www.cadviet.com/upfiles/3/99830_cy.lsp
Mình cám ơn bạn vì lisp này của bạn giải quyết được vấn đề thêm tiền tố đằng trước text, tuy nhiên bạn có thể thêm phần làm việc với số thập phân nữa thì hay quá. Mình đã tìm trên diễn đàn nhưng vẫn không thấy lisp nào như ý muốn. Giúp mình nhé, cám ơn bạn :D
-
Mình có tìm được 1 lisp "copy text tăng dần" trên cadviet, lisp này rất hay tuy nhiên nó lại hạn chế ở chỗ chỉ có thể thực hiện được với số nguyên. Vì thế mình muốn nhờ mọi người sửa giùm lisp này thêm phần thao tác với số thập phân nữa, được như vầy thì cám ơn mọi người lắm lắm :D
-
Thêm 1 chú nữa:
;; free lisp from cadviet.com ;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=37567 ;;----------------------------------------------;; ;; Text calculation tool - Skywings ;; ;;----------------------------------------------;; ;;***SUB-FUNCTION*** (defun GET-TEXT () (princ "\nSelect NUMBERs : ") (while (null (setq Numbers (ssget '((0 . "*TEXT"))))) (princ "\n**NOTHING selected!**") ) ) (defun GET-DATA (/ ss-mt ss-t n) (setq ss-mt (ssadd) ss-t (ssadd) n 0 sw 0 ) (repeat (sslength Numbers) (setq ent (ssname Numbers n)) (if (= (cdr (assoc 0 (entget ent))) "MTEXT") (setq ss-mt (ssadd ent ss-mt)) (setq ss-t (ssadd ent ss-t)) ) (setq n (1+ n)) ) (if (/= (sslength ss-mt) 0) (setq Numbers (acet-explode ss-mt) sw 1 ) ) (setq n 0) (repeat (sslength ss-t) (setq ent (ssname ss-t n) Numbers (ssadd ent Numbers) n (1+ n) ) ) ) (defun GET-VALUE (name / sw) (princ (strcat "\nSelect " name " : ")) (cond ((= (cdr (assoc 0 (entget ename))) "MTEXT") (command ".explode" ename "") (setq value (read (cdr (assoc 1 (entget (entlast))))) sw 1 ) ) ((setq value (read (cdr (assoc 1 (entget ent)))))) ) (if (= sw 1) (command ".undo" 1) ) value ) (defun OPT () (if (null option) (setq option "Replace" save2 option ) ) (initget "Replace Create Do-nothing") (setq option (getkword (strcat "\nOptions: [Replace/Create/Do-nothing] <" option "> " ) ) ) (if (null option) (setq option save2) (setq save2 option) ) (setq switch 1) ) (defun ACTION (option result / txt pnt) (cond ((= option "Replace") (while (null (setq txt (entsel "\nChoose TEXT to replace: "))) (princ "\n**NOTHING selected!**") ) (setq txt (entget (car txt)) txt (subst (cons 1 result) (assoc 1 txt) txt) ) (entmod txt) ) ((= option "Create") (setq pnt (getpoint "\nSpecify start point of text:")) (entmake (list (assoc 0 ent) (assoc 8 ent) (cons 1 result) (cons 10 (trans pnt 1 0)) (assoc 40 ent) (assoc 7 ent) (assoc 50 ent) ) ) ) ) ) (defun GET-ORDER () (princ (strcat "\nCurrent setting: Precision = " (rtos precision 2 0) " <" (rtos 0 2 precision) ">" ) ) (initget "Plus Subtract Multiply Divide Average maX-min ADd-by mUltiply-by preCision" ) (setq operation (getkword (strcat "\nOperations: [Plus/Subtract/Multiply/Divide/Average/maX-min/ADd-by/mUltiply-by/preCision]: <" operation "> " ) ) ) (if (null operation) (setq operation save1) (setq save1 operation) ) ) ;;***MAIN FUNCTION***: (defun c:TCAL (/ Numbers DIVIDEND DIVISOR ENT ID INDEX MINUEND NUM-MAX NUM-MIN NUM-SET RESULT SUBTRAHEND SWITCH VALUE sw ) (princ "** Text calculation tool - Skywings **" ) (setvar "CMDECHO" 0) (setvar "QAFLAGS" 1) (if (null precision) (setq precision 2 save3 precision ) ) (if (null operation) (setq operation "Plus" save1 operation ) ) (GET-ORDER) (while (= operation "preCision") (initget 4) (setq precision (getint (strcat "\nSpecify new precision: <" (rtos precision 2 0) "> " ) ) ) (if (null precision) (setq precision save3) (setq save3 precision) ) (GET-ORDER) ) (cond ;; PLUS: ((= operation "Plus") (GET-TEXT) (setq switch 0) (while (/= Numbers nil) (GET-DATA) (setq index 0 result 0 ) (princ "\n>>Expression: ") (repeat (sslength Numbers) (setq ent (entget (ssname Numbers index)) value (read (cdr (assoc 1 ent))) index (1+ index) ) (if (numberp value) (progn (setq result (+ result value)) (if (/= index 1) (princ " + ") ) (princ (rtos value 2 precision)) ) ) ) (if (= sw 1) (command ".undo" 1)) (princ (strcat "\n>>RESULT = " (rtos result 2 precision))) (if (= switch 0) (OPT) ) (ACTION option (rtos result 2 precision)) (setq Numbers nil Numbers (ssget '((0 . "*TEXT"))) ) ) ) ;; MULTIPLY: ((= operation "Multiply") (GET-TEXT) (setq switch 0) (while (/= Numbers nil) (GET-DATA) (setq index 0 result 1 ) (princ "\n>>Expression: ") (repeat (sslength Numbers) (setq ent (entget (ssname Numbers index)) value (read (cdr (assoc 1 ent))) index (1+ index) ) (if (numberp value) (progn (setq result (* result value)) (if (/= index 1) (princ " * ") ) (princ (rtos value 2 precision)) ) ) ) (if (= sw 1) (command ".undo" 1) ) (princ (strcat "\n>>RESULT = " (rtos result 2 precision))) (if (= switch 0) (OPT) ) (ACTION option (rtos result 2 precision)) (setq Numbers nil Numbers (ssget '((0 . "*TEXT"))) ) ) ) ;; SUBTRACT: ((= operation "Subtract") (setq switch 0 sw 0 ) (while (null (setq ename (car (entsel (strcat "\nSelect MINUEND : ")))))) (setq minuend (GET-VALUE "MINUEND")) (while (null (numberp minuend)) (while (null (setq ename (car (entsel (strcat "\nSelect MINUEND : ")))))) (setq minuend (GET-VALUE "MINUEND")) ) (princ minuend) (redraw ename 3) (princ "\nSelect SUBTRAHENDs : ") (while (null (setq Numbers (ssget '((0 . "*TEXT"))))) (princ "\nSelect SUBTRAHENDs : ") ) (redraw ename 4) (while (/= ename nil) (GET-DATA) (setq index 0 result 0 minuend (float minuend) ) (princ (strcat "\n>>Expression: " (rtos minuend 2 precision) " - (" ) ) (repeat (sslength Numbers) (setq ent (entget (ssname Numbers index)) subtrahend (read (cdr (assoc 1 ent))) index (1+ index) ) (if (numberp subtrahend) (progn (setq result (+ result subtrahend)) (if (/= index 1) (princ " + ") ) (princ (rtos subtrahend 2 precision)) ) ) ) (princ ")") (if (= sw 1) (command ".undo" 1) ) (setq result (- minuend result)) (princ (strcat "\n>>RESULT = " (rtos result 2 precision))) (if (= switch 0) (OPT) ) (ACTION option (rtos result 2 precision)) (setq ename nil ename (car (entsel (strcat "\nSelect MINUEND : "))) ) (if (or (null ename) (null (numberp (setq minuend (GET-VALUE "MINUEND")))) ) (progn (setvar "QAFLAGS" 0) (vl-exit-with-error "") ) ) (princ minuend) (princ "\nSelect SUBTRAHENDs <TEXT>: ") (while (null (setq Numbers (ssget '((0 . "*TEXT"))))) (princ "\nSelect SUBTRAHENDs : ") ) ) ) ;; DIVIDE: ((= operation "Divide") (setq switch 0 sw 0 ) (while (null (setq ename (car (entsel (strcat "\nSelect DIVIDEND : ")))))) (setq dividend (GET-VALUE "DIVIDEND")) (while (null (numberp dividend)) (while (null (setq ename (car (entsel (strcat "\nSelect DIVIDEND : ")))))) (setq dividend (GET-VALUE "DIVIDEND")) ) (princ dividend) (redraw ename 3) (princ "\nSelect DIVISORs : ") (while (null (setq Numbers (ssget '((0 . "*TEXT"))))) (princ "\nSelect DIVISORs : ") ) (redraw ename 4) (while (/= ename nil) (GET-DATA) (setq index 0 result 1 dividend (float dividend) ) (princ (strcat "\n>>Expression: " (rtos dividend 2 precision) " / (" ) ) (repeat (sslength Numbers) (setq ent (entget (ssname Numbers index)) divisor (read (cdr (assoc 1 ent))) index (1+ index) ) (if (numberp divisor) (progn (setq result (* result divisor)) (if (/= index 1) (princ " * ") ) (princ (rtos divisor 2 precision)) ) ) ) (princ ")") (if (= sw 1) (command ".undo" 1) ) (setq result (/ dividend result)) (princ (strcat "\n>>RESULT = " (rtos result 2 precision))) (if (= switch 0) (OPT) ) (ACTION option (rtos result 2 precision)) (setq ename nil ename (car (entsel (strcat "\nSelect DIVIDEND : "))) ) (if (or (null ename) (null (numberp (setq dividend (GET-VALUE "DIVIDEND")))) ) (progn (setvar "QAFLAGS" 0) (vl-exit-with-error "") ) ) (princ dividend) (princ "\nSelect DIVISORs : ") (while (null (setq Numbers (ssget '((0 . "*TEXT"))))) (princ "\nSelect DIVISORs : ") ) ) ) ;; AVERAGE: ((= operation "Average") (GET-TEXT) (setq switch 0) (while (/= Numbers nil) (GET-DATA) (setq index 0 id 0 result 0 ) (princ "\n>>Expression: (") (repeat (sslength Numbers) (setq ent (entget (ssname Numbers index)) value (read (cdr (assoc 1 ent))) index (1+ index) ) (if (numberp value) (progn (setq result (+ result value) id (1+ id) ) (if (/= index 1) (princ " + ") ) (princ (rtos value 2 precision)) ) ) ) (if (= sw 1) (command ".undo" 1)) (setq result (rtos (/ (float result) id) 2 precision)) (princ (strcat ") / " (rtos id 2 0))) (princ (strcat "\n>>RESULT = " result)) (if (= switch 0) (OPT) ) (ACTION option result) (setq Numbers nil Numbers (ssget '((0 . "*TEXT"))) ) ) ) ;; MAX-MIN: ((= operation "maX-min") (GET-TEXT) (setq switch 0) (while (/= Numbers nil) (GET-DATA) (setq index 0 Num-set nil ) (repeat (sslength Numbers) (setq ent (entget (ssname Numbers index)) value (read (cdr (assoc 1 ent))) index (1+ index) ) (if (numberp value) (setq Num-set (cons value Num-set)) ) ) (setq Num-set (vl-sort Num-set '>) num-max (car Num-set) num-min (last Num-set) result (strcat "MAX = " (rtos num-max 2 precision) " MIN = " (rtos num-min 2 precision) ) ) (if (= sw 1) (command ".undo" 1)) (princ "\n>>Numbers set: ") (princ Num-set) (print) (princ result) (if (= switch 0) (OPT) ) (ACTION option result) (setq Numbers nil Numbers (ssget '((0 . "*TEXT"))) ) ) ) ;; ADD-BY...: ((= operation "ADd-by") (if (null number0) (setq number0 0.00 save4 number0 ) ) (setq number0 (getreal (strcat "Add by: <" (rtos number0 2 2) "> ")) index 0 ) (if (null number0) (setq number0 save4) (setq save4 number0) ) (GET-TEXT) (GET-DATA) (repeat (sslength Numbers) (setq ent (entget (ssname Numbers index)) value (read (cdr (assoc 1 ent))) index (1+ index) ) (if (numberp value) (setq value (+ (float value) number0) ent (subst (cons 1 (rtos value 2 precision)) (assoc 1 ent) ent ) ) ) (entmod ent) ) ) ;;MULTIPLY-BY...: ((= operation "mUltiply-by") (if (null number0) (setq number0 0.00 save4 number0 ) ) (setq number0 (getreal (strcat "Multiply by: <" (rtos number0 2 2) "> ")) index 0 ) (if (null number0) (setq number0 save4) (setq save4 number0) ) (GET-TEXT) (GET-DATA) (repeat (sslength Numbers) (setq ent (entget (ssname Numbers index)) value (read (cdr (assoc 1 ent))) index (1+ index) ) (if (numberp value) (setq value (* (float value) number0) ent (subst (cons 1 (rtos value 2 precision)) (assoc 1 ent) ent ) ) ) (entmod ent) ) ) ) (princ "<Exit>") (setvar "QAFLAGS" 0) (princ) )Tcal dùng lựa chọn AD (add-by) nhập hằng số K là -K nếu muốn trừ, K nếu muốn cộng
Bạn ơi bạn có thể thêm tiền tố vào trước kết quả xuất ra không? ví dụ (+1) + (+1) = (+2) tương tự với các ký tự khác ví dụ (layer1: 1,2) + (3) = (layer1: 3,2).
Và thêm phần +,-,*,/ với số nhập từ bàn phím nữa thì quá tuyệt. Thanks:D
-
lisp at2t của bác gia_bach rất hay, liệu bác có thể thêm phần quét chọn nhiều text 1 lúc được k? e thấy pic từng text 1 mất time quá. thanks bác
-
Bạn có thể bổ sung phần đặt tên text ghi kết quả theo ý muốn k.
Như hình vẽ, sau khi thực hiện phép cộng (1+10) ta sẽ xuất ra 1 text với kết quả là 11. Vậy mình muốn text xuất ra đó sẽ là "layer 11" và text layer được lưu lại mỗi lần thực hiện lệnh hoặc thay đổi tùy ý. Thanks:D
-
lisp căn giữa
http://www.cadviet.c.../99830_tc_1.lsp
và lisp căn trái, phải
http://www.cadviet.c...830_cantext.lsp
Đây là 2 lisp mình tìm được trên cadviet, do tìm được cũng lâu rồi nên mình cũng k nhớ link nữa, bạn giúp mình nhé. Thank
-
Mình đã tìm và sử dụng cùng lúc 2 lisp căn giữa và căn trái, phải. Tuy nhiên dùng như rất bất tiện và 2 lisp vẫn chưa hoàn thiện.
Lisp căn giữa căn 1 text thì ok nhưng 2 text trở lên thì nó lại trùng với nhau lại mất công move ra, còn lispt. Bạn có thể kết hợp 2 lisp đó và hoàn thiện thêm căn trên dưới như yêu cầu phía trên của mình đc k. Thanks :D
-
Thưa các bác, trong bản vẽ nhiều khi phải move nhiều đối tượng về cùng 1 phía (trái, phải, trên, dưới) cho đẹp và thuận tiện trong việc chỉnh sửa bản vẽ. Thế nhưng làm viêc này rất mất thời gian, vì vậy bác nào rành về lisp thì viết hộ e cái lisp với, thanks các bác nhiều :D.
sorry e nói chưa được rõ ý, e up hình dưới đây để các bác hiểu ý em hơn.
Yêu cầu là: Move text về cùng 1 phía lấy 1 text hay 1 đoạn thẳng bất kì làm chuẩn.
Lisp có thể áp dụng đối với mọi đối tượng.
-
xoay bên layout ntn hả bạn ơi.
-
Bạn ơi nếu vào screen thì toàn bộ bản vẽ sẽ bị mờ đi, màu nhợt nhạt lắm.
Mình chỉ muốn in nổi bật 1 phần của bản vẽ thôi.
-
Xin hỏi mọi người cách in 1 góc của bản vẽ nhạt màu hơn những chỗ khác để làm nổi lên phần mình muốn nhấn mạnh tới thì làm ntn.
Đối với những bản vẽ ít chi tiết thì mình có thể trim, break,... khoanh vùng rồi chọn màu, chọn nét in nhạt. Nhưng đối với bản vẽ nhiều chi tiết thì điều này là rất khó thực hiện.
Vậy có cách nào làm việc này cho nhanh không mọi người.
-
Mình nghĩ tốt nhất bạn nên tạo 1 file khung tên chuẩn, sau đó mở bản vẽ cần in ra rồi xref file khung tên vào phần layout.
Trong layout bạn tạo 1 khung mview khớp với khung tên, trong khung mview zoom hoặc pan khung bản vẽ trùng với khung tên là ok,
Đã có nhiều topic liên quan đề cập tới vấn đề này bạn thử tìm hiểu xem sao.
-
1
-
-
Đối với những bản vẽ có nhiều hatch như TH 2 thì việc chỉnh sửa rất mất thời gian.
Có bác nào biết cách giải quyết thì bảo em với, em cảm ơn các bác nhiều.
-
Lỗi bạn gặp phải có lẽ là do bị trùng nét hoặc layer đã bị thay đổi màu khác.
-
Mình thấy nhiều bản vẽ bên layout có thể dùng lệnh br bỏ đi 1 góc của VP ( tạo thành 1 khoảng trắng ) để thay vào đó là khung tên chẳng hạn. Mình dùng lệnh mv thì k thể nào làm được như thế, mọi người ai biết làm thì chỉ mình với. Thanks :D
-
Mình xài cad LT nên k có lệnh Flatten, vậy là hết cách phá block loại này hả bạn @@
-
Khi tạo block ta bỏ chọn ở ô " Allow exploding " thì không thể xplode theo cách thông thường, còn phá nó thể nào mình cũng k biết.
" Flatten " là lệnh gì thế bạn, mình xài cad LT nên k có lệnh này.
-
1
-
-
Với hatch khi vào option
TH 1: ta chọn associative thì phần hatch sẽ gắn liền với vật thể bao xung quanh, khi đó ta có thể stretch hay trim thoải mái cả phần hatch lẫn phần vật thể xung quanh.
TH 2: k chọn associative thì k làm được như TH 1.
Vậy có cách nào xử lý hatch được như TH 1 mà hatch đã trót làm như TH 2 không vậy mọi người.
-
Hay quá, mình làm được rồi. Thank bạn nhiều!
[Đã xong] Chia sẻ Bộ Lisp rất hay: ”Kho báu của Minh”
trong AutoLisp
Đã đăng · Trả lời báo cáo
Cho mình hỏi là lisp arr load vào bị lỗi font vậy làm cách nào để khắc phục vậy.