Uh ! Mình không hiểu tại sao mà khi chạy xong sửa lại các point đó rồi chạy lại nó lại vẫn bắt point vào những điểm đó mặc dù mình đã cố gắng sửa thật chính...

>>

Uh ! Mình không hiểu tại sao mà khi chạy xong sửa lại các point đó rồi chạy lại nó lại vẫn bắt point vào những điểm đó mặc dù mình đã cố gắng sửa thật chính xác rồi. Có một điều mình muốn hỏi bạn đó là tại sao khi bắt đầu gõ lệnh :

Lisp hỏi :chon duong mà mình không thề select được vào đó mà chỉ bao được các đối tượng là text có phải đó là lý do ?

Xem giùm mình nhé ! Cảm ơn bạn nhiều !

Cũng có thể do chế độ bắt điểm của CAD. Bạn phải dùng chế độ bắt điểm Insert bắt vào Middle Center của Text bát dính vào Curve (dùng chế độ bắt điểm Nearest).

Có lẽ mình đưa vào Lisp một khoảng hở cho phép của biến dis để CAD chấp nhận, không bắt lỗi bằng cách vẽ point vào điểm bắt dính Middle Center của Text trên Curve

Dòng này (if (/= dis 0) (Command "point" po1))

mình sửa lại như sau : (if (> dis 0.2) (Command "point" po1))

Giá trị 0.2mm tức là khoảng hở cho phép có thể chấp nhận được không bắt lỗi bằng cách vẽ point.

Code được sửa lại :

