Bạn tham khảo lisp này (của ai quên mất) rồi tự nghiên cứu thôi. HỌC HỎI là tốt nhưng HỌC nhiều thì tốt hơn...

>>

 

Bạn tham khảo lisp này (của ai quên mất) rồi tự nghiên cứu thôi. HỌC HỎI là tốt nhưng HỌC nhiều thì tốt hơn HỎI nhiều.

;----- Trim and Delete outside of closed polyline (C¾t vµ xo¸ phÇn bªn ngoµi cña 1 polyline ®ãng).
; Required Express tools. OutSide Contour Delete with Extrim.
(defun C:OCD (  / en ss lst ssall bbox)
 (vl-load-com)
 (if (and (setq en (car (entsel "\nSelect contour (polyline): ")))
               (wcmatch (cdr (assoc 0 (entget en))) "*POLYLINE"))
  (progn
   (setq bbox (ACET-ENT-GEOMEXTENTS en))
   (setq bbox (mapcar '(lambda(x)(trans x 0 1)) bbox))
   (setq lst (ACET-GEOM-OBJECT-POINT-LIST en 1e-3))
   (ACET-SS-ZOOM-EXTENTS (ACET-LIST-TO-SS (list en)))
   (command "_.Zoom" "0.95x")
   (if (null etrim) (load "extrim.lsp"))
   (etrim en (polar (car bbox) (angle (car bbox) (cadr bbox)) (* (distance (car bbox)(cadr bbox)) 1.1)))
   (if (and
         (setq ss (ssget "_CP" lst))
         (setq ssall (ssget "_X" (list (assoc 410 (entget en))))))
    (progn
     (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
     (foreach e1 lst (ssdel e1 ssall))
      (ACET-SS-ENTDEL ssall))))))
(princ "\nType OCD to start")
(princ)

 lisp này cách thức của nó vẫn là dùng etrim  và xãy ra lỗi như đầu bài mình đã đề cập cái mình cần hỏi là làm sao lồng extrim vào nếu trong lisp gõ dòng lệnh (c:extrim) thì nó vẫn thực hiện lệnh tuy nhiên kế tiếp yêu cầu select object và chọn side to trim không thể thực hiện = 1 câu lệnh được , gõ vd: (setq ss (entsel "\n Chon boundary để trim")

pt (getpoint "\n CHỌN PHÍA TRIM"))

(etrim (car ss) pt)

thì cad nó hiểu nhưng bị lỗi hay xóa luôn 1 vài pline bên trong boundary mặc dù getpoint là bên ngoài

 

còn gõ

(setq ss (entsel "\n Chon boundary để trim")

pt (getpoint "\n CHỌN PHÍA TRIM"))

(c:extrim (car ss) pt) thì báo bad function many argument

<<

Download lisp

Filename: 396757_ocd.lsp

13 giờ trước, Phạm văn thành 1994 đã nói:

>>

13 giờ trước, Phạm văn thành 1994 đã nói:

 

vâng bác nói giống ý của e đấy ạ 

Thử code này xem mình không có file để Test, và cũng không biết sau khi có kết quả, thì kết quả này hiển thị dạng nào

1. Hiện dưới dòng command (dòng lệnh)

2. Ghi đè vô Text/Mtext/Dim có sẵn

lên bạn cứ dùng đi, tiện đâu thì sửa

(defun c:thunghiem(/ ent l ss str str_dim)
  
  (if (setq ss (ssget '((0 . "*DIM*"))))
    (progn
      (setq L 0.0)
      (foreach dt (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
	(setq ent (entget dt)
	      str_dim (if (/= (cdr(assoc 1 ent)) "") (cdr(assoc 1 ent)) (rtos (cdr(assoc 42 ent)) 2 8)))
	;xu ly string DIm
	(if (vl-string-search "=" str_dim)
	  (setq str (substr str_dim (+ 2 (vl-string-search "=" str_dim)) (strlen str_dim)))
	  (setq str str_dim)
	  )
	(if (= str "<>") (setq str (rtos (cdr(assoc 42 ent)) 2 8)))
	(setq L (+ L (atof str)))	
	)
      )
    )
  ;Them do chinh xac sau dau phay o day
  (princ (rtos L 2 4))
  ;Neu muon xuat ket qua gi vao Text hay Dim hay Mtext thi de lai dong nay
  (if (setq dt (car(entsel "\nChon Mtext/Text/Dim")))
    (entmod (subst (cons 1 (rtos L 2 4)) (assoc 1 (setq ent (entget dt))) ent))
    )
  (princ)
  )

Các bác cho em hỏi, trước này em dùng lisp up Dimmension về tỉ lệ hiện hành theo code sau: 

(defun c:UP() (command "DIM1" "UP"))

Bữa nay lại báo lỗi không hiểu lệnh thì không biết do lỗi gì hay em nghịch vào biến hệ thống nào ạ?

Command: (command "DIM1" "UP")
Unknown command "UP".  Press F1 for help.

Các bác cho em hỏi, trước này em dùng lisp up Dimmension về tỉ lệ hiện hành theo code sau: 

(defun c:UP() (command "DIM1" "UP"))

Bữa nay lại báo lỗi không hiểu lệnh thì không biết do lỗi gì hay em nghịch vào biến hệ thống nào ạ?

Command: (command "DIM1" "UP")
Unknown command "UP".  Press F1 for help.
nil

Nhờ sự giúp đỡ của anh SSG, bạn thanhbinh, bạn Tue_NV, đoạn code của anh Hoành đã viết sẵn, mình đã dùng để bổ sung thêm vài chỗ để hoàn chỉnh cái...

>>

Nhờ sự giúp đỡ của anh SSG, bạn thanhbinh, bạn Tue_NV, đoạn code của anh Hoành đã viết sẵn, mình đã dùng để bổ sung thêm vài chỗ để hoàn chỉnh cái lisp giãn dòng text này. Tuy chưa hiểu sâu lắm nhưng như anh SSG nói, có thể vận dụng nó rùi từ từ hiểu sau, vì hiện tại kiến thức còn yếu quá.

 

(defun c:gt ( / os dc i ss dt dtt dm)
(setq
os (getvar "osmode")
dc (getpoint "\nChon diem chuan: ")
i 0
)
(setvar "osmode" 0)
(setq ss (ssget '((0 . "TEXT")))
lst (ss2ent ss)
lst (vl-sort lst
'(lambda (e1 e2)
((caddr (assoc 10 (entget e1)))
(caddr (assoc 10 (entget e2)))
)
)
)
)
(foreach e lst
(setq
dt (entget e)
dtt (cdr (assoc 10 dt))
dm (list (car dc) (+ (cadr dc) (* i 500)))
)
(command ".justifytext" e "" "ml")
(command ".move" e "" dtt dm)
(setq i (1+ i))
)
(setvar "osmode" os)
(princ)
)

(defun ss2ent (ss / i Le e);;;Convert ss to list of ename
(setq i 0)
(repeat (sslength ss)
(setq
e (ssname ss i)
Le (append Le (list e))
i (1+ i)
)
)
Le
)

 

Nếu còn chỗ nào chưa hợp lý xin mọi người góp ý tiếp nhé.

Chúc mọi người luôn vui vẻ.

:cheers:

 

Chào bạn Tuan_thietkedien,

Bạn nên lưu ý hàm (setq lst (vl-sort lst '(lambda (e1 e2) (

Mặt khác trong trường hợp các text có cùng tọa độ y của điểm chèn text thì sao nhỉ??? Bạn đọc kỹ phần hướng dẫn về hàm vl-sort sẽ thấy là nó có thể sẽ mất tiêu một vài text mà chỉ giữ lại một text duy nhất trong số các text có cùng tọa độ y của điểm chèn này. Giữ cái nào thì mình cũng chưa rõ lắm, cần tìm hiểu thêm. Song bạn hãy thử với điều kiện phân loại là

 

Rất mong bạn thành công.

<<

Cám ơn a Tue_NV

Sau một hồi mò mẫm đủ mọi cách thì vòng lặp nó mới chạy.

Cho e hỏi cách dùng hàm member trên vẫn chạy đúng nhưng e ko thấy đoạn nào nó lấy số thứ tự của B để lấy kq ra cả, giống như dùng vòng lặp để xđ j nó vị trí thứ mấy trong B để lấy ra.

(nth (- (length a) (length (member (getint "Nhap x:") a))) b )...
>>

Cám ơn a Tue_NV

Sau một hồi mò mẫm đủ mọi cách thì vòng lặp nó mới chạy.

Cho e hỏi cách dùng hàm member trên vẫn chạy đúng nhưng e ko thấy đoạn nào nó lấy số thứ tự của B để lấy kq ra cả, giống như dùng vòng lặp để xđ j nó vị trí thứ mấy trong B để lấy ra.

(nth (- (length a) (length (member (getint "Nhap x:") a))) b ) 

(defun c:lp ()
(setvar "CMDECHO" 0)
(setq A (list 1.5 2.5 4 6 10 16 25 35 50 70 95 120 150 185 240 300)
  B (list 3.4 3.8 4.8 5.3 6.3 7.3 9 10 12 14 16 18 20 22 25 28)
 j 0
  x (getreal "x:") )
(while  (setq i (nth j A))
 (if (= i x)
 (setq kq j )
 )
  (setq j (1+ j))
)
(princ (nth kq B))
(setvar "CMDECHO" 1) 
(princ)
)

Chào bạn thuyvan0210. Đây là Code mà Tue_NV viết theo ý của bạn. Hy vọng bạn hài lòng :

(defun c:SCD()
(vl-load-com)
(command "undo" "be")
(setq oldos (getvar...
>>

Chào bạn thuyvan0210. Đây là Code mà Tue_NV viết theo ý của bạn. Hy vọng bạn hài lòng :

(defun c:SCD()
(vl-load-com)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 15359)

(setq olddim (getvar "dimzin"))

(setvar "dimzin" 0)
(setq mss (car(entsel "\n Chon mat so sanh :")))
(HLI mss)
(setq gtmss (getreal "\n Nhap gia tri mat so sanh :"))

(setq PL (car (entsel "\n Chon Pline :")))
(HLI PL)
(setq po (getpoint "\n Chon cac nut tren Polyline can ghi cao do :"))
(setq cao (getreal "\n Chon chieu cao chu :"))
(setq tp (getint "\n So chu so thap phan :"))

(while po

(setq po2 (vlax-curve-getClosestPointTo mss po))
(setq pot (list (car po2) (- (cadr po2) (/ cao 2)) 0))
(setq kc (+ (distance po po2) gtmss))
(Command "line" po po2 "")
(Command "style" "CADVIET" "TIMES.TTF" "0" "1" "0" "N" "N")
(Command "Text" "j" "BR" pot cao "90" (rtos kc 2 tp))
(HLI PL)
(setq po (getpoint "\n Chon cac nut tren Polyline can ghi cao do :"))

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

;
(defun HLI(enT)
(sssetfirst (ssadd enT (ssadd)) (ssadd enT (ssadd)))
)

Trước tiên mình cảm ơn bạn! Nhưng mà đoạn lisp bạn viết nó cũng gần giống đoạn lisp của mình. Mình muốn chỉ chọn pline một lần duy nhất thôi, lisp sẽ tự định nghĩa các nút của pline đó, chứ ko phải chọn lại từng nút như vậy nữa. bạn xem lại hộ mình nhé!

<<

 

cảm ơn anh, cái lisp trên chạy tốt anh ạ, nhưng nó chỉ chạy với điều kiện riêng để gọi block, sửa text và quay chữ thôi,...

>>

 

cảm ơn anh, cái lisp trên chạy tốt anh ạ, nhưng nó chỉ chạy với điều kiện riêng để gọi block, sửa text và quay chữ thôi, còn phần chuyển layer và nét tim đường thì phải làm riêng! anh có thể bổ sung giúp em cái phần của anh vào cái lisp này được không ạ!

(DEFUN C:TD5(/ cnt enam ent pnt s1 tot v1 val)(setvar "CMDECHO" 0.000)
(prompt "\nChon cac duong muon chuyen: ")
   (setq tl (getvar "textstyle"))
   (COMMAND "-LAYER" "m" "Tim duong" "color" 3 "" "")(PRINC)
   (SETQ A (SSGET))
   ("CHPROP" A PAUSE "c" "3" "la" "Tim duong" "lt" "acad_iso10w100" "s" "0.15" "")(princ)
   (command "insert" "D:\\Dowload\\62465_ten_duong.dwg" (getpoint "\n Chon diem bat ky tren ban ve") 1 1 0)
  (command "textstyle" tl)(princ))

Hề hề hề,

Trước hết bạn cần hiểu rằng cái lisp của bạn sử dụng để thay đổi color,layer, linetype, linetypescale. cho một nhóm nhiều đối tượng chứ không phải chỉ cho một đối tượng.

Trong khi lisp mình viết cho bạn lại chỉ dùng để nhập text vào một đường chọn trước mà thôi.

Việc ghép hai lisp này không phải là không thể mà vấn đề là cần hiểu đúng mục tiêu của bạn mới làm được. Bạn nên nói rõ vấn đề này.

<<

Oki thanks ketxu

(defun c:lp (/)
(setvar "CMDECHO" 0)
(setq A (list 1.5 2.5 4 6 10 16 25 35 50 70 95 120 150 185 240 300);
  B (list 3.4 3.8 4.8 5.3 6.3 7.3 9 10 12 14 16 18 20 22 25 28)
kq (nth (- (length a) (length (member (getreal "Nhap x:") a))) b )
)
(setq sl(getreal "\nCho so luong cap can tinh toan: ")
 tdtt (/ (* 3.14 kq kq sl) 4)
)
(princ (strcat "\nTiet dien tinh toan" " "(rtos tdtt 2 2) "mm2" ))
(setvar "CMDECHO"...
>>

Oki thanks ketxu

(defun c:lp (/)
(setvar "CMDECHO" 0)
(setq A (list 1.5 2.5 4 6 10 16 25 35 50 70 95 120 150 185 240 300);
  B (list 3.4 3.8 4.8 5.3 6.3 7.3 9 10 12 14 16 18 20 22 25 28)
kq (nth (- (length a) (length (member (getreal "Nhap x:") a))) b )
)
(setq sl(getreal "\nCho so luong cap can tinh toan: ")
 tdtt (/ (* 3.14 kq kq sl) 4)
)
(princ (strcat "\nTiet dien tinh toan" " "(rtos tdtt 2 2) "mm2" ))
(setvar "CMDECHO" 1)
(princ)
)

Còn đoạn mã của DVH để mình xem chút rồi sửa coi. Thanks.

Bạn chú ý linetype CENTER Phải đã được load Không thì thêm đoạn này...

>>

Bạn chú ý linetype CENTER Phải đã được load Không thì thêm đoạn này vào đầu lisp :

 

 

=> Lisp thành :

 

(defun c:cl(/ eLine ll ur pl pr pt pb ex ss)
(vl-load-com)
(if (= (tblsearch "ltype" "CENTER") nil)(command "-linetype" "l" "CENTER" "acad.lin" ""))
(grtext -1 "Center Line @Ketxu")
(defun eLine(p1 p2)(entmakex (list (cons 0 "LINE")(cons 62 3)(cons 10 p1)(cons 11 p2)(cons 6 "CENTER"))))
(while (setq ss (ssget))
(vlax-for e (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object)))
(vla-getboundingbox e 'll 'ur)
(setq ll (vlax-safearray->list ll)
 ur (vlax-safearray->list ur)
 ex (/ (abs (-(car ll)(car ur))) 6) ;Extend outside Rectangle
 pl (list (- (car ll) ex) (/ (+ (cadr ll)(cadr ur)) 2))
 pr (list (+ (car ur) ex) (cadr pl))
 pt (list (/ (+ (car ll)(car ur)) 2) (+ (cadr ur) ex))
 pb (list (car pt) (- (cadr ll) ex))
)
(eLine pl pr)
(eLine pt pb)
)
)
)

Cảm ơn bạn nhiều,nhưng mình muốn khi vẽ đường trục đó mặc định nó vẽ đường trục đó bằng layer TRUC đã có trên bản vẽ,tiện thể cho mình hỏi phần trục dư ra ngoài các hình kích thước dài như thế nào vậy?

<<

Hiện tại e có tìm được 2 cái lisp trong cadviet ghi lý trình và ghi khoảnh cách tới tim và khoảng cách, nhưng giờ e muốn kết hợp cả 2 cái vào với nhau nhưng chưa biết chỉnh sửa thế nào cho đc, e thì cũng mới tìm hiểu về lisp lên chưa sửa được. Mong muốn của e thì đc như hình vẽ phí dưới. e muốn các bác chỉnh sửa lại cho e cái lisp: glt với ạ. xem xin cảm ơn các bác. em có để 2 lisp...

Hiện tại e có tìm được 2 cái lisp trong cadviet ghi lý trình và ghi khoảnh cách tới tim và khoảng cách, nhưng giờ e muốn kết hợp cả 2 cái vào với nhau nhưng chưa biết chỉnh sửa thế nào cho đc, e thì cũng mới tìm hiểu về lisp lên chưa sửa được. Mong muốn của e thì đc như hình vẽ phí dưới. e muốn các bác chỉnh sửa lại cho e cái lisp: glt với ạ. xem xin cảm ơn các bác. em có để 2 lisp trong đính kèm file (KC và LT, e lấy trong lisp ttt để e chạy ra ạ). Em xin chân thành cảm ơn các bác nhiều.

;; free lisp from cadviet.com
;;; this lisp was downloaded from https://www.cadviet.com/forum/topic/53192-y%C3%AAu-c%E1%BA%A7u-lisp-t%C3%ADnh-l%C3%BD-tr%C3%ACnh-c%C3%A1c-%C4%91i%E1%BB%83m-tr%C3%AAn-1-polylineline/#entry168075

(defun c:glt (/ pl plst pa pd k l ltg p0 a lt lt1 lt2 txt tg etg txtp txtp1 txtp2 dl dl1 dl2)
(vl-load-com)
(command "undo" "be")
(setq ucsold (getvar "ucsname"))
(command "ucs" "w")
(setq pl (car (entsel "\n Chon polyline can ghi ly trinh")))
(setq plst (vl-sort (acet-geom-vertex-list pl) '(lambda (x y) (< (car x) (car y)))))
(setq pa "T")
(if (= (strcase pa) "T")
   (setq pd (car plst))
   (setq pd (last plst))
)
(setq p0 (getpoint "\n Chon diem goc ghi ly trinh"))
(setq ltg (getreal "\n Nhap ly trinh goc: "))         
(setq k 2)
(setq l 1)
(setq a (getpoint "\n Chon point can ghi ly trinh"))
(while ( /= a nil)
(if (= l 1)
   (progn
         (if (equal (vlax-curve-getStartPoint (setq obj (vlax-ename->vla-object pl))) pd 0.001)
             (setq lt (+ (- (vlax-curve-getDistAtPoint obj (vlax-curve-getClosestPointTo obj a)) 
                                  (vlax-curve-getdistatpoint obj (vlax-curve-getclosestpointto obj p0))  ) ltg )  )
             (setq lt (+ (- (vlax-curve-getdistatpoint obj (vlax-curve-getclosestpointto obj p0)) 
                                  (vlax-curve-getDistAtPoint obj (vlax-curve-getClosestPointTo obj a))
                                    ) ltg )  )
         )
         (setq dl (abs (- lt (* (fix (/ lt 1000)) 1000))))
         (if (< (fix dl) 100)
             (if (< (fix dl) 10)
                 (setq txtp (strcat "00" (rtos dl 2 k)))
                 (setq txtp (strcat "0" (rtos dl 2 k)))
             )
             (setq txtp (rtos dl 2 k))
         )
         (if (> lt 0)
             (setq txt (strcat "Km" (itoa (fix (/ lt 1000))) "+" txtp))
             (setq txt (strcat "Km" (itoa (fix (/ lt 1000))) "-" txtp))
         ) 
         (setq tg (car (entsel "\n Chon text can thay the ")))
         (setq etg (entget tg))
         (setq etg (subst (cons 1 txt) (assoc 1 etg) etg))
         (entmod etg)
   )
   (progn
        (if (equal (vlax-curve-getStartPoint (setq obj (vlax-ename->vla-object pl))) pd 0.001)
            (progn
                 (setq lt1 (+ (- (vlax-curve-getDistAtPoint obj (vlax-curve-getClosestPointTo obj a))
                                        (vlax-curve-getdistatpoint obj (vlax-curve-getclosestpointto obj p0))  ) ltg )  )
                 (setq lt2 (+ (- (vlax-curve-getDistAtPoint obj (vlax-curve-getClosestPointTo obj (getpoint "\n Chon second point can ghi ly trinh")))
                                        (vlax-curve-getdistatpoint obj (vlax-curve-getclosestpointto obj p0))  ) ltg ))
            )
            (progn
                (setq lt1 (+ (- (vlax-curve-getdistatpoint obj (vlax-curve-getclosestpointto obj p0)) 
                                       (vlax-curve-getDistAtPoint obj (vlax-curve-getClosestPointTo obj a))  ) ltg ))
                (setq lt2 (+ (- (vlax-curve-getdistatpoint obj (vlax-curve-getclosestpointto obj p0))
                                       (vlax-curve-getDistAtPoint obj (vlax-curve-getClosestPointTo obj (getpoint "\n Chon second point can ghi ly trinh"))) ) ltg ))
            )
         )
         (setq dl1 (abs (- lt1 (* (fix (/ lt1 1000)) 1000))))
         (if (< (fix dl1) 100)
             (if (< (fix dl1) 10)
                 (setq txtp1 (strcat "00" (rtos dl1 2 k)))
                 (setq txtp1 (strcat "0" (rtos dl1 2 k)))
             )
             (setq txtp1 (rtos dl1 2 k))
         )
         (setq dl2 (abs (- lt2 (* (fix (/ lt2 1000)) 1000))))
         (if (< (fix dl2) 100)
             (if (< (fix dl2) 10)
                 (setq txtp2 (strcat "00" (rtos dl2 2 k)))
                 (setq txtp2 (strcat "0" (rtos dl2 2 k)))
             )
             (setq txtp2 (rtos dl2 2 k))
         )
         (if (and (>=  lt1 0) (>=  lt2 0))
              (setq txt (strcat "Km" (itoa (fix (/ lt1 1000))) "+" txtp1 "-Km" (itoa (fix (/ lt2 1000))) "+" txtp2 )))
         (if (and (>=  lt1 0) (<  lt2 0))
             (setq txt (strcat "Km" (itoa (fix (/ lt1 1000))) "+" txtp1 "-Km" (itoa (fix (/ lt2 1000))) "-" txtp2 )))
         (if (and (<  lt1 0) (>=  lt2 0))
              (setq txt (strcat "Km" (itoa (fix (/ lt1 1000))) "-" txtp1 "-Km" (itoa (fix (/ lt2 1000))) "+" txtp2 ))) 
         (if (and (<  lt1 0) (<  lt2 0))
              (setq txt (strcat "Km" (itoa (fix (/ lt1 1000))) "-" txtp1 "-Km" (itoa (fix (/ lt2 1000))) "-" txtp2 )))
         (setq tg (car (entsel "\n Chon text can thay the ")))
         (setq etg (entget tg))
         (setq etg (subst (cons 1 txt) (assoc 1 etg) etg))
         (entmod etg)
    )
)
(setq a (getpoint "\n Ban hay chon diem tiep theo: "))
)
(if (/= ucsold "")
   (command "ucs" "p")
)
(command "undo" "e")
(princ)
) 

Ghi ly trinh.dwg

glt.lsp

ttt.lsp

 

Tue_NV chưa thực hiện yêu cầu ở dòng màu đỏ vì bạn chưa nói rõ từ đầu

Bạn sử dụng Lisp này cho hoàn thiện đã, có gì...

>>

 

Tue_NV chưa thực hiện yêu cầu ở dòng màu đỏ vì bạn chưa nói rõ từ đầu

Bạn sử dụng Lisp này cho hoàn thiện đã, có gì rồi Tue_NV sẽ hoàn thiện thêm :

(defun c:dstt(/ ans dau cuoi po po1 ent i cao r)(setvar "cmdecho" 0)(initget "D C")(setq ans (getkword "\n Ban muon danh so tang dan o vi tri dau hay cuoi < D / C >:"))(if (= ans "D")(progn(setq dau (getint "\n Danh so bat dau :") i 1)(setq cuoi (getstring 5"\n Danh chuoi ki tu ket thuc :"))(if (not caoo) (setq caoo 5))(setq cao (getdist (strcat "\n Nhap chieu cao chu <" (rtos caoo 2 2) "> :")))(if (not cao) (setq cao caoo) (setq caoo cao))(if (not ro) (setq ro 1))(setq r (getdist (strcat "\n Nhap do rong chu <" (rtos ro 2 2) "> :")))(if (not r) (setq r ro) (setq ro r))(setq po (getpoint (strcat "\n Cho diem chen cua so : " (itoa dau) cuoi))) (wtxt (strcat (itoa dau) cuoi) po cao r)(setq eL (entlast))(command "circle" po (* 1.1 cao))(while po(setq po1 (getpoint po (strcat "\n Cho diem chen cua so : " (itoa (+ dau i)) cuoi)))(command "copy" eL "" po po1) (setq eL (entlast))(setq ent (entget eL))(setq ent (subst (cons 1 (strcat (itoa (+ dau i)) cuoi)) (assoc 1 ent) ent))(entmod ent)(setq i (1+ i))(command "circle" po1 (* 1.1 cao))(setq po po1));while))(if (= ans "C")(progn(setq dau (getstring 5"\n Danh chuoi ki tu bat dau :") i 1)(setq cuoi (getint "\n Danh so ket thuc :"))(if (not caoo) (setq caoo 5))(setq cao (getdist (strcat "\n Nhap chieu cao chu <" (rtos caoo 2 2) "> :")))(if (not cao) (setq cao caoo) (setq caoo cao))(if (not ro) (setq ro 1))(setq r (getdist (strcat "\n Nhap do rong chu <" (rtos ro 2 2) "> :")))(if (not r) (setq r ro) (setq ro r))(setq po (getpoint (strcat "\n Cho diem chen cua so : " dau (itoa cuoi) ))) (wtxt (strcat dau (itoa cuoi)) po cao r)(setq eL (entlast))(command "circle" po (* 1.1 cao))(while po(setq po1 (getpoint po (strcat "\n Cho diem chen cua so : " dau (itoa (+ cuoi i)) )))(command "copy" eL "" po po1) (setq eL (entlast))(setq ent (entget eL))(setq ent (subst (cons 1 (strcat dau (itoa (+ cuoi i)) )) (assoc 1 ent) ent))(entmod ent)(setq i (1+ i))(command "circle" po1 (* 1.1 cao))(setq po po1));while))(princ));(defun wtxt (txt p h w / sty d)(setq sty (getvar "textstyle")d (tblsearch "style" sty))(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt)(cons 40 h) (cons 10 p) (cons 11 p) (cons 41 w)(cons 72 1) (cons 73 2) )))

Chào bạn Tue_NV. 

Mình down file fisp này về sử dụng. Khi load file vào cad thì nó báo lỗi :" error: malformed list on input" . 

Mình cũng đã copy toàn bộ code về nhưng vẫn có lỗi như thế. 

Vì bài viết cũng lâu rồi không biết có lỗi j không. 

Bạn có thể gửi cho mình vào mail: levantuan225@gmail.com được không? 

Cám ơn bạn rất nhiều! 

<<

Nếu chỉ có 1 hình có thể vẽ thủ công bằng cách vẽ Ellipse với sự lựa chọn:

Command: pellipse

Enter new value for PELLIPSE <0>: 1

Sau đó tạo block 1 chữ rồi array theo đường dẫn, cũng không tốn nhiều thời gian lắm!

@ Bác Đoan Van Ha: Sao cad của em không cho sửa tex được tạo ra từ lệnh arctext?

@Bác...

Nếu chỉ có 1 hình có thể vẽ thủ công bằng cách vẽ Ellipse với sự lựa chọn:

Command: pellipse

Enter new value for PELLIPSE <0>: 1

Sau đó tạo block 1 chữ rồi array theo đường dẫn, cũng không tốn nhiều thời gian lắm!

@ Bác Đoan Van Ha: Sao cad của em không cho sửa tex được tạo ra từ lệnh arctext?

@Bác Tue_NV:

Lisp scale một chiều với tham số R của bác em dùng ko được, sau khi chọn đối tượng nó ra thông báo sau:

Command: xsc Chon doi tuong can scale:

Select objects: 1 found

Select objects:

Base point:

Bấm chọn 1 điểm nó ra như này:

Base point: ; error: too many arguments

Command:

Chịu chết ko dùng được, ko hiểu vì sao?

Đây là đoạn Code Scale 1 chiều, Tue_NV đã cải tiến lại với lựa chọn thêm tham số R giống như Scale 2 chiều. Các bạn sử dụng và cho biết ý kiến thêm để Tue_NV hoàn thiện nhé.

Cảm ơn các bạn

;XSCALE Scale the mot chieu lenhtat :XSC(DEFUN EXCUTE()  (setq oldvalue (getvar "CMDECHO"))  (setvar "CMDECHO" 0)  (princ "Chon doi tuong can scale: ")  (setq ss (ssget))  (setq P0 (getpoint "\n Base point: "))  (initget 1 "X Y X S")  (setq C (getkword "\nScale theo ? :"))(setq hstr (getstring "\n Cho biet he so scale or Reference < R >"))(if (/= hstr "R") (setq hs (distof hstr 2)))(if (or (= hstr "R") (= hstr ""))(progn(setq po1 (getdist p0 "\n Nhap chieu dai cua doan 1 hay Pick diem thu 2 cua canh thu 1:"))(setq po2 (getdist p0 "\n Nhap chieu dai cua doan 2 hay Pick diem thu 2 cua canh thu 2:"))(setq hs (/ po2 po1))))  (DELBLOCK "VKC_TEMP")  (CREATEBLOCK ss P0)    (Command "-Insert" "VKC_TEMP" C hs P0 "") 	(setq dt (entlast))  (Command "Explode" dt)  (setvar "CMDECHO" oldvalue)  (princ))(DEFUN CREATEBLOCK(ss P)  (command "-Block" "VKC_TEMP" P ss ""))(DEFUN DELBLOCK (bname)  (if (IsExistBlock bname)    (Command "-Purge" "B" bname "Y" "Y")      ))(DEFUN IsExistBlock(bname / kq)  (setq kq Nil)  (setq n (length LiBlk))  (setq i 0)  (while (< i n)    (if (= bname (nth i LiBlk))      (progn    (setq i n)    (setq kq T)      )        )    (setq i (1+ i))  )  kq)(DEFUN CREALIBLK (/ NL)  (setq LiBlk (List))  (setq NL (tblnext "BLOCK" T))    (while NL        (setq LiBlk (append LiBlk (list (cdr (assoc 2 NL)))))    (setq NL (tblnext "BLOCK"))  )  (setq LiBlk (Acad_strlsort LiBlk)))(DEFUN C:XSCALE()  (CREALIBLK)  (EXCUTE))(DEFUN C:XSC()  (CREALIBLK)  (EXCUTE))

 

Bạn thử xem nhé, còn font .vni thì mình thấy nó trong lsp nó cũng set toàn bộ font là .vni mà ^^. cho nhập độ chính xác như...

>>

 

Bạn thử xem nhé, còn font .vni thì mình thấy nó trong lsp nó cũng set toàn bộ font là .vni mà ^^. cho nhập độ chính xác như bạn mún, chạy với layer bất kỳ

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=68491&st=40
(defun *error* (msg)
  (princ "error: ")
  (princ msg)
  (princ)
)
(defun Wdis (p1 p2 / dis ang point)
  (setq dis (distance p1 p2))
  (setq ang (angle p1 p2))
  (if (and (> ang (/ Pi 2)) (< ang (* Pi 1.5)) )
(progn
   (setq ang (+ Ang Pi))
   (setq Point (polar p2 ang (/ dis 2.0)))
)
(setq Point (polar p1 ang (/ dis 2.0)))
  )
  (command "Text" "S" "vaptimn" "c" point (/ TileBdHT 500) (* (/ ang Pi) 180) (rtos dis 2 ca))
)
(defun ssgetLayer( La1 La2 / ss)
  (setq ss (ssget "X" (list
                  	(cons -4  "<OR")
                    	(cons -4  "<AND")
                      	(cons 8 La1)
                      	(cons 0  "LWPOLYLINE")
                    	(cons -4  "AND>")
                    	(cons -4  "<AND")
                      	(cons 8 La1)
                      	(cons 0  "LINE")
                    	(cons -4  "AND>")
                    	(cons -4  "<AND")
                      	(cons 8 La2)
                      	(cons 0  "LWPOLYLINE")
                    	(cons -4  "AND>")
                    	(cons -4  "<AND")
                      	(cons 8 La2)
                      	(cons 0  "LINE")
                    	(cons -4  "AND>")
                  	(cons -4  "OR>")
                	)
  ))
  ss
)
(defun pointpl (name tM k / namem i bien t1 p1 diem)
(setq namem name)
(setq i 1)
(while (<= i k)
(progn
  (setq bien (assoc tM namem))
  (setq t1 (member bien namem))
  (setq p1 (car t1))
  (setq namem (cdr t1))
  (setq diem (cdr p1))
  (setq i (+ 1 i))
)
)
diem
)
(defun c:tdd( / i k luuxy p xoa)
(setvar "cmdecho" 0)
(progn
(if (null (tblsearch "style" "vaptimn"))
  (command "_style" "vaptimn" ".vnarial" "" "" "" "" ""))
(if (null (tblsearch "style" "vhelveb"))
  (command "_style" "vhelveb" ".vnarial" "" "" "" "" ""))
(if (null (tblsearch "layer" "sohieu_diem"))
  (command "_layer" "n" "sohieu_diem" ""))
(command "_layer" "c" "2" "sohieu_diem" "")
(if (null (tblsearch "layer" "bang_toado"))
  (command "_layer" "n" "bang_toado" ""))
(command "_layer" "c" "7" "bang_toado" "")
(command "_layer" "c" "6" "thua" "")
(command "_layer" "c" "6" "100" "")
(setq r1 (getvar "USERI1"))
(setq TileBdHT (getreal (strcat "\nMau So Ti Le Cua BDHT" "(" (rtos r1 2 0) "):")))
(setq tdo (getint "\nNhap do chinh xac toado:"))
(setq ca (getint "\nNhap do chinh xac canh:"))
(if (= TileBdHT nil)
  (setq TileBdHT r1))
(setvar "USERR1" TileBdHT)
(setvar "blipmode" 0)
(setq old (getvar "osmode"))
(setvar "osmode" 0)
(setq p (getpoint "\n Pick"))
(if (/= p nil)
  (command "-Boundary" "a" "b" "n" "" "" p "" )
)
(setq luuxy (entget (entlast)))
(setq p (getpoint "\n Diem dat bang toa do :"))
(entdel (entlast))
(setq k (cdr (assoc 90 luuxy)))
(if (/= p nil)
  (progn
   (setq p01 p)
   (setq p02 (mapcar '+ p '(10.0  0.0 0.0)))
   (setq p03 (mapcar '+ p '(22.5 -2.5 0.0)))
   (setq p04 (mapcar '+ p '(35.0  0.0 0.0)))
   (setq p05 (mapcar '+ p '(45.0  0.0 0.0)))
   (setq p06 (mapcar '+ p '(0.0 -5.0 0.0)))
   (setq p07 (mapcar '+ p '(10.0 -2.5 0.0)))
   (setq p08 (mapcar '+ p '(35.0 -2.5 0.0)))
   (setq p09 (mapcar '+ p '(45.0 -5.0 0.0)))
   (if (<= k 10) 
(progn
  (setq p10 (mapcar '+ p '(0.0 -40.0 0.0)))
  (setq p11 (mapcar '+ p '(10.0 -40.0 0.0)))
  (setq p12 (mapcar '+ p '(22.5 -40.0 0.0)))
  (setq p13 (mapcar '+ p '(35.0 -40.0 0.0)))
  (setq p14 (mapcar '+ p '(45.0 -40.0 0.0)))
)
(progn
  (setq ty (* -1 (+ 10.0 (* k 3))))
  (setq t0 (list 0.0 ty 0.0))
  (setq t1 (list 10.0 ty 0.0))
  (setq t2 (list 22.5 ty 0.0))
  (setq t3 (list 35.0 ty 0.0))
  (setq t4 (list 45.0 ty 0.0))
  (setq p10 (mapcar '+ p t0))
  (setq p11 (mapcar '+ p t1))
  (setq p12 (mapcar '+ p t2))
  (setq p13 (mapcar '+ p t3))
  (setq p14 (mapcar '+ p t4))
)
   )
   (command "layer" "s" "bang_toado" "")
   (command "Line" p01 p05 "")
   (command "Line" p01 p10 "")
   (command "Line" p02 p11 "")
   (command "Line" p03 p12 "")
   (command "Line" p04 p13 "")
   (command "Line" p05 p14 "")
   (command "Line" p07 p08 "")
   (command "Line" p06 p09 "")
   (command "Line" p10 p14 "")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(22.5 2.0 0.0)) 1.25 0 "B¶NG LIÖT K£ TäA §é GãC RANH")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(5.0 -1.5 0.0)) 1.15 0 "Sè hiÖu ®iÓm")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(5.0 -3.5 0.0)) 1.15 0 "Tªn ®iÓm")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(22.5 -1.25 0.0)) 1.15 0 "Täa ®é")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(16.25 -3.75 0.0)) 1.15 0 "X(m)")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(28.75 -3.75 0.0)) 1.25 0 "Y(m)")
(command "Text" "S" "vhelveb" "j" "M" (mapcar '+ p '(40.0 -2.5 0.0)) 1.25 0 "C¹nh")
  )
)
(setq i 1)
(while (<= i k)
  (progn
   (setq toado (pointpl luuxy 10 i))
   (setq x (rtos (car toado) 2 tdo))
   (setq y (rtos (cadr toado) 2 tdo))
   (command "layer" "s" "sohieu_diem" "")
   (setq doi (list (* 0.2 (/ TileBdHT 500)) (* 0.2 (/ TileBdHT 500)) 0.0))
   (command "Text" "S" "vaptimn" (mapcar '+ toado doi) (/ TileBdHT 500) 0 i)
   (command "donut" "0.0" (* 0.25 (/ TileBdHT 500)) toado "") 
   (setq tsh (list 5.0 (- (* -3 i) 4.5) 0.0))
   (setq txx (list 16.25 (- (* -3 i) 4.5) 0.0))
   (setq tyy (list 28.75 (- (* -3 i) 4.5) 0.0))
   (setq tgc (list 40.0 (- (* -3 i) 3.0) 0.0))
   (setq psh (mapcar '+ p tsh))
   (setq pxx (mapcar '+ p txx))
   (setq pyy (mapcar '+ p tyy))
   (setq pgc (mapcar '+ p tgc))
   (if (= i 1)
(progn
  (setq toado1 toado)
  (setq x1 (rtos (car toado1) 2 tdo))
  (setq y1 (rtos (cadr toado1) 2 tdo))
)
   )
   (if (>= i 2)
(progn
(setq canh (distance toado0 toado))
(command "layer" "s" "bang_toado" "")
(command "Text" "S" "vaptimn" "j" "M" pgc 1.2 0 (rtos canh 2 ca) )
(command "layer" "s" "sohieu_diem" "")
(wdis toado0 toado)
)
   )
   (command "layer" "s" "bang_toado" "")
   (command "Text" "S" "vaptimn" "j" "M" psh 1.2 0 i)
   (command "Text" "S" "vaptimn" "j" "M" pxx 1.2 0 y)
   (command "Text" "S" "vaptimn" "j" "M" pyy 1.2 0 x)
   (setq toado0 toado)
   (setq i (+ i 1))
  )
)
(command "layer" "s" "sohieu_diem" "")
(wdis toado toado1)
(setq canh (distance toado toado1))
   (setq tsh (list 5.0 (- (* -3 (+ k 1)) 4.5) 0.0))
   (setq txx (list 16.25 (- (* -3 (+ k 1)) 4.5) 0.0))
   (setq tyy (list 28.75 (- (* -3 (+ k 1)) 4.5) 0.0))
   (setq tgc (list 40.0 (- (* -3 (+ k 1)) 3.0) 0.0))
   (setq psh (mapcar '+ p tsh))
   (setq pxx (mapcar '+ p txx))
   (setq pyy (mapcar '+ p tyy))
   (setq pgc (mapcar '+ p tgc))
(command "layer" "s" "bang_toado" "")
(command "Text" "S" "vaptimn" "j" "M" pgc 1.2 0 (rtos canh 2 ca) )
(command "Text" "S" "vaptimn" "j" "M" psh 1.2 0 "1")
(command "Text" "S" "vaptimn" "j" "M" pxx 1.2 0 y1)
(command "Text" "S" "vaptimn" "j" "M" pyy 1.2 0 x1)
(setvar "osmode" old)
) ;(end progn)
;(end if)
)

Ps: còn 1 chỗ nhoc mò chưa ra, cũng có thể nói là ko pit ^^ là nếu số lẽ đằng sau vd:2.199 thì nó ko làm tròn đc 3 số là 2.200 mà nó thành 2.20, nếu số lẽ đằng ssau vẫn lẽ thì vẫn đc n số lúc nhập độ chính xác

cái này của bác thực sự là quá hay rồi, nhưng bác có thể giúp em thêm các số hiêụ đỉnh vào bản vẽ đc không ?chứ suất một loạt ra rồi chẳng biết điểm 1 ở đâu, điểm 2 ở đâu bác à.Mong bác giúp đỡ

<<

 

-^^ nói đến chuyên môn thì nhoc còn phải mót nhiều, do hoàn cảnh, tính chất công việc hiện tai của nhoc , mỗi người 1...

>>

 

-^^ nói đến chuyên môn thì nhoc còn phải mót nhiều, do hoàn cảnh, tính chất công việc hiện tai của nhoc , mỗi người 1 hoàn cảnh 1 lời khó mà nói hết a ah, chủ yếu là vì nhoc thích tìm tòi ^^, mỗi lần viết thấy vui, tương lai thế nào chưa rõ, cố đc đến đâu hay đến đó.

- Clip anh nhoc xem trước đó rùi ^^, cách biên tập của a nó không giống bên nhoc, bên nhoc nhoc cũng có vài công trình dạng tuyến chỉ rãi lưới đơn giản khổ giấy lớn hơn

- mục đích nhoc thử làm lsp này để hỗ trợ cho chương trình sẵn của cơ quan, nhưng có nhiều khi mình mún xử lý độc lập, còn chương trình nó hay ràng buộc theo nhiều cái khác khó xử lý tính huống nhanh^^

- nhoc ko giỏi hơn anh đâu ^^, nhoc chậm tiu lắm, chỉ cố gắng hết theo sức mình có

- nhoc có xem qua lsp tạo lưới của a, nhưng nó còn hơi cao với nhoc, nhìn lsp của nhoc đơn giản thui, nhưng mất đến 2 ngày nhoc mới làm xong kaka

;hàm tao textstyle
(defun emk_style (MyStyle MyFont)
(entmake (list    (cons 0 "STYLE")    
(cons 100 "AcDbSymbolTableRecord")    
(cons 100 "AcDbTextStyleTableRecord")    
(cons 2 MyStyle)    (cons 3  MyFont)    
(cons 70 0))))
;;;;
(defun MakeLine (PT1 PT2 Layer Linetype LTScale xdata)
	(entmakex (list '(0 . "LINE")
	(cons 8 (if Layer Layer (getvar "Clayer")))
	(cons 6 (if Linetype Linetype "bylayer"))
	(cons 48 (if LTScale LTScale 1))
	(cons 10 PT1)	(cons 11 PT2)
	(cons -3 (if xdata (list xdata) nil))))) 
;;;;;;--------------------------------------------------------------------------------------------
;================================================================================================
(defun dtr (a)
(* (/ a 180.0) pi)
)
(prompt "LISP TAO LUOI TOA DO BAN DO VI TRI, LENH : KKL")
;;;
(defun c:kkl (/ donvi nx ny pt1 pt2 pt3 pt4 kcx kcy goc1 goc2 x1 x y  heso old ptext1 ptext2 ptext3 ptext4 str str2 goc3 htext num )
(vl-load-com)
(setq old (getvar "osmode"))
(if (null (tblsearch "STYLE" "vusaln"))
    (emk_style "vusaln" "Vaptimn.TTF"))
(if (null (tblsearch "LAYER" "A1-luoik"))
    (_layer2 "A1-luoik" 7))
  (setq donvi (list (cons 1  100) (cons 2  50) (cons 3  25)))
  (setq tyleVT (getvalue tyleVT 1000.0 "Nhap ty le ban do VT: "))
  (setq heso (/ 1000 tyleVT))
  (setq htext (/ 2.0 heso))
;===================================*******************++++++++++++++++++++********************===================================  
(while (and (setvar "osmode" 1)
            (setq pt1 (getpoint "\nChon diem goc duoi trai khung:"))
            (setq pt2 (getpoint pt1 "\nChon diem goc tren phai khung:")))
(progn
(setvar "osmode" 0)
;======================================================================
;=======================================================================
(setq pt3 (inters pt1 (polar pt1 (/ pi 2) 90000) pt2 (polar pt2 pi 90000) nil))
(setq pt4 (inters pt1 (polar pt1 0 90000) pt2 (polar pt2 (dtr 270) 90000) nil))
(setq kcx (distance pt1 pt4) kcy (distance pt1 pt3))
;==============================================================================
(cond 
((and (>= (/ kcx 100) 2) (>= (/ kcy 100) 2))
;==========================================================
(setq nx (fix (/ kcx 100)) ny (fix (/ kcy 100)))
(setq goc2 (list (lamtron (fix (+ (car pt1) 10))) (cadr pt1) 0.0))
(setq goc3 (list (car pt1) (lamtron (fix (+ (cadr pt1) 10))) 0.0))
;============================================================
(repeat nx

(makeline goc2 (polar goc2 (/ pi 2) (/ 8.0 heso)) "A1-luoik" nil nil nil)
;=======================================================================
(setq ptext1 (polar goc2 (dtr 23) (/ 3.5 heso)))
(setq ptext2 (polar goc2 (dtr 158) (/ 3.5 heso)))
(setq num (fix (car goc2)))
(setq str (them0 (itoa (rem num 1000))))
(setq str2 (itoa (/ num 1000)))
(mktext ptext1 htext str "M" "A1-luoik" "vusaln" nil)
(mktext ptext2 htext str2 "M" "A1-luoik" "vusaln" nil)
;=======================================================================
(setq goc2 (mapcar '+ goc2 (list (cdr (assoc 1 donvi)) 0.0 0.0)))
) ;end repeat nx
;============================================================
(repeat ny
(makeline goc3 (polar goc3 0 (/ 8.0 heso)) "A1-luoik" nil nil nil)
;=====================================================================
(setq ptext3 (polar goc3 (dtr 23) (/ 4.0 heso)))
(setq ptext4 (polar goc3 (dtr 338) (/ 4.0 heso)))
(setq num (fix (cadr goc3)))
(setq str (them0 (itoa (rem num 1000))))
(setq str2 (itoa (/ num 1000)))
(mktext ptext3 htext str2 "M" "A1-luoik" "vusaln" nil)
(mktext ptext4 htext str "M" "A1-luoik" "vusaln" nil)
;============================================================= 
(setq goc3 (mapcar '+ goc3 (list 0.0 (cdr (assoc 1 donvi)) 0.0)))
); end repeat ny
;============================================================
(setq goc1 (list (lamtron (fix (+ (car pt1) 10))) (lamtron (fix (+ (cadr pt1) 10))) 0.0))
;============================================================================================ 
 (setq x (car goc1))
  (repeat nx
    (setq y (cadr goc1))
    (repeat ny
      
	  (vediem x y (/ 2.5 heso))
      (setq y (+ y (cdr (assoc 1 donvi))))
    )
;===============================================================================================
    (setq x (+ x (cdr (assoc 1 donvi))))
  )
;============================================================
) ;end 100


;========================================================++++++++++**************+++++++++=======================================================
((and (>= (/ kcx 50) 2) (>= (/ kcy 50) 2))
;==========================================================
(setq nx (fix (/ kcx 50)) ny (fix (/ kcy 50)))
(setq goc2 (list (lamtron (fix (+ (car pt1) 10))) (cadr pt1) 0.0))
(setq goc3 (list (car pt1) (lamtron (fix (+ (cadr pt1) 10))) 0.0))
;============================================================
(repeat nx

(makeline goc2 (polar goc2 (/ pi 2) (/ 8.0 heso)) "A1-luoik" nil nil nil)
;=======================================================================
(setq ptext1 (polar goc2 (dtr 23) (/ 3.5 heso)))
(setq ptext2 (polar goc2 (dtr 158) (/ 3.5 heso)))
(setq num (fix (car goc2)))
(setq str (them0 (itoa (rem num 1000))))
(setq str2 (itoa (/ num 1000)))
(mktext ptext1 htext str "M" "A1-luoik" "vusaln" nil)
(mktext ptext2 htext str2 "M" "A1-luoik" "vusaln" nil)
;=======================================================================
(setq goc2 (mapcar '+ goc2 (list (cdr (assoc 2 donvi)) 0.0 0.0)))
) ;end repeat nx
;============================================================
(repeat ny
(makeline goc3 (polar goc3 0 (/ 8.0 heso)) "A1-luoik" nil nil nil)
;=====================================================================
(setq ptext3 (polar goc3 (dtr 23) (/ 4.0 heso)))
(setq ptext4 (polar goc3 (dtr 338) (/ 4.0 heso)))
(setq num (fix (cadr goc3)))
(setq str (them0 (itoa (rem num 1000))))
(setq str2 (itoa (/ num 1000)))
(mktext ptext3 htext str2 "M" "A1-luoik" "vusaln" nil)
(mktext ptext4 htext str "M" "A1-luoik" "vusaln" nil)
;============================================================= 
(setq goc3 (mapcar '+ goc3 (list 0.0 (cdr (assoc 2 donvi)) 0.0)))
); end repeat ny
;============================================================
(setq goc1 (list (lamtron (fix (+ (car pt1) 10))) (lamtron (fix (+ (cadr pt1) 10))) 0.0))
;============================================================================================ 
 (setq x (car goc1))
  (repeat nx
    (setq y (cadr goc1))
    (repeat ny
      
	  (vediem x y (/ 2.5 heso))
      (setq y (+ y (cdr (assoc 2 donvi))))
    )
;===============================================================================================
    (setq x (+ x (cdr (assoc 2 donvi))))
  )
;============================================================
) ;end 50
;============================================================******++++++++++++++++++++****************++++++++++++++++++++========================
((and (>= (/ kcx 25) 2) (>= (/ kcy 25) 2))
;==========================================================
(setq nx (fix (/ kcx 25)) ny (fix (/ kcy 25)))
(setq goc2 (list (lamtron (fix (+ (car pt1) 10))) (cadr pt1) 0.0))
(setq goc3 (list (car pt1) (lamtron (fix (+ (cadr pt1) 10))) 0.0))
;============================================================
(repeat nx

(makeline goc2 (polar goc2 (/ pi 2) (/ 8.0 heso)) "A1-luoik" nil nil nil)
;=======================================================================
(setq ptext1 (polar goc2 (dtr 23) (/ 3.5 heso)))
(setq ptext2 (polar goc2 (dtr 158) (/ 3.5 heso)))
(setq num (fix (car goc2)))
(setq str (them0 (itoa (rem num 1000))))
(setq str2 (itoa (/ num 1000)))
(mktext ptext1 htext str "M" "A1-luoik" "vusaln" nil)
(mktext ptext2 htext str2 "M" "A1-luoik" "vusaln" nil)
;=======================================================================
(setq goc2 (mapcar '+ goc2 (list (cdr (assoc 3 donvi)) 0.0 0.0)))
) ;end repeat nx
;============================================================
(repeat ny
(makeline goc3 (polar goc3 0 (/ 8.0 heso)) "A1-luoik" nil nil nil)
;=====================================================================
(setq ptext3 (polar goc3 (dtr 23) (/ 4.0 heso)))
(setq ptext4 (polar goc3 (dtr 338) (/ 4.0 heso)))
(setq num (fix (cadr goc3)))
(setq str (them0 (itoa (rem num 1000))))
(setq str2 (itoa (/ num 1000)))
(mktext ptext3 htext str2 "M" "A1-luoik" "vusaln" nil)
(mktext ptext4 htext str "M" "A1-luoik" "vusaln" nil)
;============================================================= 
(setq goc3 (mapcar '+ goc3 (list 0.0 (cdr (assoc 3 donvi)) 0.0)))
); end repeat ny
;============================================================
(setq goc1 (list (lamtron (fix (+ (car pt1) 10))) (lamtron (fix (+ (cadr pt1) 10))) 0.0))
;============================================================================================ 
 (setq x (car goc1))
  (repeat nx
    (setq y (cadr goc1))
    (repeat ny
      
	  (vediem x y (/ 2.5 heso))
      (setq y (+ y (cdr (assoc 3 donvi))))
    )
;===============================================================================================
    (setq x (+ x (cdr (assoc 3 donvi))))
  )
;============================================================
) ;end  25
;==================================================*********************++++++++++++++++++++*************===========================
((and (< (/ kcx 25) 2) (< (/ kcy 25) 2))
(alert "Ban chon Khung KiBo qua\nVe Khung Lai Hen!!!^^")) ; end nho hon 25
) ;end cond
;==================================================================++++++++++**************+++++++++=======================================
) ;end progn of while pt1 pt2
) ; end  while
(setvar "osmode" old)
(princ)
)
;==============================================================================================
;;;;;;;;;;;;;;;;;;;;
(defun lamtron (n / sodu)
  (setq sodu (rem n 100))
  (if (/= sodu 0)
    (setq n (+ (- n sodu) 100))
  )
  n
)
;=================================
(defun vediem (xx yy r / left right top bot)
  (setq top (+ yy r))
  (setq bot (- yy r))
  (setq right (+ xx r))
  (setq left (- xx r))
  (makeline (list left yy) (list right yy) "A1-luoik" nil nil nil)
  (makeline (list xx top) (list xx bot) "A1-luoik" nil nil nil)
)
;============================
;=================================================================================
(defun _layer2 ( name colour )
    (if (null (tblsearch "LAYER" name))
        (entmake
            (list
               '(0 . "LAYER")
               '(100 . "AcDbSymbolTableRecord")
               '(100 . "AcDbLayerTableRecord")
               '(70 . 0)
                (cons 2 name)
                (cons 62 colour)
            )
        )
    )
)
;=====================================================================================
;; ham luu gia tri
(defun getvalue ( a giatri dongnhac / astr) 
(or a (setq a giatri))
(cond
	((= (type a) 'INT) (setq a (cond ((getint (strcat "\n" dongnhac "(" (itoa a) ") :")))(a))))
	((= (type a) 'REAL) (setq a (cond ((getreal (strcat "\n" dongnhac "(" (rtos a 2 0) ") :")))(a))))
	((= (type a) 'STR) (setq a (cond ((= "" (setq astr (getstring T (strcat "\n" dongnhac " (" a "): ")))) a) (astr))))
))
;;;;
;;ham tao text 2
(defun mktext (point height string justify layer textstyle mau / lst)
(setq lst (list '(0 . "TEXT")
                              (cons 10 point)
							  (cons 40 height)
							  (cons 1 string)
							  (cons 8 layer)
							  (cons 7 (if textstyle textstyle (getvar "textstyle")))
							  (cons 62 (if mau mau 256))
							  
			)
			justify (strcase justify))
		(cond   ((= justify "L") (setq Lst (append Lst (list (cons 72 0) (cons 11 point)))))
		        ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))
				((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))
				((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))
				)
	(entmakex Lst)
  )	;end mktext
;;--------------------------------------
(defun them0(chuoi)
  (setq len (strlen chuoi))
  (if (= len 1)
    (strcat "00" chuoi)
    (if (= len 2)
      (strcat "0" chuoi)
      chuoi
    )  
  )
 ) 

Trong lsp kkl có thông báo

(alert "Ban chon Khung KiBo qua\nVe Khung Lai Hen!!!^^"))

vậy khung KiBo là gì vậy bạn ? Có thể cho mình một khung với.

 

<<

Mình có một lisp đo diện tích vùng khép kín rồi điền giá trị vào Dtext, cũng ko nhớ xin của ai, nếu ai trong diễn đàn nhớ ra là code...

>>

Mình có một lisp đo diện tích vùng khép kín rồi điền giá trị vào Dtext, cũng ko nhớ xin của ai, nếu ai trong diễn đàn nhớ ra là code của mình thì cho gửi lời cám ơn nhé. Mình muốn nhờ thêm mọi người sửa hộ code để sau khi điền giá trị diện tích vào text thì mầu text được thay đổi để dễ nhận biết, mầu nào cũng đc miễn là khác mầu cũ của text.

 

Code file lisp mà mình có:

(defun c:N()
 (if (= tl nil) (progn
(setq tl (getreal "\nDrawing scale : "))
(setq ntl (/ 100 tl))
(setq tl2 (* ntl ntl))
)
 )
 (setq dtl 0)
 (setq ss (ssadd))
 (setq oslast (getvar "OSMODE"))
 (command "osnap" "")
 (print)
 (print)
 (setq pt1 (getpoint "\nPick internal point : "))
 (while (/= pt1 nil)
(command "-boundary" pt1 "")
(setq et (entlast))
(ssadd et ss)
(command "area" "e" "last")
(setq vsize ( /(getvar "VIEWSIZE") 3 ))
(command "hatch" "ANSI31" vsize "0" "last" "")
(setq et (entlast))
(ssadd et ss)
(setq dtcon (getvar "AREA"))
(setq dtl (+ dtcon dtl))
(print)
(print)
(setq pt1 (getpoint "\nPick internal point : "))
 )
 (command "setvar" "OSMODE" oslast)
 (command "erase" ss "")
 (setq ss nil)
 (command "redraw")
 (setq dtl (/ dtl tl2))
 (print dtl)
 (setq elst (entget (car (entsel "Thay cho so: "))))
 (setq elst (subst (cons 1 (rtos dtl 2 2)) (assoc 1 elst) elst))
 (entmod elst)
 (print)
 (prompt (strcat "\nTotal area : " (rtos dtl 2 4)))
 (print)
;  (setq pt2 (getpoint "\nPoint to write: "))
;  (command "text" pt2 (/ vsize 6) "0" (rtos dtl 2 2))
);defun

 

Xin chân thành cảm ơn!

Hề hề hề,

Vậy chứ cái màu text cũ là màu chi để còn biết đường mà tránh chứ hè????

<<

Hề hề hề,

Nếu đúng vậy thì bạn có thể dùng cái lisp của bác Đoan Van Ha hay xài thử cái...

>>

Hề hề hề,

Nếu đúng vậy thì bạn có thể dùng cái lisp của bác Đoan Van Ha hay xài thử cái ni coi có ưng cái bụng không hè????

(defun c:copnh (/ ss1 p1 p2 ss2)
(command "undo" "be")
(alert "\n Chon nhom doi tuong can copy")
(setq ss1 (ssget )
        p1 (getpoint "\n Chon diem goc ")
        p2 (getpoint p1 "\n Chon diem dich")
)
(while p2
      (alert "\n Chon nhom doi tuong can xoa")
      (setq ss2 (ssget))
      (command "erase" ss2 "")
      (command "copy" ss1 "" p1 p2)
      (setq p2 (getpoint p1 "\n Chon diem dich ke tiep"))
)
(command "undo" "e")
(princ)
)

Hề hề hề,'

Chúc bạn vui.

Sorry bác Phamthanhbinh! Nếu biết bác giúp thì tôi đã không viết giúp như trên.

<<

Hề hề hề,

Vậy là bạn sắp thành lisper rồi đó. Ráng lên chút xíu nữa là tới thiên đường thôi mà.

Hề hề...

>>

Hề hề hề,

Vậy là bạn sắp thành lisper rồi đó. Ráng lên chút xíu nữa là tới thiên đường thôi mà.

Hề hề hề,...

Bạn xài cái này coi có ưng cái bụng không hè???

Hãy so sánh với cái bạn đã sửa để biết mình đã làm gì và từ đó có thêm kinh nghiệm sửa lisp theo ý mình và trở thành lisper hỉ...

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=12225
;GHI TOA DO CAC DIEM VA THONG KE THANH BANG
----------------------------------------------
(defun C:td1 (/ diem PT1 PT2 PT3 tapx tapy 
	   x y xx yy h n di kc
	   C PT PTX PTY PTD PTC N
	   p1 p2 p3 p4 p11 p22 p33 L1 L2 L11 L22)
(setvar "cmdecho" 0 )
(command "Undo" "Begin")  
 (setq om (getvar "osmode"))
 (setq tapx '()
tapy '()
stt '()
k 0
h (getreal "\nnhap chieu cao chu:"))

(while
 (setq diem (getpoint "\nchon cac vi tri co toa do can ghi:"))
 (progn
(setq   PT1 (list(+ (* 3 h) (car diem))(+ (* 3 h) (cadr diem)))
	PT2 (list (car PT1) (- (cadr PT1)(+ 1 h) ) )
	 x (rtos(car diem) 2 4)
		 y (rtos (cadr diem) 2 4)
   tapx (append tapx (list x))
   tapy (append tapy (list y))
	 k (+ 1 k)
	;;; N (strcat "N" (rtos k 2 0))
	;;;stt (append stt (list N))
  );setq
 (setvar "osmode" 0)
 (command "text" "j" "BL" PT1 h 0 x)
 (setq TB (textbox (entget(entlast)))
LC (car TB)
RC (cadr TB)
di (distance LC RC)
PT3 (polar PT1 0 (+ di h))
C  (polar PT3 0 (* 1.5 h))
  );setq
(command "text" PT2 h 0 y
	 "pline" diem PT1 PT3 ""
	;;; "circle" (polar PT3 0 (* 1.5 h)) (* 1.5 h)
	;;; "text" "m" (polar PT3 0 (* 1.5 h)) h 0 N )

(setvar "osmode" om)
);progn   
 );dong while

;tao bang thong ke
 (setq	kc (* 2 di)
	PT (getpoint"\nvi tri dat bang :")
PTC (list (+ (* 2 kc) di (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) (car PTD)) (cadr PTD))
PTY (list (+ kc (car PTX)) (cadr PTX))
  p11 (list (+ (/ di 2) (car p1))  (+ h (cadr p1)))
  p22 (list (+ di (/ di 2) (car p11)) (cadr p11))
  p33 (list (+ kc (car p22)) (cadr p22))
  L1 (list (+ di (car p3))(cadr p3))
  L2 (list (+ kc (car L1))(cadr L1))
 n (length tapx)
 k 0
);setq
(setvar "osmode" 0)
 (command "line" p1 p2 ""
  ;;; "text" "j" "m" p11 h 0 "STT" 
   "text" "j" "m" p22 h 0 "Täa ®é X" 
   "text" "j" "m" p33 h 0 "Täa ®é Y"
   "line" p3 p4 "")	

 (while (< k n) 
(setq xx (nth k tapx)
  yy (nth k tapy)
;;; tstt(nth k stt)
             )
(command ;;;;; "text" "j" "m" PTD h 0 tstt 
	 "text" "j" "m" PTX h 0 xx 
	 "text" "j" "m" PTY h 0 yy 
	 "line" PT PTC "")	
(setq PT (list (car PT) (- (cadr PT)(* 2 h)))
	 PTC (list (+ (* 2 kc) di (car PT)) (cadr PT))
 PTD (list (+ (/ di 2) (car PT))  (+ h (cadr PT)))
 PTX (list (+ di (/ di 2) (car PTD)) (cadr PTD))
 PTY (list (+ kc (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 (car PT)) (cadr PT))
  L11 (list (+ di (car PT))(cadr PT))
  L22 (list (+ kc (car L11))(cadr L11))
  );setq
);if
(command "line" p3 PT ""
  "line" p4 PTC ""
  "line" L1 L11 ""
  "line" L2 L22 "")
(setvar "osmode" om )
(setvar "cmdecho" 1)
(prompt"\nxong\n")
 (command "Undo" "End")
 (princ)
);DONG toado

 

 

hì hì bác quá khen. em chẳng qua meo mù vớ phải cá chiên thui. cái lsp của bác em dùng thử thấy y như của em pác ạ. cái vòng tròn đó nó ko chịu biến mất thì làm thế nào hở bác. thank bác trước nhìu nhé.

<<

Của anh đây:

(defun c:xy ( / ts pt1 pt2 px py pxt pyt txtpnt txtpnt1 txtpnt2 algn d alp)

(defun SETERR (s)
(if (/= s "Function...
>>

Của anh đây:

(defun c:xy ( / ts pt1 pt2 px py pxt pyt txtpnt txtpnt1 txtpnt2 algn d alp)

(defun SETERR (s)
(if (/= s "Function cancelled")
(princ (strcat "\nError: " s))
) ; of If
(setq *error* oer
seterr nil
)
(princ)
) ; of SETERR
(setq oer *error*
*error* seterr
)

(setq ts (* (getvar "DIMTXT") (GETVAR "DIMSCALE")))

(setq pt1 (getpoint "\nPick First Point:"))
(setq pt2 (getpoint pt1 "\nPick Second Point:"))
(setq px (car pt1))
(setq py (cadr pt1))
;****** real to string
(setq pxt  (rtos px 2 ))
(setq pyt (rtos py 2 ))
(command "dim1" "leader" pt1 pt2 "" pxt)
(setq txtpnt (cdr (assoc 10 (entget (entlast)))))
(setq txtpnt1 (list (car txtpnt)
(- (cadr txtpnt) (* 2.0 ts))
2.0
)
)
(setq d(sqrt (+ (* ts ts) (* 100 100))))
(setq alp(atan (/ ts 100)))
(setq txtpnt2 (polar txtpnt1 alp d))
(command "MTEXT" txtpnt1 txtpnt2 pyt "")
(setq *error* oer
seterr nil
)
(princ)

) 

 

 

 

 

Trước tiên cám ơn pác pdle nhìu. cái lsp của pác sài cũng được, nhưng lsp này không giống lsp của em. lsp của em khi đánh có hỏi chiều cao text. và có đường line ở giữa tọa độ x,y vậy pác có thể sửa cái lsp của em không vậy chỉ cần bỏ cái tên đi thui. mong pác giúp nhe...

<<

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 ý...

>>

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 <" 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 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 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 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 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

<<