(defun c:btd()
(Command "undo" "BEgin")
(setvar "Pdmode" 2)
(setvar "Pdsize" 200)

(vl-load-com)
(setq curve (car(entsel "\n Chon duong :")))
(while (null curve) (setq curve (car(entsel "\n Chon lai duong :")))
)
(prompt "\n Chon Text : ")
(setq ss (ssget '((0 . "TEXT"))))
(sssetfirst ss ss)
(Command "justifytext" ss "" "MC")
(setq n (sslength ss)
i 0)

(while ((setq sn (ssname ss i))
(setq ent (entget sn))
(setq po1 (cdr(assoc 11 ent)))
(setq po2 (vlax-curve-getClosestPointTo curve po1))
(setq dis (distance po1 po2))
(if (> dis 0.2) (Command "point" po1))
(setq i (1+ i))
)
(setvar "Pdmode" 0)
(Command "undo" "END")
(Princ)
)

 

Lisp hỏi :chon duong mà mình không thề select được vào đó.

Mình sử dụng hàm entsel : Pick chuột chọn đối tượng. Trong Lisp mình đã đưa vào vòng lặp while, khi nào bạn pick trúng đối tượng Curve thì mới dừng lại. Pick chưa trúng đối tượng thì phải pick lại. Bạn đồng ý chứ .

Nguyên tắc đoạn Lisp trên :

 

1. Một curve : đó là 1 SPline, PLine, line, Arc..

2. Ta lấy 1 điểm của text : chính là điểm Middle Center (Gọi là điểm Po1)

3. Tưởng tượng từ Po1 ta dựng 1 đường vuông góc Po1Po2 với Curve. Với Po2 chính là chân đường vuông góc và Po2 thuộc curve

4. Đặt khoảng cách dis=Po1Po2.

Vậy thì Nếu dis Xem Text với điểm Middle Center đã bắt dính vào Curve => Không vẽ point vào Middle Center

Vậy thì Nếu dis>0.2 (sai số) => Text với điểm Middle Center đã không bắt dính vào Curve => Vẽ point vào Middle Center

<<

Thực ra Lisp đã giải bài toán đó rồi. Chỉ cần chỉnh lại 1 chút cho phù hợp mà thôi.

ndn386 thử lại code này xem nhé :

(defun c:gb(/ p ss S frome...
>>

Thực ra Lisp đã giải bài toán đó rồi. Chỉ cần chỉnh lại 1 chút cho phù hợp mà thôi.

ndn386 thử lại code này xem nhé :

(defun c:gb(/ p ss S frome cur toe tt)
(setq p (getpoint "\n Pick 1 diem vao mien trong hinh kin :") 
ss (ssadd) S 0)
(while p
(setq frome (entlast))
(command ".boundary" "A" "O" "R" "" p "")
(setq toe (entlast));; 
(setq cur frome
)
(while (not (eq cur toe))
(setq cur (entnext cur)
ss (ssadd cur ss))
(command "area" "S" "O" ss "" "")
(setq tt (getvar "area"))
(setq S (+ S tt))
)
(command "area" "A" "O" "L" "" "")
(setq tt (getvar "area"))
(setq S (+ S (* tt 2))) 
(sssetfirst ss ss)
(setq p (getpoint "\n Pick 1 diem vao mien trong hinh kin / An phim bat ki de xem ket qua:"))

)
(if (> (sslength ss) 0)
(alert (strcat "Area = " (rtos (abs S) 2 2)))
(alert "\n Ban chua Pick vao mien kin nao ca ")
)
(command "erase" ss "")
(Princ)
)

Cảm ơn anh Tue_NV bài toán của em đã được giải quyết rồi. Cảm ơn anh nhiều lắm

<<

Mình có cái này hồi xưa thấy trong CD bán ngoài thị trường chẳng biết của ai viết nhưng đúng ý của bạn nè.

(defun c:ND 
 (/ Ename Elist Msg Oldtext...
>>

Mình có cái này hồi xưa thấy trong CD bán ngoài thị trường chẳng biết của ai viết nhưng đúng ý của bạn nè.

(defun c:ND 
 (/ Ename Elist Msg Oldtext Oldlist Newtext Newlist)
(prompt "\nChon chu muon chinh.")
 (setq Ename (car (entsel)))
(prompt "\nChon chu lam chuan.")
 (if (not Ename) (prompt "\nChua chon duoc doi tuong.")
 (progn
  (setq Elist (entget Ename)) 
  (setq Oldlist (assoc 1 Elist)) 
  (setq Oldtext (cdr Oldlist))
  (setq Msg (strcat "\nNewtext <" Oldtext ">:"))
  (setq Newtext (car (entsel)))
  (setq Newtext (entget Newtext))
  (setq Newtext (assoc 1 Newtext)) 
  (setq Newtext (cdr Newtext))
  (if (= Newtext "") (setq Newtext Oldtext))
  (setq Newlist (cons '1 Newtext))
  (setq Elist (subst Newlist Oldlist Elist))
  (entmod Elist)
 ) ; end progn
 ) ; end if
 (princ)
)

 

Tên lệnh là ND

Chọn chử muốn chỉnh trước rồi chọn chử làm mẫu sau. Chúc vui !!!!!!

 

 

Mình rất tâm đắc cái này. Nó rất tiện khi làm Kết cấu. Thanks nhé. Nhưng mà làm thế nào để có thể multi dc thì tuyệt?

<<

Bạn thử dùng cái này xem. Khi pick vào 1 điểm thì nó sẽ lấy các toạ độ XYZ. Khi kết thúc công việc nó sẽ ghi ra file xxx.txt (xxx là tên bản vẽ hiện tại và nó nằm...

>>

Bạn thử dùng cái này xem. Khi pick vào 1 điểm thì nó sẽ lấy các toạ độ XYZ. Khi kết thúc công việc nó sẽ ghi ra file xxx.txt (xxx là tên bản vẽ hiện tại và nó nằm cùng thuw mục với bản vẽ) - code này là của NguyenLam _ ketcau.com

(defun c:tff ( / tmp dlst p1 file opw msg id)
 (setq tmp t)
 (setq dlst (list(strcat "X" "\t" "Y" "\t" "Z")))
 (setq id 0)
 (setq file (strcat (getvar "DWGPREFIX") (substr (getvar "DWGNAME") 1 (- (strlen (getvar "DWGNAME")) 4)) ".txt"))
 (while tmp
   (progn
     (setq id (1+ id))
     (setq msg (strcat "\nChon diem thu " (rtos id 2 0)":"))
     (setq p1 (getpoint msg))
     (if p1
(progn
  (setq dlst (append (list (strcat (rtos (car p1) 2 3)
				   "\t"
				   (rtos (cadr p1) 2 3)
				   "\t"
				   (rtos (caddr p1) 2 3)
				   )
			   )
		     dlst )
	)
  (setq tmp t)
  )
(setq tmp nil)
)
     )
   )
 (setq dlst (reverse dlst))
 (setq ;file "d:\\tien\\diem.txt"
opw (open file "w")
)
 (foreach n dlst (write-line n opw))
 (close opw)
);end defun

Có bác nào sửa giúp em code trên không? Sửa như sau:

+ Thêm tên điểm vào trước tọa độ

Ví dụ: ten, X, Y, Z = LK1,123.4456,5689.12,0.3

Them vào trước lệnh chọn điểm thứ là dòng lệnh chọn tên điểm, sau đo mới chọn điểm rồi xuất ra.

<<

;---------------------------------
(defun ctd_err (s)
   (if(/= s "Function cancelled")
      (princ (strcat "\nError: " s)) )(setq *error* old_err)(princ)
)

(defun C:cd (/ dim_ch ll_ d13_...
>>

;---------------------------------
(defun ctd_err (s)
   (if(/= s "Function cancelled")
      (princ (strcat "\nError: " s)) )(setq *error* old_err)(princ)
)

(defun C:cd (/ dim_ch ll_ d13_ d14_ d4_ d2_ point_cat old_osm dm_13 d10_1 cat_h ang_h
                ang_n dis_1 ang_g ang_d dim_l dim_new dm_14 dis_h old_ang)
(setq old_err *error* *error* ctd_err)
(setvar "Cmdecho" 0)
(setq old_osm(getvar "Osmode") old_ang(getvar "Angdir"))
(setvar "Angdir" 0) ;(setvar "Osmode" 0)
(prompt "\nChon Dim <Aligned-Liner-Hor-Ver> dinh cat.")
(if(and(setq dim_ch(ssget '((0 . "DIMENSION"))))
      (setq point_cat(getpoint "\nDiem moc cat duong giong <New>: ")) ) 
  (progn
    (setq ll_ 0 tol_(sslength dim_ch) total 0.0)
    (while (< ll_ tol_)
(setq d2_(ssname dim_ch ll_) d3_(entget d2_) d4_(cdr(assoc 1 d3_)) )
       (prompt "\nDiem giong moi")
(if(and d3_ d4_)
	   (setq d13_(cdr(assoc 13 d3_))  ;Dim 2 
                d10_(cdr(assoc 10 d3_))  ;Dim Chuan
         d14_(cdr(assoc 14 d3_))  ;Dim 1
                ang_n(angle d10_ d13_)
                dis_1(distance d10_ d13_)
                ang_g(angle d10_ d14_)
                ang_d(- ang_g (dtr 90))
                dim_l(* (cos (- ang_n ang_d)) dis_1) );setq
)
       (if (and dim_l point_cat)
           (progn 
              (setq dis_h(distance d10_ point_cat)
                    ang_h(angle d10_ point_cat)
                    cat_h(* (sin (- ang_h ang_d)) dis_h)
                    dm_14(polar d10_ ang_g cat_h)	;New point2
                    d10_1(polar d10_ ang_d dim_l)
                    dm_13(polar d10_1 ang_g cat_h) )	;New point 1
              (if (and dm_13 dm_14 d14_ d13_ d3_)
                  (progn
                    (setq d3_(subst (cons '13 dm_13) (cons '13 d13_) d3_)
                          d3_(subst (cons '14 dm_14) (cons '14 d14_) d3_))
                    (entmod d3_)(prompt "..... OK !")
                  ) (princ "\n..... Khong thuc hien !")
              )
           )
       )
       (setq ll_(+ ll_ 1))
    );while
  )
)

 

E thì vẫn cắt dim theo thằng này,down file của bạn ấy vào thấy vẫn cắt như dao,nên k bít là nó có z khác 0..Híc

Hề hề hề,

Với lisp này thì thực ra là không cắt được do bác ketxu trở thành ket xỉ không chịu post cái lisp DTR lên cho mọi người xài.....

Nếu co lisp DTR này thì chắc hẳn sẽ được vì bác ấy chả thèm dùng tới hàm (inters ....) nên hổng bị cái lỗi giống cái lisp của bạn thanhduan2407.

Trong lisp này tuy chả nói ra nhưng thực tế thì cái điểm mới dm_13 và dm_14 này đều lấy cùng tọa độ z với thằng d10 cả rồi (do dùng hàm polar .....). Tức là nếu d10 có z=0 thì dm_13 và dm_14 cũng có z=0 bác ketxu ạ. Chí ít thì 3 thằng này cũng đồng phẳng rùi. Hề hề hề

Và thằng này cũng có tí lỗi do việc xác định cái điểm dm_13 gây ra.... Thực chất đó chính là do cái khoảng cách dis_1 giữa hai điểm không có cùng cao độ z gây ra. Hề hề hề

Mong bác xem lại hỉ???

<<

Bạn Explode Table để được Text (hoặc MText) trước đã, sau đó sử dụng LISP sau, Mở file lyky.txt được xuất ra tại "C:\\lyky.txt" bằng...

>>

Bạn Explode Table để được Text (hoặc MText) trước đã, sau đó sử dụng LISP sau, Mở file lyky.txt được xuất ra tại "C:\\lyky.txt" bằng Excel.

(defun C:C2T ( / e f lst ss y z)
  (setq ss  (acet-ss-to-list (ssget '((0 . "TEXT,MTEXT,RTEXT"))))
        lst (mapcar '(lambda (e) (cons(Dxf 10 (entget e)) (Dxf 1 (entget e)))) ss)
        z   (* (Dxf 40 (entget (car ss))) 0.5)
        lst (vl-sort lst (function (lambda (e1 e2) (Compare2D (car e1) (car e2) z))))
        f   (open "C:\\lyky.txt" "w"))
(foreach e lst
(princ (if (equal y (cadr (car e)) z) "\t" "\n") f)
(princ (cdr e) f) (setq y (cadr (car e)))) (close f)
(prompt "Ket qua xuat ra tai C:/lyky.txt"))
(defun Compare2D (p q f / ) (if (equal (cadr p) (cadr q) f) (< (car p) (car q)) (> (cadr p) (cadr q))))
(defun Dxf(n e) (cdr (assoc n e)))

em dùng lệnh c2t thì nó ra bang nhưng lại thiếu cột a ạ :(

<<

Bạn chạy thử Lisp này nhé :

(defun c:tkc(/ ss r lisr old Res kq)
 (setq ss (ssget '((0 . "CIRCLE"))) i -1 lisr '() Res '() kq "")
 (while (setq ent (ssname ss (setq i (1+ i))))
...
>>

Bạn chạy thử Lisp này nhé :

(defun c:tkc(/ ss r lisr old Res kq)
 (setq ss (ssget '((0 . "CIRCLE"))) i -1 lisr '() Res '() kq "")
 (while (setq ent (ssname ss (setq i (1+ i))))
   (setq r (cdr (assoc 40 (entget ent))))
   (setq lisr (cons r lisr))
 )
(foreach x lisr
(if (setq old (assoc x Res))
(setq Res (subst (cons x (1+ (cdr old))) old Res))
(setq Res (append Res (list (cons x 1))))
)
)
 (foreach x Res
   (setq kq (STRCAT kq "Duong tron duong kinh la " (rtos (car x) 2 1) " \n co so luong la : "
	     (itoa(cdr x)) "\n\n"
     )
   )
 )
 (alert kq)
   (princ)
 )

Chào bác Tue_NV,

Đọc cái lisp của bác , mình mót được khá nhiều điều hay. Tỷ như cái cách lập vòng lặp While hay cách tạo biến res.

Tuy nhiên có một chỗ chưa đúng là cái thông báo kết quả, phải đổi lại là bán kinh chứ không phải đường kính bác ạ, vì bác lấy từ mã dxf 40 nên nó trả về bán kinh chứ không phải đường kính.

Bác kiểm tra lại nhé.

 

Còn một điều nữa là trong trường hợp các bán kính vòng tròn khác nhau không quá lớn, tỷ như là 0.01 đơn vị thì sẽ xảy ra kết quả hơi không đúng do trong thông báo kết quả bác lại làm tròn số bác ạ. Nên chăng ta cứ để nguyên giá trị bán kính mà khỏi làm tròn.??? Hoặc là ta làm tròn luôn bán kính trước khi tạo list các bán kính????

<<

Bạn thử đoạn Code này xem :

(defun c:ckc()
(setq po1 (getpoint "\n Pick diem A :"))
(setq po2 (getpoint po1 "\n Pick diem B :"))
(setq S (distance po1 po2))
(setq po3 (getpoint...
>>

Bạn thử đoạn Code này xem :

(defun c:ckc()
(setq po1 (getpoint "\n Pick diem A :"))
(setq po2 (getpoint po1 "\n Pick diem B :"))
(setq S (distance po1 po2))
(setq po3 (getpoint "\n Pick diem C :"))
(while 
(setq po4 (getpoint po3 "\n Pick diem tiep theo de tinh khoang cach/ Enter de ket thuc :"))
(setq S (+ S (distance po3 po4)) po3 po4)
)
(alert (strcat "Tong S = " (rtos S)))
(princ)
)

em vẽ bằng pl 1đoạn 100 rồi 1đoạn 200. dùng lisp CKC pick vào 3điểm mút của pline trên được kết quả S=100. Nhưng rõ ràng là độ dài pline trên là 300. Tại sao như thế bác nhỉ? Lisp này tiện ích khi tính tổng khoảng cách giữa các điểm riêng biệt. Nếu kết quả có lựa chọn chọn text để điền kết quả nữa thì tốt! Ah nhưng nếu dùng CKC của bài viết trước thì lại có kết quả chính xác. Lạ thế ko bít. hii

<<

Hề hề hề,

Cái lisp thứ hai thì bạn phải chờ thêm một chút vì nó hơi loằng ngoằng hơn.

Còn cái líp thứ nhất...

>>

Hề hề hề,

Cái lisp thứ hai thì bạn phải chờ thêm một chút vì nó hơi loằng ngoằng hơn.

Còn cái líp thứ nhất thì bạn dùng thử cái này coi sao hè.

(defun c:chgev (/ psl tsl hs key_ctnc1 key_ctnc p0 p1 el1 el2 t1 t2 t3 t4 htxt num vt)
(vl-load-com)
(command "undo" "be")
(alert "\n Chon tap hop diem can thay doi cao do")
(setq psl (acet-ss-to-list (ssget "W" (setq pt1 (getpoint "\n Diem chon 1")) (setq pt2 (getpoint pt1 "\n Diem chon 2")) (list (cons 0 "POINT")))))
(setq tsl (acet-ss-to-list (ssget "W" pt1 pt2 (list (cons 0 "TEXT")))))
(setq hs (getreal "\n Nhap hang so tinh toan: "))
(if (not key_ctnc1) (setq key_ctnc1 "C"))
(initget "c t n h")
(setq key_ctnc (getkword (strcat "\Cong/Tru/Nhan/cHia  <" key_ctnc1 ">: ")))
(if (not key_ctnc) (setq key_ctnc key_ctnc1) (setq key_ctnc1 key_ctnc))
(foreach p psl
      (setq p0 (cdr (assoc 10 (entget p))))
      (foreach txt tsl
             (setq p1 (cdr (assoc 11 (entget txt))))
             (if (= (cadr p1) (cadr p0))
                 (progn
                       (if (equal (- (car p0) (car p1)) 0.4 0.001)
                           (progn
                                  (setq el1 (entget txt))
                                  (setq t1 (cdr (assoc 1 el1)))
                           )
                       )
                       (if (equal (- (car p1) (car p0)) 0.4 0.001) 
                           (progn
                                 (setq el2 (entget txt))
                                 (setq t2 (cdr (assoc 1 el2 )))
                           )
                        )
                 )
             )
      )
      (if (and t1 t2)
          (progn                 
                 (setq num (congtrunhanchia key_ctnc (atof (strcat t1 "." t2)) hs)) ;;;;;;;;;;;; (- (atof (strcat t1 "." t2)) hs))
                 (setq htxt (rtos num 2 2)
                        vt (vl-string-position (ascii ".") htxt)
                        t3 (substr htxt 1 vt)
                        t4 (substr htxt (+ vt 2))
                        el1 (subst (cons 1 t3) (assoc 1 el1) el1)
                        el2 (subst (cons 1 t4) (assoc 1 el2) el2)
                )
                (entmod el1)
                (entmod el2)
           )
       )
)
(command "undo" "e")
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun congtrunhanchia (pheptinh sohang1 sohang2 / kq)
(cond
	((= (strcase pheptinh) "C") (setq kq (+ sohang1 sohang2)))
	((= (strcase pheptinh) "T") (setq kq (- sohang1 sohang2)))
	((= (strcase pheptinh) "N") (setq kq (* sohang1 sohang2)))
	((= (strcase pheptinh) "H") (setq kq (/ sohang1 sohang2)))	
)
kq
)                

Hề hề hề,

trong lisp này, mình mượn cái hàm cộng trừ nhân chia của bác hochoaihetdot trên diễn đàn để bạn tha hồ lựa chọn, muốn cộng hay trừ hay nhân hay chia cái cao độ với một hằng số nào đó thì tùy hỉ. Hãy cám ơn bác ấy bằng cách nhấn dấu + ở bài post của bác ấy nha

cảm ơn bạn.Mình vẫn chờ lisp thứ 2 của bạn.

với lisp thứ nhất này, bạn có thể hướng dẫn mình cách sử dụng không? mình không hiểu cách chọn "tập hợp điểm cần thay đổi cao độ" chọn "điểm chọn 1", "điểm chọn 2" là cái gì.

<<

.................

Cho đến thời điểm này có thể nói 1 chắc chắn rằng chúng ta không có phương pháp để tạo block động bằng...

>>

.................

Cho đến thời điểm này có thể nói 1 chắc chắn rằng chúng ta không có phương pháp để tạo block động bằng lisp, hay kể cả là vba, trong help cũng nói rõ điều này. các ngôn ngữ khác thì mình không rõ. Vậy mình tạo nó bằng cách nào? thực tế nó rất đơn giản nếu chúng ta nghĩ khác cách làm thông thường 1 chút.

 

Ở đây mình tận dụng khả năng đọc, ghi và lưu 1 tập tin bất kì ở định dạng không mã hóa của lisp. Và may mắn là Autocad cung cấp cho chúng ta khả năng đọc và ghi 1 file bản vẽ ra 2 loại định dạng:

- DWG: Định dạng mã hóa mà mặc định chúng ta hay dùng.

- DXF: Định dạng mở, không mã hóa, có thể đọc được cấu trúc của nó bằng bất kỳ công cụ đọc văn bản nào. Định dạng này do chưa được biên dịch nên tải vào cad chậm hơn dwg, đồng thời dung lượng file thường cao hơn.

Thay vì cố gắng tìm cách make 1 dynamic block ngay trong bản vẽ thì mình sẽ make 1 file dxf chứa dynamic block đó rồi sau đó tải nó vào bản vẽ.

 

Ý tưởng là vậy. mình cụ thể hóa nó bằng các bước như sau:

- Tạo 1 dynamic block bằng cad theo ý muốn cho chương trình của bạn và lưu nó lại với định dạng dxf. Vì cad có khả năng tương thích ngược với các bản cad đời trước khá tốt nên lời khuyên là chọn định dạng dxf của phiên bản 2007 để lưu. Nó nhẹ hơn mấy thằng ku em nó sau này. dxf của cad2007 được chọn cũng là vì đây là bản cad đầu tiên hỗ trợ dynamic block.

- Dùng lisp mình viết dưới đây để đọc nội dung file dxf trên và tạo ra code để make.

- kết quả thu được là 1 file lisp, nội dung của nó là 1 hàm con có thể make được block của bạn.

;;; Make Dynamic block by Lisp
;;; Copyright 2012 Thaistreetz - Cadviet.com
(defun c:mkb (/ lst openfile path)
(setq path (getfiled "Chon File block" "" "dxf" 8))
(setq openfile (open path "r"))
(while (setq readline (read-line openfile)) (setq lst (cons (strcat "\"" (acet-str-replace "\"" "\\\"" readline )"\"") lst)))
(close openfile)
(setq path (getfiled "Nhap ten File lisp" "" "lsp" 1))
(setq openfile (open path "w"))
(write-line "(defun insert-block (point scale / temp file lst)" openfile)
(write-line "(setq lst (list" openfile)
(foreach ll (reverse lst) (write-line ll openfile))
(write-line "))" openfile)
(write-line "(setq temp (strcat (string-right-trim 8 (findfile \"acad.dcl\")) \"temp.dxf\")" openfile)
(write-line "   	file (open temp \"W\"))" openfile)
(write-line " (foreach ll lst (write-line ll file))" openfile)
(write-line " (close file)" openfile)
(write-line " (command \"-insert\" temp point scale 0)" openfile)
(write-line " (vl-file-delete temp))" openfile)
(close openfile))
(defun String-right-trim (trim string /)
(cond ((= (type trim) 'STR) (vl-string-right-trim trim string))
((= (type trim) 'INT) (substr string 1 (- (strlen string) trim)))
(t string)))

PS:

- Ngoài Dynamic block, bằng phương pháp này bạn có thể tạo được các đối tương khác của cad mà chúng ta chưa có phương pháp tạo theo cách thông thường. Ví dụ các linetype có chứa true type font, hay các bảng đối tượng...

- Có thể bạn sẽ hoảng nếu đọc cấu trúc của hàm con được tạo, vì nó...dài lê thêê...ê...ê. Kệ nó, cái này bạn có thể yên tâm vì lisp xử lý chuỗi (string) rất nhanh. Con máy cùi bắp của mình xử lý 1 file dưới 1Mb đủ nhanh để không cảm thấy khó chịu vì độ trễ trong khi file tạo ra chỉ khoảng vài chục Kb đến vài trăm Kb là cùng.

- Lisp trên mình sử dụng command để insert block, nếu có thể hãy thay thế bằng các hàm vla để tránh lỗi có thể sảy ra khi insert block

Code bạn không áp dụng với Block Dynamic có ATTributes

Cách làm của mình thường dùng Lisp hoặc CAD -> Insert Block Dynamic từ 1 file *.Dwg có chứa Block Dyn để xử lý

hoặc là tạo 1 Palette thư viện (Tool Palette) để sau này thích cái gì thì lấy cái đó và kéo rồi thả

<<

Lệnh để gọi acad.pgp là _ai_editcustfile

Còn dùng lệnh tắt thì có lệnh tắt này : pgp. Muốn thay tên gì thì tuỳ bạn. Chỉ cần thay lại cái tên pgp ở dòng...

>>

Lệnh để gọi acad.pgp là _ai_editcustfile

Còn dùng lệnh tắt thì có lệnh tắt này : pgp. Muốn thay tên gì thì tuỳ bạn. Chỉ cần thay lại cái tên pgp ở dòng

(defun c:pgp()

(defun c:pgp()
(command "_ai_editcustfile" "acad.pgp")
(princ)
)

:cheers:

Tue_NV xin nói thêm về chức năng của lệnh ai_editcustfile :

Lệnh này mở các file có đuôi

.dwg ;

.dxf ;

.lsp (file Lisp) ;

.mnu(file Menu)

.dcl(file hộp thoại);

.txt ;

.xls (file excel) ;

.doc (file Word)

.... các file khác

Miễn là các file này có 1 đường dẫn đàng hoàng

và các file này phải có chương trình mở nó.

 

Các bạn thấy hay không? Từ CAD ta có thể mở file Excel, Word, CAD, LISP.... nhưng có điều bất tiện là ta phải nhớ cái tên của nó. các bạn có thể thiết lập lệnh tắt của lệnh ai_editcustfile trong acad.pgp

Các bạn thử xem. Thú vị đấy chứ

:s_big:

<<

Sáng nay, nhân tiện sửa Lisp cho bạn huygo -> tiện thể sửa luôn cho bạn 79032

. Bạn thử cái này :

(defun...
>>

Sáng nay, nhân tiện sửa Lisp cho bạn huygo -> tiện thể sửa luôn cho bạn 79032

. Bạn thử cái này :

(defun c:wo( / ssdt sodt index tt entdt w)  
 (setq ssdt (ssget '((0 . "INSERT") (66 . 1)))
sodt (sslength ssdt)
index 0
  )
 (or *w* (setq *w* 1.0))
 (setq w (getreal (strcat "\n Nhap be rong < " 
			(rtos *w* 2 2) " > :")))
 (if w (setq *w* w) (setq w *w*))
 (repeat sodt
   (setq entdt (ssname ssdt index)
  index (1+ index)
  entdt (entnext entdt)
  tt (entget entdt)
  tt (subst (cons 41 w) (assoc 41 tt) tt)
   )
   (entmod tt)
   (entupd entdt)
 )
 (princ)
)

Cảm ơn bác,nhân tiện bác thêm chức sửa chiều cao và text style trong block att này luôn giùm e,khi hỏi chiều cao và hỏi text style nếu không nhập enter thì giữ nguyên nếu nhập thì thay đổi.

<<

Của bạn đây. CHo phép bạn chọn 1 đường chuẩn L2 và nhiều đường cần kẻ gióng L1 :

(defun c:kdg(/ dxf...
>>

Của bạn đây. CHo phép bạn chọn 1 đường chuẩn L2 và nhiều đường cần kẻ gióng L1 :

(defun c:kdg(/ dxf ST:Ss->ListEnt ST:Entmake-Line ssLine curve-obj)
(vl-load-com)
(grtext -1 "Free Lisp from CADVIET @Ketxu")
;;;;===== Local Functions =======
(defun dxf (code ent)(cdr (assoc code (entget ent))))
(defun ST:Ss->ListEnt (ss / n e l)
 (setq n (sslength ss))
 (while (setq e (ssname ss (setq n (1- n))))(setq l (cons e l))))
(defun ST:Entmake-Line (pt1 pt2)(entmake (list (cons 0 "LINE")(cons 10 pt1)(cons 11 pt2)(cons 62 1)))) 

;;;;======= Start Here =========
(setq curve-obj (vlax-ename->vla-object (car (entsel "\nCh\U+1ECDn \U+0111\U+01B0\U+1EDDng chu\U+1EA9n (L2) :"))))
(prompt "\nCh\U+1ECDn c\U+00E1c \U+0111\U+01B0\U+1EDDng c\U+1EA7n v\U+1EBD \U+0111\U+01B0\U+1EDDng gi\U+00F3ng (L1) : ")
(setq ssLine (ST:Ss->ListEnt(ssget (list (cons 0 "LINE")))))
(foreach Line ssLine
	(ST:Entmake-Line (dxf 10 Line) (vlax-curve-getClosestPointTo curve-obj (dxf 10 Line)))
	(ST:Entmake-Line (dxf 11 Line) (vlax-curve-getClosestPointTo curve-obj (dxf 11 Line)))
))

 

Cảm ơn bác nhìu! Em làm được zùi

<<

Các Bạn thử lại lisp sau

(defun c:sd ( / lstd pt xpt ypt xp yp pt1 goc h_textdim
 	p10 p11 p13 p14 oldp10 oldp11 oldp13...
>>

Các Bạn thử lại lisp sau

(defun c:sd ( / lstd pt xpt ypt xp yp pt1 goc h_textdim
 	p10 p11 p13 p14 oldp10 oldp11 oldp13 oldp14)
 (setq #OSMODE (getvar "OSMODE"))
 (command "_.Undo" "be")
 (setvar "cmdecho" 0)
 (setvar "OSMODE" 0)
 (princ "\nChon cac DIM can sap xep")
 (while (setq lstd (ssget (list(cons 0 "DIMENSION");"AcDbAlignedDimension" "AcDbRotatedDimension"
   	(cons -4 "<OR")(cons 70 32)(cons 70 33)(cons 70 64)(cons 70 65)(cons 70 128)(cons 70 129)
(cons 70 96)(cons 70 97)(cons 70 160)(cons 70 161)(cons 70 196)(cons 70 197)(cons 70 224)(cons 70 225)(cons -4 "OR>")
   	;(cons -4 "<OR")(cons 50 0)(cons 50 pi)(cons 50 (/ pi 2))(cons 50 (* 1.5 pi))(cons -4 "OR>")
   	)
  )
   	)
(setq lstd (vl-remove-if 'listp (mapcar 'cadr (ssnamex lstd))))
(or h_textdim (setq h_textdim (cdr (assoc 140 (tblsearch "DIMSTYLE" (cdr (assoc 3 (entget (car lstd)))))));chieu cao text dim
  d1014 (* 3 h_textdim);k/c tu chan duong giong den duong ghi kich thuoc
  d2d (* 4 h_textdim);k/c giua 2 duong kich thuoc
  pt (getpoint "\nChon vi tri moi cua chan duong giong kich thuoc")
  xpt (car pt)
  ypt (cadr pt)
  xp xpt
  yp ypt
  pt1 pt
  )
)
(while lstd
 	(setq en (entget (car lstd))
oldp10 (cdr(assoc 10 en))
oldp11 (cdr(assoc 11 en))
oldp13 (cdr(assoc 13 en))
oldp14 (cdr(assoc 14 en))
goc (angle oldp14 oldp10)
delta_y (- (cadr oldp10)(cadr oldp11))
delta_x (- (car oldp10)(car oldp11))
)
 	(cond

((= (rem goc pi) 0.0)(setq p13 (list xpt(cadr oldp13) (caddr oldp13)); DIM dung
  	p14 (list xpt (cadr oldp14) (caddr oldp14))
  	p10 (polar p14 (angle p14 oldp10) d1014)
  	p11 (list (- (car p10) delta_x) (cadr oldp11) (caddr oldp11))
  	xp (car (polar p14 (angle p14 oldp10) d2d))
  	)
 )
((= (rem goc (* pi 0.5)) 0.0)(setq p13 (list (car oldp13) ypt (caddr oldp13)); DIM ngang
   	p14 (list (car oldp14) ypt (caddr oldp14))
   	p10 (polar p14 (angle p14 oldp10) d1014)
   	p11 (list (car oldp11) (- (cadr p10) delta_y) (caddr oldp11))
   	yp (cadr (polar p14 (angle p14 oldp10) d2d))
   	)
 )
(t(setq p13 (inters (polar oldp13 goc d1014) oldp13 pt (polar pt (+ goc (* pi 0.5)) d1014) nil)
p14 (inters oldp14 oldp10 pt (polar pt (+ goc (* pi 0.5)) d1014) nil); DIM ali
p10 (polar p14 (angle p14 oldp10) d1014)
p11 (polar oldp11 (angle oldp10 p14) (distance p10 oldp10))
pt1 (polar pt (angle p14 oldp10) d2d)
)
 )
)
 	(setq en (subst (cons 13 p13)(assoc 13 en) en)
en (subst (cons 14 p14)(assoc 14 en) en)
en (subst (cons 10 p10)(assoc 10 en) en)
en (subst (cons 11 p11)(assoc 11 en) en)
lstd (cdr lstd)
)
 	(entmod en)
 	);for
(princ "\nChon cac DIM can sap xep")
(setq xpt xp ypt yp pt pt1)
);while
 (setvar "OSMODE" #OSMODE)
 (command "_.Undo" "en")
 (princ)
 )

 

Lưu ý: các đường DIM nghiêng có điểm dóng (dxf14) nằm trên đường ghi kích thước có nghĩ là không có đường dóng thì sẽ không đúng

lisp ở bài #1 để mình xem lại cách tính góc nghiêng cho chính xác hơn

à xl b vì m lại hiểu nhầm câu sắp xếp dim thật ra nó là lisp để các dim k bị lệnh nh nhưng sao lisp của b dài thế m dow được lisp họ viết ngắn lắm.b thử xem

http://www.cadviet.com/upfiles/3/111690_md.lsp

<<

1.Lệnh txt2mtxt ( thuộc bộ Express ) bạn ạ

1.2 : explode tất cả Mtext ra r lại dùng txt2mtxt (to lisp ok)

Hoặc tạm dùng :

>>

1.Lệnh txt2mtxt ( thuộc bộ Express ) bạn ạ

1.2 : explode tất cả Mtext ra r lại dùng txt2mtxt (to lisp ok)

Hoặc tạm dùng :

(defun C:jt (/ i ent obj  obj1 ss btwtxt)
(vl-load-com)  
(princ "\nSelect First Text or MText Entity: ")
(while (not (and (setq ss (ssget (list (cons 0 "TEXT,MTEXT"))))
			  (setq ent (ssname ss 0))
			  (setq obj1 (vlax-ename->vla-object ent))
		 )
	)
 (princ "\nError with selection please select again: ")  
)
(if(=(cdr(assoc 0 (entget ent))) "MTEXT")
 (setq btwtxt "\\P") ;Return in MText.
 (setq btwtxt " ")   ;Or space between Text selections.
)
(redraw(ssname(ssget "P")0)3) ;Highlight First selection.
(princ "\nSelect text or mtext entities to add to first: ")	  
(setq thisdrawing (vla-get-activedocument (vlax-get-acad-object))
   ss (ssget ":S" (list (cons 0 "TEXT,MTEXT")))
   i 0 ;Start with first selection.
)
(if(ssmemb ent ss)(ssdel ent ss))
; Don't delete First selection if selected again.
(repeat (sslength ss)
 (vla-startundomark thisdrawing)
 (setq ent (ssname ss i)
	obj (vlax-ename->vla-object ent)
	i	 (1+ i) ;increment to next selection.
 )
 (if(= btwtxt " ")
  (while(vl-string-search "\\P" (vla-get-textstring obj))
(vla-put-textstring obj
(vl-string-subst " " "\\P" (vla-get-textstring obj))
)
  )
 )
 (vla-put-textstring obj1 
(strcat 
(vla-get-textstring obj1)
btwtxt
(vla-get-textstring obj)		  
) 
 )
 (vla-delete obj)
 (vla-endundomark thisdrawing)
)
(princ)
)

 

 

Sao mình down lisp không được, còn cái txt2mtxt thì nó đâu giữ nguyên dòng cho các text đâu, nó chuyển thành mtext mà các text lại liền nhau, không như ý muốn

<<

(defun c:AttDef2Text ( / ss )
  ;; © Lee Mac  ~  01.06.10
  (vl-load-com)

  (if (setq ss (ssget "_:L" '((0 . "ATTDEF"))))
...
>>

(defun c:AttDef2Text ( / ss )
  ;; © Lee Mac  ~  01.06.10
  (vl-load-com)

  (if (setq ss (ssget "_:L" '((0 . "ATTDEF"))))
    (
      (lambda ( i / e o )
        (while (setq e (ssname ss (setq i (1+ i))))
          (if
            (
              (if (and (vlax-property-available-p
                         (setq o (vlax-ename->vla-object e)) 'MTextAttribute)
                       (eq :vlax-true (vla-get-MTextAttribute o)))

                MAttDef2MText AttDef2Text
              )
              (entget e)
            )
            (entdel e)
          )
        )
      )
      -1
    )
  )
  (princ)
)

(defun AttDef2Text ( eLst / dx74 dx2 )
  ;; © Lee Mac  ~  01.06.10

  (setq dx74 (cdr (assoc 74 eLst)) dx2 (cdr (assoc 2 eLst)))

  (entmake
    (append '( (0 . "TEXT") ) (RemovePairs '(0 100 1 2 3 73 74 70 280) eLst)
      (list
        (cons 73 dx74)
        (cons  1  dx2)
      )
    )
  )
)

(defun MAttDef2MText ( eLst )
  ;; © Lee Mac  ~  01.06.10

  (entmake
    (append '( (0 . "MTEXT") (100 . "AcDbEntity") (100 . "AcDbMText") )
      (RemoveFirstPairs '(40 50 41 7 71 72 71 72 73 10 11 11 210)
        (RemovePairs '(-1 102 330 360 5 0 100 101 1 2 3 42 43 51 74 70 280) eLst)
      )
      (list (cons 1 (cdr (assoc 2 eLst))))
    )
  )
)

(defun RemoveFirstPairs ( pairs lst )
  ;; © Lee Mac

  (defun foo ( pair lst )
    (if lst
      (if (eq pair (caar lst))
        (cdr lst)
        (cons (car lst) (foo pair (cdr lst)))
      )
    )
  )

  (foreach pair pairs
    (setq lst (foo pair lst))
  )
  lst
)


(defun RemovePairs ( pairs lst )
  ;; © Lee Mac
  (vl-remove-if
    (function
      (lambda ( pair )
        (vl-position (car pair) pairs)
      )
    )
    lst
  )
)

Gửi bác VanHoa

 

Cảm ơn Bạn Dinhvantrang rất nhiều...Lisp của bạn đã xử lý đc Text Att bị Exploxe...

<<

Download lisp

Filename: 419017_attdef2text.lsp

Lisp đầu :

;free lisp from CadViet.com @ketxu
(defun dxf (dxf ent) (cdr (assoc dxf (entget ent))))
(defun wtxt_l(txt p / sty d h1 h2 wf...
>>

Lisp đầu :

;free lisp from CadViet.com @ketxu
(defun dxf (dxf ent) (cdr (assoc dxf (entget ent))))
(defun wtxt_l(txt p / sty d h1 h2 wf h) ;;;Write txt on graphic screen at p
(setq    sty (getvar "textstyle")    
d (tblsearch "style" sty)    
h1 (cdr (assoc 40 d))    
h2 (cdr (assoc 42 d))    
wf (cdr (assoc 41 d)))
(if (> h1 0) (setq h h1) (setq h h2))
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 40 h) (cons 41 wf)(cons 72 1)(cons 11 p) (cons 1 txt) (cons 10 p))))
(defun c:ct(/ sum ssc sst)
(setq ssc (acet-ss-to-list (ssget '((0 . "*TEXT"))))
	sst (acet-ss-to-list (ssget '((0 . "*TEXT"))))
	sum 0)
(foreach x ssc
(setq sum (+ sum (atof (dxf 1 x))))
)
(foreach x sst
(setq sum (- sum (atof (dxf 1 x))))
)
(wtxt_l (rtos sum 2 2) (getpoint "\n Diem chen ket qua"))	
)

Tuyệt vời. cảm ơn bạn. Qua nhiều lisp hay !!!

<<

Lisp làm toàn bộ rất khó vì phải mô hình hóa địa hình.

 

Có cách làm tay khá đơn giản tận dụng chức năng của 3DSMax:

Vào 3DSMax:

- Nhập...

>>

Lisp làm toàn bộ rất khó vì phải mô hình hóa địa hình.

 

Có cách làm tay khá đơn giản tận dụng chức năng của 3DSMax:

Vào 3DSMax:

- Nhập đường đồng mức từ file DWG.

- Dùng lệnh Terrain để biến đường đồng mức thành mặt.

- Dùng lệnh Shell để biến mặt thành khối.

- Dùng lệnh Boolean để giao các khối (khối A, Khối B và khối trụ tạo bởi đường biên khu đất) để tạo thành khối C.

- Export khối A, Khối B, Khối C sang CAD.

 

Từ mặt mesh này trong AutoCAD chúng ta có thể tính được khối tích của nó (của 3 khối A, B, C). Bằng cách explode chúng ra thành 3Dface, dùng lisp để tính khối tích của các hình lăng trụ tạo bởi các 3DFace này với mặt phẳng x0y. Tổng của chúng chính là khối tích của miền giới hạn bởi địa hình và mặt phẳng xoy. Khối tích được tính theo công thức: V = S * (z1+z2+z3)/3.

 

Mã lisp như sau:

(defun c:V3DF ()
 (defun ttone (ent)
   (setq
     tt    (entget ent)
     p1    (cdr (assoc 10 tt))
     p2    (cdr (assoc 11 tt))
     p3    (cdr (assoc 12 tt))
     x1    (car p1)
     y1    (cadr p1)
     z1    (caddr p1)
     x2    (car p2)
     y2    (cadr p2)
     z2    (caddr p2)
     x3    (car p3)
     y3    (cadr p3)
     z3    (caddr p3)
     S	    (abs (/ (+
	      (* (+ y1 y2) (- x1 x2))
	      (* (+ y2 y3) (- x2 x3))
	      (* (+ y3 y1) (- x3 x1))
	    )
	    2.0
	 )
    )
     V	    (/ (* s (+ z1 z2 z3)) 3.0)
     VTong (+ VTong V)
   )
 )
 ;;;--------------------Main -----------------
 (setq	Vtong 0.0
ss3f  (ssget '((0 . "3DFACE")))
       sodt  (cond
	(ss (sslength ss))
	(t 0)
      )	
index 0
 )
 (repeat sodt
   (setq entdt	(ssname ss index)
  index	(1+ index)
   )
   (ttone entdt)    
 )
 (princ "\n*****************************")
 (princ "\nThe tich la: ")
 (princ Vtong)
 (princ "\n*****************************")
 (princ)
)

Bác Hoành ạh, về Cad thì em phục bác, nhưng mà còn về nhiều cái .......khác thì....hehe, bác không bằng em đâu. Nhưng rất cảm ơn bác về bài viết này, chỉ giúp em sự liên hệ giữa các phần mềm :s_big:

<<

Hề hề hề,

Xin lỗi vì bạn phải đợi lâu.Vừa qua mình cũng hơi bận nên không đọc được yêu cầu của...

>>

Hề hề hề,

Xin lỗi vì bạn phải đợi lâu.Vừa qua mình cũng hơi bận nên không đọc được yêu cầu của bạn.

Đây là cái mình đã sửa lại từ cái lisp cũ, không biết đã đúng với cái bạn yêu cầu hay chưa. Nếu chưa xin đừng ngại nói rõ chỗ chưa được để mình ngâm tiếp.

 
(defun c:gdd (/ oldos )
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(command "undo" "be")
(makeattbl "GHIDODOC1" nil)
(makeattbl "GHIDODOC2" T)
(alert "\n Hay chon cac pline, line, arc can ghi do doc ")
(setq ssl (acet-ss-to-list (ssget (list (cons 0 "*line,arc")))))
(foreach ent ssl      
      (ghidodoc ent)      
)
(command "undo" "e")
(setvar "osmode" oldos)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;; Tao block thuoc tinh 
(defun makeattbl (name Tflag / p e1 e2 e3 )
(setvar "aflags" 0)
(if (not (tblsearch "block" name ))
(progn
(setq p (list 0.0 0.0 0.0))
(if Tflag
(command "pline" (polar p pi 15) "w" 0.0 3 (polar p pi 9) "w" 0.75 0.75 (polar p  0 15) "")
(command "pline" (polar p 0 15) "w" 0.0 3 (polar p 0 9) "w" 0.75 0.75 (polar p  pi 15) "")
)
(setq e1 (entlast))
(command "attdef" "" "Dodoc" "dodoc" "10%" "j" "mc" (polar p  (/ pi 2) 3) 3 0  )
(setq e2 (entlast))
(command "attdef" "" "length" "dodai" "500" "j" "mc" (polar p (- (/ pi 2)) 3) 3 0  )
(setq e3 (entlast))
(command "block" name p e1 e2 e3 "")
) )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ghidodoc (ent / obj h1 h2 plst p2 p3 len i v ang ans)
(setq els (entget ent)  )
(if (or (= (cdr (assoc 0 els)) "LINE") (= (cdr (assoc 0 els)) "ARC"))
    (progn 
       (command "pedit" ent "y" "")
       (setq ent (entlast))
    )
)
(redraw ent 3)
(setq obj (vlax-ename->vla-object ent)
          plst (acet-geom-vertex-list ent) 
          h1 (getreal "\n Nhap cao do diem dau: ") )
(foreach p plst
    (setq par (vlax-curve-getparamatpoint obj p)                   
          ;;;;;;;; h (getreal "\n Nhap chieu cao text: ")
          ;;;;;;;; p1 (vlax-curve-getstartpoint obj)
          p2 (vlax-curve-getpointatparam obj (1+ par))  )
    (if p2 (progn
              (setq  p3 (vlax-curve-getpointatparam obj (+ par 0.5))
                        h2 (getreal "\n Nhap cao do diem ke tiep: ")
                        len (- (vlax-curve-getdistatpoint obj p2) (vlax-curve-getdistatpoint obj p))
                        v (vlax-curve-getfirstderiv obj (+ par 0.5))
                        ang (atan (/ (cadr v) (car v)))
                        i (/ (* (abs (- h1 h2)) 100) len)  )
              (command "insert" "GHIDODOC1" "R" (* (/ ang pi) 180) p3 "" ""  (strcat "i = " (rtos i 2 4) "%") (strcat "L = " (rtos len 2 1) "(m)") )              
              (setq ans (getstring "\n Ban co dong y voi chieu do doc nay < y or n> : "))
              (if (= (strcase ans) "N")
                  (progn
                  (command "erase" "last" "")
                  (command "insert" "GHIDODOC2" "R" (* (/ ang pi) 180) p3 "" ""  (strcat "i = " (rtos i 2 4) "%") (strcat "L = " (rtos len 2 1) "(m)") )
                  )
               )
               )
     )
     (setq h1 h2)
)
(redraw ent 4)
)

Chúc bạn luôn vui.

 

Chào bác Bình, mong bác sửa thêm lisp này hộ em với. Đối với đoạn nối hai nút giao mà được nối bởi cả đường thẳng và đường cong hay vẽ một đường polyline nhưng bằng cách pick 3 điểm thì khi dùng lệnh Gdd thì nó chỉ nhận khoảng cách đoạn đầu tiên để tính. Mong Bác sửa sớm giúp em nhé. Cám ơn bác nhiều

<<

Download lisp

Filename: 332175_gdd.lsp

Của bạn đây. lisp sẽ tính diện tích thực theo tỷ lệ bản vẽ bạn nhập vào. đầu tiên bạn phải chọn vị trí đặt bảng thống kê diện...

>>

Của bạn đây. lisp sẽ tính diện tích thực theo tỷ lệ bản vẽ bạn nhập vào. đầu tiên bạn phải chọn vị trí đặt bảng thống kê diện tích trên bản vẽ rồi mới pick chọn các miền cần đo diện tích. pick tới đâu diện tích sẽ được thống kê vào bảng đến đó. Mình viết thêm cho bạn một ô tính tổng diện tích các miền đã đo (yêu cầu của bạn không thấy nêu vấn đề này), tuy nhiên bạn phải Enter để kết thúc lệnh (không nhấn Esc nhé) thì lisp mới vẽ được ô cuối cùng này.

(defun c:r()
(vl-load-com)
(setvar "cmdecho" 0)
(setq lacol (getvar "CEColor"))
(setq ladin (getvar "dimzin"))
(setq laos (getvar "osmode")) 
(if (not tl) (setq tl 1))
(if (not h) (setq h 1))
(setq tl1 (getreal (strcat "\nty le ban ve < 1/" (rtos tl 2 0) " >: 1/"))
caot1 (getreal (strcat "\nCao text < " (rtos h 2 0) " >: ")))
(if tl1 (setq tl tl1))
(if caot1 (setq h caot1))

(setq k 0 
tdt 0)
(setq ss (ssadd))

(setvar "dimzin" 0)
(setvar "OSMODE" 0)
(setq PT (getpoint "\nChon diem xuat bang thong ke dien tich (mep trai):"))
(setq P1 (list (+ (car PT)(* 6 h)) (cadr PT))
P2 (list (+ (car PT)(* 22 h)) (cadr PT))
P3 (list (car PT) (- (cadr PT)(* 3 h)))
P4 (list (car P1) (cadr P3))
P5 (list (car P2) (cadr P3))
P6 (list (+ (car PT)(* 11 h)) (+ (cadr PT)(* 2 h)))
P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
);setq
(command "pline" PT P2 P5 P3 "C"
"pline" P1 P4 ""
"style" "chuv" "VNI-Helve-condense" "" "1" "" "" ""
"text" "m" P6 (* 1.2 h) 0 "%%UBAÛNG THOÁNG KEÂ DIEÄN TÍCH"
"text" "m" P7 h 0 "STT"
"text" "m" P8 h 0 "DIEÄN TÍCH (M2)"
);command

(setq pt1 (getpoint "\n Chon mien tinh dien tich : "))
(while (/= pt1 nil)
(setq k (+ 1 k))
(command "TEXT" "m" pt1 (* 3 h) 0 (rtos k 2 0))
(setq PT (list (car P3) (cadr P3))
P1 (list (+ (car PT)(* 6 h)) (cadr PT))
P2 (list (+ (car PT)(* 22 h)) (cadr PT))
P3 (list (car PT) (- (cadr PT)(* 3 h)))
P4 (list (car P1) (cadr P3))
P5 (list (car P2) (cadr P3))
P7 (list (+ (car PT)(* 3 h)) (- (cadr PT)(* 1.5 h)))
P8 (list (+ (car PT)(* 14 h)) (- (cadr PT)(* 1.5 h)))
P9 (list (car PT) (- (cadr P3)(* 3 h)))
P10 (list (car P1) (cadr P9))
P11 (list (car P2) (cadr P9))
P12 (list (car P7) (- (cadr P3)(* 1.5 h)))
P13 (list (car P8) (cadr P12))
);setq
(command "CECOLOR" 4 "-boundary" pt1 "" )
(setvar "CECOLOR" lacol)
(setq et (entlast))
(ssadd et ss)
(command "area" "e" "last") 
(setq et (entlast))
(ssadd et ss)
(setq dtcon (* (getvar "AREA") tl))
(setq tdt (+ dtcon tdt))
(command "erase" ss "")

(command "pline" PT P2 P5 P3 "C"
"pline" P1 P4 ""
"text" "m" P7 h 0 (rtos k 2 0)
"text" "m" P8 h 0 (rtos dtcon 2 2))

(setq pt1 (getpoint "\n chon mien tinh dien tich tiep theo hoac enter de ket thuc lenh..."))
);while
(setq ss nil)
(setvar "DIMZIN" ladin)
(command "pline" P3 P9 P11 P5 "C"
"pline" P10 P4 ""
"style" "chuv" "VNI-Helve-condense" "" "1" "" "" ""
"text" "m" P12 h 0 "TOÅNG"
"text" "m" P13 h 0 (rtos tdt 2 2)
);command
(setvar "OSMODE" laos)
(setvar "cmdecho" 1)
)

Nếu được bạn bổ sung thêm gán text là font Vni-Hel thì đẹp mắt hơn bạn à, chứ như thế xấu quá

Xin lỗi bạn Thaistreetz mình xin bổ sung thêm gán text lá font Vni-helcon để bạn nào có nhu cầu thì sử dụng

<<