Hỏi về Lisp (thuật toán, ý tưởng, coding,...)

Tháng 10 2, 2010

1- Lisp không có sẵn các hàm thao tác với hệ hexadecimal, nếu có nhu cầu phải tự xây dựng lấy.
Nếu chỉ giới hạn ở việc chọn entbef (mình thích từ "entback" hơn vì nó opposite với "entnext" hơn) thì trình tự như bạn đã làm là OK rồi. Tuy nhiên, đã tốn công sức vào đó thì nên xây dựng luôn các hàm thao tác với hexadecimal để có cái mà dùng khi cần đến sau này nên mình mới gợi ý như vậy. Cách làm tuỳ mỗi người, thoả sức mà sáng tạo!

2- Góp ý: hàm 16t10 của bạn cho return dạng integer thì hợp lý hơn

3- Trong help có một đoạn code cực hay, convert số decimal sang cơ số khác bất kỳ: nhị, bát, thập lục (thậm chí tam, tứ, ngũ... phân gì đó cũng được tuốt!). Bạn thấy hứng thú thì ngâm cứu và phát triển tiếp theo chiều ngược lại:

Vài ví dụ ssg đã chạy thử (thập lục, nhị và... tam phân!)

Command: (base 16 27)

"1B"

Command: (base 2 7)

"111"

Command: (base 3 7)

"21"

Chào bác SSG,

Dựa trên cái lisp và sư gợi ý của bác mình viết thêm phần đổi ngược một chuỗi ký tự biểu diễn số trong các hệ cơ số đếm khác nhau thành giá tị số nguyên trong hệ thập phân. Nhờ bác và các bác khác kiểm tra lại giùm mình nhé.


; BASE converts from a decimal integer to a string in another base.
(defun BASE ( bas int / ret yyy zot )
(defun zot ( i1 i2 / xxx )
(if (> (setq xxx (rem i2 i1)) 9)
(chr (+ 55 xxx))
(itoa xxx)
)
)
(setq ret (zot bas int) yyy (/ int bas))
(while (>= yyy bas)
(setq ret (strcat (zot bas yyy) ret))
(setq yyy (/ yyy bas))
)
(strcat (zot bas yyy) ret)
)
;; The CON function will convert an expression string in another base to decimal integer value.
(defun con (str bas / n i )
(setq str (strcase str)
        n (strlen  str)
        val 0
        i 0 )
(while (> n 0)
      (setq ch (substr str n 1))
      (if (>= (ascii ch) 65)
          (setq val (+ val ( * (expt bas i) (- (ascii ch) 55))))
          (setq val (+ val (* (expt bas i) (atoi ch))))
      )
      (setq i (1+ i)
              n (1- n)
      )
)
val
)

Code được sửa bởi Phạm Thanh Bình ngày 3/10/2010 theo góp ý của bác Master_Worse và bác SSG.

Tháng 10 3, 2010

Chào bác SSG,
Dựa trên cái lisp và sư gợi ý của bác mình viết thêm phần đổi ngược một chuỗi ký tự biểu diễn số trong các hệ cơ số đếm khác nhau thành giá tị số nguyên trong hệ thập phân. Nhờ bác và các bác khác kiểm tra lại giùm mình nhé.

1- Tuyệt lắm bác Bình! Không bõ công bác đã thức đến hơn 2h sáng! :cheers:

Ssg đã chạy thử, OK!

2- Cái calculator của Windows đã có sẵn options chuyển qua lại giữa các hệ đếm 2, 8, 10 và 16. Các bạn có thể dùng để kiểm tra kết quả chạy hàm BASE và CON:

Tháng 10 3, 2010

Chào bác SSG,
Dựa trên cái lisp và sư gợi ý của bác mình viết thêm phần đổi ngược một chuỗi ký tự biểu diễn số trong các hệ cơ số đếm khác nhau thành giá tị số nguyên trong hệ thập phân. Nhờ bác và các bác khác kiểm tra lại giùm mình nhé.

Bác sửa dòng này: (setq n (strlen (strcase str))val 0i 0 )

thành: (setq n (strlen (setq str (strcase str))) val 0 i 0 )

là tạm ổn vì (- (ascii "a") 55) = 42 /= (- (ascii "A") 55) = 10

với lại nếu có 1 ký tự không phải là A, B, C, D, E, F thì sao!? - không cần lắm nhưng ...

nếu có thể thì sửa vị trí các đối số lại cho giống hàm base

(defun con (bas str / n i )

Tháng 10 3, 2010

1- Bác sửa dòng này: (setq n (strlen (strcase str))val 0i 0 )
thành: (setq n (strlen (setq str (strcase str))) val 0 i 0 )

là tạm ổn vì (- (ascii "a") 55) = 42 /= (- (ascii "A") 55) = 10

2- với lại nếu có 1 ký tự không phải là A, B, C, D, E, F thì sao!? - không cần lắm nhưng ...

3- nếu có thể thì sửa vị trí các đối số lại cho giống hàm base

(defun con (bas str / n i )

Ý kiến ssg thế này:

1- OK! Cám ơn bạn!

2- Không cần, vì chỉ có programmer dùng. Các điều kiện sẽ được "rào" khi họ lập chương trình chính. Trong các functions con, ta cứ giả định rằng các arguments là chính xác -> code sẽ ngắn gọn, rõ ràng hơn.

3- Hoàn toàn nhất trí.

Tháng 10 4, 2010

Theo hướng dẫn của anh ssg cộng với ý tưởng trong lisp anh Tue_NV, em tự trả lời câu hỏi của mình với lisp sau.
(defun maklis ()
  (setq lis_hex '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F"))
  (setq lis_dec '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10" "11" "12" "13" "14" "15"))
)
(defun DXF (code e) (cdr (assoc code (entget e))))
(defun 16t10 (hex / lis_hex lis_dec L kt S i j)
 (maklis)
  (setq L (strlen hex) i L j 0 S 0)
  (Repeat L
    (setq kt (atoi (nth (vl-position (substr hex i 1) lis_hex) lis_dec)))
    (setq S (+ S (* (expt 16 j ) kt)))
    (setq i (1- i))
    (setq j (1+ j))
)
  (itoa S)
)
(defun 10t16 (dec / lis_hex lis_dec hex L dec1 i kt)
 (maklis)
  (setq dec (fix dec))
  (setq hex (strcat)) 
  (setq L (1+ (fix (/ (log dec) (log 16))))  i (1- L) dec1 dec)
  (Repeat L
    (setq kt (nth (vl-position (itoa (fix (/ dec1 (expt 16 i)))) lis_dec) lis_hex))
(setq hex (strcat hex kt))
    (setq dec1 (- dec1 (* (expt 16 i ) (fix (/ dec1 (expt 16 i))))))
    (setq i (1- i))
)
  hex
)
(defun entbef (ena / ena2 han1)
 (setq han1 (dxf 5 ena))
 (setq ena2 (handent (10t16 (- (atof (16t10 han1)) 1))))
)
(defun C:test ()
 (setq ena1 (car (entsel "\nChon doi tuong ban muon lay ename cua doi tuong ke truoc")))
 (setq ena_bef (entbef ena1))
 (command "erase" ena_bef "")
)
Bước 2- "Tự xây dựng hàm số học để cộng trừ số hexadecimal. Dùng nó để trừ handle nhận được ở trên 1 đơn vị, kết quả bạn nhận được là "C1"." của anh em không làm trực tiếp bên hexadecimal được. Anh có thể viết hàm cộng trừ trực tiếp trên hệ hexadecimal không? Em làm như vậy thì dài dòng và không đúng hướng dẫn của anh thi phải.

Cảm ơn sự nhiệt tình của các anh. Rất vui được học hỏi!

Vài góp ý về lisp của bạn:

Nếu gọi hàm 16t10 hoặc 10t16 mà mỗi lần lại thực hiện (maklis) là không hiệu quả

Không cần lis_dec vì trong hàm 16t10

(vl-position (substr hex i 1) lis_hex)

tương đương với

(atoi (nth (vl-position (substr hex i 1) lis_hex) lis_dec))

và trong hàm 10t16

(nth (fix (/ dec1 (expt 16 i))) lis_hex)

tương đương với

(nth (vl-position (itoa (fix (/ dec1 (expt 16 i)))) lis_dec) lis_hex)

Trong hàm 16t10 nên cho j=1 ngoài vòng lặp,

sau đó (setq j (* j 16)) bên trong

Trong hàm 10t16 nên thêm 1 biến i16 = (expt 16 i)ngoài vòng lặp,

sau đó (setq i16 (/ i16 16)) bên trong

Có thể dùng (setq j (lsh j 4)) và (setq i16 (lsh i16 -4)) để tăng tốc độ

Trong hàm entbef phải dùng vòng while vì nếu đối tượng có handent bị xóa

thì ena2 = nil, ngoài ra còn phải xét trường hợp ena là đối tượng đầu tiên

Trong hàm C:test ena_bef chưa chắc là 1 entity thì làm sao dùng (command "erase" ena_bef "")

Tháng 10 6, 2010

Em xin hỏi về đối tượng viewport.

1. Em có đọc trên diễn đàn biết lệnh "mspace" và "pspace" giúp chuyển model vport và thoát ra môi trường layout.

Nhưng lệnh "mspace" chỉ chuyển vào model vport đang active, Vậy nếu như layout1 có 5 viewport1 (có viewportID khác nhau theo mã dxf 69).

Em làm thế nào để kích hoạt vport bất kỳ trong số các vport đang có?

Làm thể nào để chuyển vào vport bất kỳ?

2. Trước khi hỏi vấn đề này có vào help để tìm hiểu thì có đọc đến biến hệ thống "cvport". Không biết biển này có giúp được vấn đề 1 em nếu không nhưng mà em đọc trong help không hiểu đc. Nếu các anh có thể, giải thích luôn dùm em về biến hệ thống này với.

3. Cảm ơn diễn đàn.

Tháng 10 7, 2010

Em xin hỏi về đối tượng viewport.
1. Em có đọc trên diễn đàn biết lệnh "mspace" và "pspace" giúp chuyển model vport và thoát ra môi trường layout.

Nhưng lệnh "mspace" chỉ chuyển vào model vport đang active, Vậy nếu như layout1 có 5 viewport1 (có viewportID khác nhau theo mã dxf 69).

Em làm thế nào để kích hoạt vport bất kỳ trong số các vport đang có?

Làm thể nào để chuyển vào vport bất kỳ?

2. Trước khi hỏi vấn đề này có vào help để tìm hiểu thì có đọc đến biến hệ thống "cvport". Không biết biển này có giúp được vấn đề 1 em nếu không nhưng mà em đọc trong help không hiểu đc. Nếu các anh có thể, giải thích luôn dùm em về biến hệ thống này với.

3. Cảm ơn diễn đàn.

Hề hề hề,

Dốt mà như bạn thì còn khối anh muốn dốt đó....

Hỏi chi mà hóc rứa.

1/- Cái vụ này mình vẫn điếc nên đành dựa cột để nghe vậy.

2/- Về thằng CVport thì:

CVPORT System Variable

Concepts Procedures Reference

Type: Integer

Saved in: Drawing

Initial value: 2

Sets the identification number of the current viewport. You can change this value, which changes the current viewport, if the following conditions are met:

The identification number you specify is that of an active viewport.

A command in progress has not locked cursor movement to that viewport.

Tablet mode is off.

Cứ theo như cái mà mình hiểu thì nó bảo rằng có thể dùng thằng này để thay đổi viewport hiện hành với 3 điều kiện là:

- Cái số CMND mà bạn nhập vô đó phải là của một thằng viewport đang hoạt động (không bị cảnh sát CAD giam giữ hay cấm di chuyển khỏi nơi cu trú)

- Cái lệnh cần thực thi sẽ không khóa chết con trỏ trên viewport này. (nghĩa là túm nó nhưng không được túm thằng cusor con nó)

- Mode tablet phải là off.

Cách mình hiểu đúng hay sai thì nhờ bạn kiểm tra lại nha. Mình điếc về View port nên chả thể kiểm chứng cái hiểu của mình

Hề hề hề,...

3/- Lại làm một việc dư

Hề hề hề....

Tháng 10 7, 2010

Em xin hỏi về đối tượng viewport.
1. Em có đọc trên diễn đàn biết lệnh "mspace" và "pspace" giúp chuyển model vport và thoát ra môi trường layout.

Nhưng lệnh "mspace" chỉ chuyển vào model vport đang active, Vậy nếu như layout1 có 5 viewport1 (có viewportID khác nhau theo mã dxf 69).

Em làm thế nào để kích hoạt vport bất kỳ trong số các vport đang có?

Làm thể nào để chuyển vào vport bất kỳ?

Gọi v là viewport bạn muốn kích hoạt (v à entity type). Bạn thử kiểu này xem:

(command "mspace")

(command "vports" "ON" v "")

Tháng 10 8, 2010

Xin hỏi, mình đang dùng lisp để tự động Insert file bằng cách sử dụng Menu hình ảnh, nhưng khi Insert một file cad nào đó ra các block thì điểm "insertion point" của block đó mặc định là điểm nào ?, nó có quy tắc nào không ? (không phải là điểm 0,0 đâu nhé, mình có thử rồi). Cám ơn nha.

Tháng 10 8, 2010

Xin hỏi, mình đang dùng lisp để tự động Insert file bằng cách sử dụng Menu hình ảnh, nhưng khi Insert một file cad nào đó ra các block thì điểm "insertion point" của block đó mặc định là điểm nào ?, nó có quy tắc nào không ? (không phải là điểm 0,0 đâu nhé, mình có thử rồi). Cám ơn nha.

Mở file cad lên, gõ lệnh base bạn sẽ thấy điểm "insertion point" của file.

-> Enter base point <1681.975,6768.404,0.000>:

Help :

Command entry: base (or 'base for transparent use)

Summary

The base point is expressed as coordinates in the current UCS. When you insert or externally reference the current drawing into other drawings, this base point is used as the insertion base point.

Tháng 10 8, 2010

Cho e hỏi cách vào 1 block lấy dữ liệu các thành phần của nó như khi dùng ssget để lấy thông tin các đối tượng ko trong block. VD như: Chọn tất cả các đối tượng TEXT trong block có tên là Vidu. và thay đổi chiều cao của nó. THank

Tháng 10 8, 2010

Cho e hỏi cách vào 1 block lấy dữ liệu các thành phần của nó như khi dùng ssget để lấy thông tin các đối tượng ko trong block. VD như: Chọn tất cả các đối tượng TEXT trong block có tên là Vidu. và thay đổi chiều cao của nó. THank

Bạn tham khảo ở đây : http://www.cadviet.com/forum/index.php?sho...mp;#entry111166

Tháng 10 9, 2010

Em xin hỏi làm thế nào để tạo ra 1 loại đối tượng (Entity type).

Ta vẫn hay vẽ CAD với các Entity type có sẵn của CAD như LINE, POLYLINE, ARC,CIRCLE ... Vậy nếu ta muốn tạo ra 1 Entity type chưa có sẵn thì làm thế nào ạ?

Sở dĩ em hỏi như vậy vì em tìm thấy 1 đối tượng Cad như sau :

Mã DXF của nó là : ((-1 . ) (0 . "TDTDBPOLYLINE") (330 . ) (5 . "852") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "plinetdtn"))

Đối tượng này tạo ra từ 1 chương trình chạy trên Cad là VnRoad (tương tự như chương trình Nova vậy). Khi ta mở file bằng chương trình VnRoad thì ta nhìn thấy đối tượng này. Nhưng khi mở bằng Cad bình thường thì đối tượng này không nhìn thấy được.

Em gởi file cho các anh xem http://www.cadviet.com/upfiles/3/56.dwg

Rõ ràng Entity type "TDTDBPOLYLINE" không có sẵn trong Cad. Vậy chương trình VnRoad đã tạo ra Entity type này như thế nào các anh nhỉ.

Tháng 10 11, 2010

E viết cái lisp như này mà ko hiểu sao lại tắc tịt không chạy đc .hjx .Bác nào giúp e với...Thank!!!

(defun BatDau() (setq OldOs (getvar "osmode")) (setvar "osmode" 0))

(defun KetThuc() (setvar "osmode" OldOs)(princ))

(defun moddxf (dxf chdxf ss) (entmod (subst (cons dxf chdxf) (assoc dxf (entget ss)) (entget ss))))

(defun Aver2 (x y) (/ (+ (float x) (float y)) 2) ) ;;;Average x & y, return Real

(defun Mid2P (p1 p2) ;;Middle point from p1, p2
(list (Aver2 (car p1) (car p2)) (Aver2 (cadr p1) (cadr p2)) (Aver2 (caddr p1) (caddr p2)))
)
;=========== Lap Khung Ten ===========;

;====================================;
(defun c:khung (/ dis121 dis141 rpt11 rpt21 rpt31 rpt41 mid121 mid231 mid341 mid411 off_set bn bp 
                      ssbv kmid12 kmid23  kmid34 kmid41 sel entkt Rec Rec1 pt1 pt2 rpt1 rpt2 rpt3 rpt4 mid12 
                      mid23 mid34 mid41 dis12 dis14 dis  toadodinh khoangcach i el1 el2 el3 el4 ssd 
                      en OldOs OldEcho )
(vl-load-com)
(setq OldEcho (getvar "cmdecho")) 
(setvar "cmdecho" 0)
(command "undo" "be")
(princ "\n       © nguyentuyen6 @CadViet ")
(princ "\n Cai Express-Tools truoc khi su dung!!!")
;====================;
;;;XU LY KHUNG TEN;;;;
;====================;
(setq sel (entsel "\nChon block khung ten:"))
(setq entkt (car sel))
(setq Rec (acet-ent-geomextents entkt)
	  pt1 (nth 0 Rec);lay dinh
	  pt2 (nth 1 Rec))
;		  i 0);setq
;-----acet-ent-geomextents:diem thap nhat trai va cao nhat phai
(BatDau)
(command "RECTANG" pt1 pt2)
(KetThuc)	
(setq el1 (entlast));el1

;-----lay dinh HCN = acet-geom-vertex-list
(setq toadodinh (acet-geom-vertex-list el1); 
	  rpt1 (nth 0 toadodinh);lay dinh 
	  rpt2 (nth 1 toadodinh)
	  rpt3 (nth 2 toadodinh)
	  rpt4 (nth 3 toadodinh)
;--
	  mid12 (Mid2P rpt1 rpt2);lay trung diem
	  mid23 (Mid2P rpt2 rpt3)
	  mid34 (Mid2P rpt3 rpt4)
	  mid41 (Mid2P rpt4 rpt1)
;--
	  dis12 (distance rpt1 rpt2)
	  dis14 (distance rpt1 rpt4));setq
;--
(setq kmid12 (polar mid12 (/ pi 2) (/ (* dis14 4) 100))
	  kmid34 (polar mid34 (/ (* pi 3) 2) (/ (* dis14 4) 100))
	  kmid23 (polar mid23 pi (/ (*dis12 20) 140))
	  kmid41 (polar mid41 0.0 (/ (* dis12 6) 140))
	  )
(command "ERASE" el1 "");xoa hcn

;====================;
;;;XU LY BAN VE;;;;
;====================;		 

 (setq bn (rtos (fix (* (getvar "CDATE") 100000)) 2 0)
;  (setq bp (getpoint "\nBase Point <0,0,0>:   "))
       bp (setq bp '(0 0 0)))
 (while (not ssbv)
        (setq ssbv (ssget "\nChon ban ve: ")))
 (command "_.BLOCK" bn bp ssbv ""
          "_.INSERT" bn bp 1 1 0)
(setq el4 (entlast));el4    
(princ)
(setq Rec1 (acet-ent-geomextents el4)
  pt11 (nth 0 Rec1);lay dinh
  pt21 (nth 1 Rec1))
;		  ii 0);setq
;-----acet-ent-geomextents:diem thap nhat trai va cao nhat phai
(BatDau)
(command "RECTANG" pt11 pt21)
(KetThuc)	
(setq el2 (entlast));el2

;-----khoang cach mac dinh
(setq khoangcach (getreal "\nKhoang cach khung ten va ban ve:"))
(if (= khoangcach nil) (setq khoangcach (/ (* dis12 5) 140)))
;---
   (setq off_set (polar pt21 (/ pi 2) khoangcach))	
(command "OFFSET" el2 off_set);offset
(setq el3 (entlast));el3
;-----lay dinh HCN = acet-geom-vertex-list
(setq toadodinh1 (acet-geom-vertex-list el3)
	  rpt11 (nth 0 toadodinh1);lay dinh
	  rpt21 (nth 1 toadodinh1)
	  rpt31 (nth 2 toadodinh1)
	  rpt41 (nth 3 toadodinh1)
;--
	  mid121 (Mid2P rpt11 rpt21);lay trung diem
	  mid231 (Mid2P rpt21 rpt31)
	  mid341 (Mid2P rpt31 rpt41)
	  mid411 (Mid2P rpt41 rpt11)
;--
	  dis121 (distance rpt11 rpt21)
	  dis141 (distance rpt11 rpt41));setq
;----- Chia truong hop cao va dai
(if (> dis121 dis141)		  
	  (command "ALIGN" khungten "" kmid41 mid141 kmid23 mid231 "" "Y" "");T
	  (command "ALIGN" khungten "" kmid34 mid341 kmid12 mid121 "" "Y" "");F
) ;if
;-----	
(command "ERASE" el2 "");xoa hcn
(command "ERASE" el3 "");xoa hcn offset
(command "EXPLODE" el4 "")
;---------------
(command "undo" "e")
(KetThuc)
(setvar "cmdecho" OldEcho)
(princ "\n...Done...")
(princ)
);defun

Tháng 10 11, 2010

E viết cái lisp như này mà ko hiểu sao lại tắc tịt không chạy đc .hjx .Bác nào giúp e với...Thank!!!

(defun BatDau() (setq OldOs (getvar "osmode")) (setvar "osmode" 0))

(defun KetThuc() (setvar "osmode" OldOs)(princ))

(defun moddxf (dxf chdxf ss) (entmod (subst (cons dxf chdxf) (assoc dxf (entget ss)) (entget ss))))

(defun Aver2 (x y) (/ (+ (float x) (float y)) 2) ) ;;;Average x & y, return Real

(defun Mid2P (p1 p2) ;;Middle point from p1, p2
(list (Aver2 (car p1) (car p2)) (Aver2 (cadr p1) (cadr p2)) (Aver2 (caddr p1) (caddr p2)))
)
;=========== Lap Khung Ten ===========;

;====================================;
(defun c:khung (/ dis121 dis141 rpt11 rpt21 rpt31 rpt41 mid121 mid231 mid341 mid411 off_set bn bp ssbv
           kmid12 kmid23  kmid34 kmid41 sel entkt Rec Rec1 pt1 pt2 rpt1 rpt2 rpt3 rpt4 mid12 mid23
           mid34 mid41 dis12 dis14 dis  toadodinh khoangcach i el1 el2 el3 el4 ssd en OldOs OldEcho )
(vl-load-com)
(setq OldEcho (getvar "cmdecho")) 
(setvar "cmdecho" 0)
(command "undo" "be")
(princ "\n       © nguyentuyen6 @CadViet ")
(princ "\n Cai Express-Tools truoc khi su dung!!!")
;====================;
;;;XU LY KHUNG TEN;;;;
;====================;
(setq sel (entsel "\nChon block khung ten:"))
(setq entkt (car sel))
(setq Rec (acet-ent-geomextents entkt)
	  pt1 (nth 0 Rec);lay dinh
	  pt2 (nth 1 Rec))
;		  i 0);setq
;-----acet-ent-geomextents:diem thap nhat trai va cao nhat phai
(BatDau)
(command "RECTANG" pt1 pt2)
(KetThuc)	
(setq el1 (entlast));el1

;-----lay dinh HCN = acet-geom-vertex-list
(setq toadodinh (acet-geom-vertex-list el1); 
	  rpt1 (nth 0 toadodinh);lay dinh 
	  rpt2 (nth 1 toadodinh)
	  rpt3 (nth 2 toadodinh)
	  rpt4 (nth 3 toadodinh)
;--
	  mid12 (Mid2P rpt1 rpt2);lay trung diem
	  mid23 (Mid2P rpt2 rpt3)
	  mid34 (Mid2P rpt3 rpt4)
	  mid41 (Mid2P rpt4 rpt1)
;--
	  dis12 (distance rpt1 rpt2)
	  dis14 (distance rpt1 rpt4));setq
;--
(setq kmid12 (polar mid12 (/ pi 2) (/ (*dis14 4) 100))
	  kmid34 (polar mid34 ((* pi 3) 4) (/ (*dis14 4) 100))
	  kmid23 (polar mid23 (* pi -1) (/ (*dis12 20) 140))
	  kmid41 (polar mid41 pi (/ (* dis12 6) 140))
	  )
(command "ERASE" el1 "");xoa hcn

;====================;
;;;XU LY BAN VE;;;;
;====================;		 

 (setq bn (rtos (fix (* (getvar "CDATE") 100000)) 2 0)
;  (setq bp (getpoint "\nBase Point :   "))
       bp (setq bp '(0 0 0)))
 (while (not ssbv)
        (setq ssbv (ssget "\nChon ban ve: ")))
 (command "_.BLOCK" bn bp ssbv ""
          "_.INSERT" bn bp 1 1 0)
(setq el4 (entlast));el4    
(princ)
(setq Rec1 (acet-ent-geomextents el4)
  pt11 (nth 0 Rec1);lay dinh
  pt21 (nth 1 Rec1))
;		  ii 0);setq
;-----acet-ent-geomextents:diem thap nhat trai va cao nhat phai
(BatDau)
(command "RECTANG" pt11 pt21)
(KetThuc)	
(setq el2 (entlast));el2

;-----khoang cach mac dinh
(setq khoangcach (getreal "\nKhoang cach khung ten va ban ve:"))
(if (= khoangcach nil) (setq khoangcach (/ (* dis12 5) 140)))
;---
   (setq off_set (polar pt21 (/ pi 2) khoangcach))	
(command "OFFSET" el2 off_set);offset
(setq el3 (entlast));el3
;-----lay dinh HCN = acet-geom-vertex-list
(setq toadodinh1 (acet-geom-vertex-list el3)
	  rpt11 (nth 0 toadodinh1);lay dinh
	  rpt21 (nth 1 toadodinh1)
	  rpt31 (nth 2 toadodinh1)
	  rpt41 (nth 3 toadodinh1)
;--
	  mid121 (Mid2P rpt11 rpt21);lay trung diem
	  mid231 (Mid2P rpt21 rpt31)
	  mid341 (Mid2P rpt31 rpt41)
	  mid411 (Mid2P rpt41 rpt11)
;--
	  dis121 (distance rpt11 rpt21)
	  dis141 (distance rpt11 rpt41));setq
;----- Chia truong hop cao va dai
(if (> dis121 dis141)		  
	  (command "ALIGN" khungten "" kmid41 mid141 kmid23 mid231 "" "Y" "");T
	  (command "ALIGN" khungten "" kmid34 mid341 kmid12 mid121 "" "Y" "");F
) ;if
;-----	
(command "ERASE" el2 "");xoa hcn
(command "ERASE" el3 "");xoa hcn offset
(command "EXPLODE" el4 "")
;---------------
(command "undo" "e")
(KetThuc)
(setvar "cmdecho" OldEcho)
(princ "\n...Done...")
(princ)
);defun

Khi đọc vào -> trước mắt, Tue_NV thấy mấy lỗi cơ bản sau :

(setq kmid12 (polar mid12 (/ pi 2) (/ (*dis14 4) 100))

kmid34 (polar mid34 ((* pi 3) 4) (/ (*dis14 4) 100))

kmid23 (polar mid23 (* pi -1) (/ (*dis12 20) 140))

kmid41 (polar mid41 pi (/ (* dis12 6) 140))

)

Bạn tự tìm lỗi tiếp nhé. Bạn đã viết được như vầy rồi. Hy vọng bạn tìm ra lỗi.

Chúc thành công

Tháng 10 12, 2010

Em xin hỏi làm thế nào để tạo ra 1 loại đối tượng (Entity type).
Ta vẫn hay vẽ CAD với các Entity type có sẵn của CAD như LINE, POLYLINE, ARC,CIRCLE ... Vậy nếu ta muốn tạo ra 1 Entity type chưa có sẵn thì làm thế nào ạ?

Sở dĩ em hỏi như vậy vì em tìm thấy 1 đối tượng Cad như sau :

Mã DXF của nó là : ((-1 . ) (0 . "TDTDBPOLYLINE") (330 . ) (5 . "852") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "plinetdtn"))

Đối tượng này tạo ra từ 1 chương trình chạy trên Cad là VnRoad (tương tự như chương trình Nova vậy). Khi ta mở file bằng chương trình VnRoad thì ta nhìn thấy đối tượng này. Nhưng khi mở bằng Cad bình thường thì đối tượng này không nhìn thấy được.

Em gởi file cho các anh xem http://www.cadviet.com/upfiles/3/56.dwg

Rõ ràng Entity type "TDTDBPOLYLINE" không có sẵn trong Cad. Vậy chương trình VnRoad đã tạo ra Entity type này như thế nào các anh nhỉ.

Đây là đối tuợng ACAD_PROXY_ENTITY

bạn gõ lệnh LISP sẽ đuợc (ví dụ):

ACAD_PROXY_ENTITY Layer: "plinetdtn"

.....

DXF name: TDTDBPOLYLINE

Class name: TdtDbPolyline

Application name: TDTALIGNMENTDBAPP" "

Product Desc: object is used for displayed the natural line" "

Company: TDT" "

WEB Address: www.tdttech.com.vn

đối tuợng ACAD_PROXY_ENTITY là sản phẩm của ARX. tham khảo : http://www.cadviet.com/forum/index.php?showtopic=13031

Trong truờng hợp này VnRoad không cho phép hiển thị trong CAD.

còn việc làm thế nào hiển thị trong Cad, bạn liên hệ với cty TDT- www.tdttech.com.vn

Tháng 10 12, 2010

Em loay hoay buổi sáng mà không ăn thua bác ah. Em định viết cái líp tự đặt khung tên vào bản vẽ ý mà. Chẳng hiểu sai chỗ nào nữa. Hjx

Tháng 10 12, 2010

Em loay hoay buổi sáng mà không ăn thua bác ah. Em định viết cái líp tự đặt khung tên vào bản vẽ ý mà. Chẳng hiểu sai chỗ nào nữa. Hjx

(setq kmid12 (polar mid12 (/ pi 2) (/ (*dis14 4) 100))

sai chỗ (*dis14 4) -> (* dis14 4)

kmid34 (polar mid34 ((* pi 3) 4) (/ (*dis14 4) 100))

sai chỗ (*dis14 4) -> (* dis14 4) và ((* pi 3) 4) - (/ (* pi 3) 4)

kmid23 (polar mid23 (* pi -1) (/ (*dis12 20) 140))

sai chỗ (*dis12 20) -> (* dis12 20)

Tháng 10 12, 2010

không phải bác ạ. Cái đó e sửa theo lời bác Tue rồi mà chạy vẫn báo lỗi. Đây là đoạn líp e đã sửa.

(defun BatDau() (setq OldOs (getvar "osmode")) (setvar "osmode" 0))

(defun KetThuc() (setvar "osmode" OldOs)(princ))

;=========== Lap Khung Ten ===========;

;====================================;
(defun c:khung (/ dis121 dis141 rpt11 rpt21 rpt31 rpt41 mid121 mid231 
mid341 mid411 off_set bn bp ssbv kmid12 kmid23 kmid34 kmid41 sel 
entkt Rec Rec1 pt1 pt2 rpt1 rpt2 rpt3 rpt4 mid12 mid23 mid34 mid41 
dis12 dis14 dis toadodinh khoangcach i el1 el2 el3 el4 ssd en OldOs OldEcho )
(vl-load-com)
(setq OldEcho (getvar "cmdecho")) 
(setvar "cmdecho" 0)
(command "undo" "be")
(princ "\n       © nguyentuyen6 @CadViet ")
(princ "\n Cai Express-Tools truoc khi su dung!!!")
;====================;
;;;XU LY KHUNG TEN;;;;
;====================;
(setq sel (entsel "\nChon block khung ten: "))
(setq entkt (car sel))
;(setq khungten (ssget "\nChon khung ten: "))
(setq Rec (acet-ent-geomextents entkt)
	  pt1 (nth 0 Rec) ;lay dinh              *-----pt2
	  pt2 (nth 1 Rec));lay dinh              | khung |
                         ;                      pt1-----*	
;-----acet-ent-geomextents:diem thap nhat trai va cao nhat phai
(BatDau)
(command "RECTANG" pt1 pt2)
(KetThuc)	
(setq el1 (entlast));el1

;-----lay dinh HCN = acet-geom-vertex-list
(setq toadodinh (acet-geom-vertex-list el1);    	  rpt4----rpt3
	  rpt1 (nth 0 toadodinh);lay dinh                  |  el1 |
	  rpt2 (nth 1 toadodinh);lay dinh                 rpt1----rpt2
	  rpt3 (nth 2 toadodinh);lay dinh 
	  rpt4 (nth 3 toadodinh);lay dinh
	  mid12 (list (/ (+ (car rpt1) (car rpt2)) 2) (/ (+ (cadr rpt1) (cadr rpt2)) 2));trung diem
	  mid23 (list (/ (+ (car rpt2) (car rpt3)) 2) (/ (+ (cadr rpt2) (cadr rpt3)) 2))
	  mid34 (list (/ (+ (car rpt3) (car rpt4)) 2) (/ (+ (cadr rpt3) (cadr rpt4)) 2))
	  mid41 (list (/ (+ (car rpt4) (car rpt1)) 2) (/ (+ (cadr rpt4) (cadr rpt1)) 2))
	  dis12 (distance rpt1 rpt2); khoang cach
	  dis14 (distance rpt1 rpt4)
);setq
;--
(setq kmid12 (polar mid12 (/ pi 2) (/ (* dis14 4) 100))
	  kmid34 (polar mid34 (/ (* pi 3) 2) (/ (* dis14 4) 100))
	  kmid23 (polar mid23 pi (/ (* dis12 20) 140))
	  kmid41 (polar mid41 0.0 (/ (* dis12 6) 140))
	  )
(command "ERASE" el1 "");xoa hcn

;====================;
;;;XU LY BAN VE;;;;
;====================;		 

 (setq bn (rtos (fix (* (getvar "CDATE") 100000)) 2 0)); block ban ve
;  (setq bp (getpoint "\nBase Point <0,0,0>:   "))
;        bp (setq bp '(0 0 0)))
 (while (not ssbv)
        (setq ssbv (ssget "\nChon ban ve: ")))
 (command "_.BLOCK" bn kmid41 ssbv ""
          "_.INSERT" bn kmid41 1 1 0)
(setq el4 (entlast));el4    
;----
(setq Rec1 (acet-ent-geomextents el4)
  pt11 (nth 0 Rec1);lay dinh               *-----pt2
  pt21 (nth 1 Rec1));lay dinh              |  bve  |
;		  ii 0);setq                           pt1-----*	
;-----acet-ent-geomextents:diem thap nhat trai va cao nhat phai
(BatDau)
(command "RECTANG" pt11 pt21)
(KetThuc)	
(setq el2 (entlast));el2

;-----khoang cach mac dinh
(setq khoangcach (getreal "\nKhoang cach khung ten va ban ve:"))
(if (= khoangcach nil) (setq khoangcach (/ (* dis12 5) 140)))
;---
   (setq off_set (polar pt21 (/ pi 2) khoangcach))	
(command "OFFSET" el2 off_set);offset
(setq el3 (entlast));el3
;-----lay dinh HCN = acet-geom-vertex-list
(setq toadodinh1 (acet-geom-vertex-list el3);    	  rpt4----rpt3
	  rpt11 (nth 0 toadodinh1);lay dinh                  |  bve |
	  rpt21 (nth 1 toadodinh1);lay dinh                 rpt1----rpt2
	  rpt31 (nth 2 toadodinh1);lay dinh 
	  rpt41 (nth 3 toadodinh1);lay dinh
;--
;lay trung diem
         mid121 (list (/ (+ (car rpt11) (car rpt21)) 2) (/ (+ (cadr rpt11) (cadr rpt21)) 2))
	  mid231 (list (/ (+ (car rpt2) (car rpt31)) 2) (/ (+ (cadr rpt21) (cadr rpt31)) 2))
	  mid341 (list (/ (+ (car rpt3) (car rpt41)) 2) (/ (+ (cadr rpt31) (cadr rpt41)) 2))
	  mid411 (list (/ (+ (car rpt4) (car rpt11)) 2) (/ (+ (cadr rpt41) (cadr rpt11)) 2))

;--
	  dis121 (distance rpt11 rpt21)
	  dis141 (distance rpt11 rpt41));setq
;----- Chia truong hop cao va dai
(if (> dis121 dis141)		  
	  (command "ALIGN" khungten "" kmid41 mid141 kmid23 mid231 "" "Y" "");T
	  (command "ALIGN" khungten "" kmid34 mid341 kmid12 mid121 "" "Y" "");F
) ;if
;-----	
(command "ERASE" el2 "");xoa hcn
(command "ERASE" el3 "");xoa hcn offset
(command "EXPLODE" el4 "")
;---------------
(command "undo" "e")
(KetThuc)
(setvar "cmdecho" OldEcho)
(princ "\n...Done...")
(princ)
);defun

Tháng 10 12, 2010

không phải bác ạ. Cái đó e sửa theo lời bác Tue rồi mà chạy vẫn báo lỗi. Đây là đoạn líp e đã sửa.

(defun BatDau() (setq OldOs (getvar "osmode")) (setvar "osmode" 0))

(defun KetThuc() (setvar "osmode" OldOs)(princ))

;=========== Lap Khung Ten ===========;

;====================================;
(defun c:khung (/ dis121 dis141 rpt11 rpt21 rpt31 rpt41 mid121 mid231 mid341 mid411 off_set bn bp 
ssbv kmid12 kmid23 kmid34 kmid41 sel entkt Rec Rec1 pt1 pt2 rpt1 rpt2 rpt3 rpt4 mid12 mid23 
mid34 mid41 dis12 dis14 dis toadodinh khoangcach i el1 el2 el3 el4 ssd en OldOs OldEcho )
(vl-load-com)
(setq OldEcho (getvar "cmdecho")) 
(setvar "cmdecho" 0)
(command "undo" "be")
(princ "\n       © nguyentuyen6 @CadViet ")
(princ "\n Cai Express-Tools truoc khi su dung!!!")
;====================;
;;;XU LY KHUNG TEN;;;;
;====================;
(setq sel (entsel "\nChon block khung ten: "))
(setq entkt (car sel))
;(setq khungten (ssget "\nChon khung ten: "))
(setq Rec (acet-ent-geomextents entkt)
	  pt1 (nth 0 Rec) ;lay dinh              *-----pt2
	  pt2 (nth 1 Rec));lay dinh              | khung |
                         ;                      pt1-----*	
;-----acet-ent-geomextents:diem thap nhat trai va cao nhat phai
(BatDau)
(command "RECTANG" pt1 pt2)
(KetThuc)	
(setq el1 (entlast));el1

;-----lay dinh HCN = acet-geom-vertex-list
(setq toadodinh (acet-geom-vertex-list el1);    	  rpt4----rpt3
	  rpt1 (nth 0 toadodinh);lay dinh                  |  el1 |
	  rpt2 (nth 1 toadodinh);lay dinh                 rpt1----rpt2
	  rpt3 (nth 2 toadodinh);lay dinh 
	  rpt4 (nth 3 toadodinh);lay dinh
	  mid12 (list (/ (+ (car rpt1) (car rpt2)) 2) (/ (+ (cadr rpt1) (cadr rpt2)) 2));trung diem
	  mid23 (list (/ (+ (car rpt2) (car rpt3)) 2) (/ (+ (cadr rpt2) (cadr rpt3)) 2))
	  mid34 (list (/ (+ (car rpt3) (car rpt4)) 2) (/ (+ (cadr rpt3) (cadr rpt4)) 2))
	  mid41 (list (/ (+ (car rpt4) (car rpt1)) 2) (/ (+ (cadr rpt4) (cadr rpt1)) 2))
	  dis12 (distance rpt1 rpt2); khoang cach
	  dis14 (distance rpt1 rpt4)
);setq
;--
(setq kmid12 (polar mid12 (/ pi 2) (/ (* dis14 4) 100))
	  kmid34 (polar mid34 (/ (* pi 3) 2) (/ (* dis14 4) 100))
	  kmid23 (polar mid23 pi (/ (* dis12 20) 140))
	  kmid41 (polar mid41 0.0 (/ (* dis12 6) 140))
	  )
(command "ERASE" el1 "");xoa hcn

;====================;
;;;XU LY BAN VE;;;;
;====================;		 

 (setq bn (rtos (fix (* (getvar "CDATE") 100000)) 2 0)); block ban ve
;  (setq bp (getpoint "\nBase Point :   "))
;        bp (setq bp '(0 0 0)))
 (while (not ssbv)
        (setq ssbv (ssget "\nChon ban ve: ")))
 (command "_.BLOCK" bn kmid41 ssbv ""
          "_.INSERT" bn kmid41 1 1 0)
(setq el4 (entlast));el4    
;----
(setq Rec1 (acet-ent-geomextents el4)
  pt11 (nth 0 Rec1);lay dinh               *-----pt2
  pt21 (nth 1 Rec1));lay dinh              |  bve  |
;		  ii 0);setq                           pt1-----*	
;-----acet-ent-geomextents:diem thap nhat trai va cao nhat phai
(BatDau)
(command "RECTANG" pt11 pt21)
(KetThuc)	
(setq el2 (entlast));el2

;-----khoang cach mac dinh
(setq khoangcach (getreal "\nKhoang cach khung ten va ban ve:"))
(if (= khoangcach nil) (setq khoangcach (/ (* dis12 5) 140)))
;---
   (setq off_set (polar pt21 (/ pi 2) khoangcach))	
(command "OFFSET" el2 off_set);offset
(setq el3 (entlast));el3
;-----lay dinh HCN = acet-geom-vertex-list
(setq toadodinh1 (acet-geom-vertex-list el3);    	  rpt4----rpt3
	  rpt11 (nth 0 toadodinh1);lay dinh                  |  bve |
	  rpt21 (nth 1 toadodinh1);lay dinh                 rpt1----rpt2
	  rpt31 (nth 2 toadodinh1);lay dinh 
	  rpt41 (nth 3 toadodinh1);lay dinh
;--
;lay trung diem
         mid121 (list (/ (+ (car rpt11) (car rpt21)) 2) (/ (+ (cadr rpt11) (cadr rpt21)) 2))
	  mid231 (list (/ (+ (car rpt2) (car rpt31)) 2) (/ (+ (cadr rpt21) (cadr rpt31)) 2))
	  mid341 (list (/ (+ (car rpt3) (car rpt41)) 2) (/ (+ (cadr rpt31) (cadr rpt41)) 2))
	  mid411 (list (/ (+ (car rpt4) (car rpt11)) 2) (/ (+ (cadr rpt41) (cadr rpt11)) 2))

;--
	  dis121 (distance rpt11 rpt21)
	  dis141 (distance rpt11 rpt41));setq
;----- Chia truong hop cao va dai
(if (> dis121 dis141)		  
	  (command "ALIGN" khungten "" kmid41 mid141 kmid23 mid231 "" "Y" "");T
	  (command "ALIGN" khungten "" kmid34 mid341 kmid12 mid121 "" "Y" "");F
) ;if
;-----	
(command "ERASE" el2 "");xoa hcn
(command "ERASE" el3 "");xoa hcn offset
(command "EXPLODE" el4 "")
;---------------
(command "undo" "e")
(KetThuc)
(setvar "cmdecho" OldEcho)
(princ "\n...Done...")
(princ)
);defun

Lỗi : ; error: bad point argument

ở đây :

(while (not ssbv)

(setq ssbv (ssget "\nChon ban ve: ")))

Dò tiếp nhé bạn :cheers:

Tháng 10 12, 2010

không phải bác ạ. Cái đó e sửa theo lời bác Tue rồi mà chạy vẫn báo lỗi. Đây là đoạn líp e đã sửa.

.........

Bạn tham khảo bài của bác Bình

......................
1/- Các bác nên cố gắng trình bày cái lisp theo các dòng càng ngắn càng tốt. Điều này sẽ giúp cho việc hiển thị lisp trong khung code box gọn lại, tạo thuận lợi cho các thành viên khi tham khảo lisp. Tỷ như cái lisp của bác có những dòng code quá dài, khiến cho việc hiển thị nó trên màn hình của codebox vượt quá khổ. Khi đọc lisp phải chạy chuột qua lại rất ức chế vì có khi chỉ vì một vài dòng như vậy mà người đọc phải chạy chuột qua lại tới méo cả mồm các bác ạ.

Cũng vì lẽ này nên mình đã mạn phép bác tự edit các dòng code này thành hai hoặc ba dòng cho nó dễ đọc, mong các bác chớ giận.

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

1 vài lỗi (chữ màu đỏ)

1- (while (not ssbv)

(setq ssbv (ssget "\nChon ban ve: ")))

hàm ssget không cho phép chèn dòng nhắc như hàm Entsel

2- (setq off_set (polar pt21 (/ pi 2) khoangcach))

(command "OFFSET" el2 off_set);offset

biến off_set là tọa độ điểm

3- ;----- Chia truong hop cao va dai

(if (> dis121 dis141)

(command "ALIGN" khungten "" kmid41 mid141 kmid23 mid231 "" "Y" "");T

(command "ALIGN" khungten "" kmid34 mid341 kmid12 mid121 "" "Y" "");F

) ;if

chưa khai báo biến khungten ?

Tháng 10 12, 2010

không phải bác ạ. Cái đó e sửa theo lời bác Tue rồi mà chạy vẫn báo lỗi. Đây là đoạn líp e đã sửa.

(defun BatDau() (setq OldOs (getvar "osmode")) (setvar "osmode" 0))

(defun KetThuc() (setvar "osmode" OldOs)(princ))

;=========== Lap Khung Ten ===========;

;====================================;
(defun c:khung (/ dis121 dis141 rpt11 rpt21 rpt31 rpt41 mid121 mid231 mid341 mid411 off_set bn bp 
ssbv kmid12 kmid23 kmid34 kmid41 sel entkt Rec Rec1 pt1 pt2 rpt1 rpt2 rpt3 rpt4 mid12 mid23 
mid34 mid41 dis12 dis14 dis toadodinh khoangcach i el1 el2 el3 el4 ssd en OldOs OldEcho )
(vl-load-com)
(setq OldEcho (getvar "cmdecho")) 
(setvar "cmdecho" 0)
(command "undo" "be")
(princ "\n       © nguyentuyen6 @CadViet ")
(princ "\n Cai Express-Tools truoc khi su dung!!!")
;====================;
;;;XU LY KHUNG TEN;;;;
;====================;
(setq sel (entsel "\nChon block khung ten: "))
(setq entkt (car sel))
;(setq khungten (ssget "\nChon khung ten: "))
(setq Rec (acet-ent-geomextents entkt)
	  pt1 (nth 0 Rec) ;lay dinh              *-----pt2
	  pt2 (nth 1 Rec));lay dinh              | khung |
                         ;                      pt1-----*	
;-----acet-ent-geomextents:diem thap nhat trai va cao nhat phai
(BatDau)
(command "RECTANG" pt1 pt2)
(KetThuc)	
(setq el1 (entlast));el1

;-----lay dinh HCN = acet-geom-vertex-list
(setq toadodinh (acet-geom-vertex-list el1);    	  rpt4----rpt3
	  rpt1 (nth 0 toadodinh);lay dinh                  |  el1 |
	  rpt2 (nth 1 toadodinh);lay dinh                 rpt1----rpt2
	  rpt3 (nth 2 toadodinh);lay dinh 
	  rpt4 (nth 3 toadodinh);lay dinh
	  mid12 (list (/ (+ (car rpt1) (car rpt2)) 2) (/ (+ (cadr rpt1) (cadr rpt2)) 2));trung diem
	  mid23 (list (/ (+ (car rpt2) (car rpt3)) 2) (/ (+ (cadr rpt2) (cadr rpt3)) 2))
	  mid34 (list (/ (+ (car rpt3) (car rpt4)) 2) (/ (+ (cadr rpt3) (cadr rpt4)) 2))
	  mid41 (list (/ (+ (car rpt4) (car rpt1)) 2) (/ (+ (cadr rpt4) (cadr rpt1)) 2))
	  dis12 (distance rpt1 rpt2); khoang cach
	  dis14 (distance rpt1 rpt4)
);setq
;--
(setq kmid12 (polar mid12 (/ pi 2) (/ (* dis14 4) 100))
	  kmid34 (polar mid34 (/ (* pi 3) 2) (/ (* dis14 4) 100))
	  kmid23 (polar mid23 pi (/ (* dis12 20) 140))
	  kmid41 (polar mid41 0.0 (/ (* dis12 6) 140))
	  )
(command "ERASE" el1 "");xoa hcn

;====================;
;;;XU LY BAN VE;;;;
;====================;		 

 (setq bn (rtos (fix (* (getvar "CDATE") 100000)) 2 0)); block ban ve
;  (setq bp (getpoint "\nBase Point <0,0,0>:   "))
;        bp (setq bp '(0 0 0)))
 (while (not ssbv)
        (setq ssbv (ssget "\nChon ban ve: ")))
 (command "_.BLOCK" bn kmid41 ssbv ""
          "_.INSERT" bn kmid41 1 1 0)
(setq el4 (entlast));el4    
;----
(setq Rec1 (acet-ent-geomextents el4)
  pt11 (nth 0 Rec1);lay dinh               *-----pt2
  pt21 (nth 1 Rec1));lay dinh              |  bve  |
;		  ii 0);setq                           pt1-----*	
;-----acet-ent-geomextents:diem thap nhat trai va cao nhat phai
(BatDau)
(command "RECTANG" pt11 pt21)
(KetThuc)	
(setq el2 (entlast));el2

;-----khoang cach mac dinh
(setq khoangcach (getreal "\nKhoang cach khung ten va ban ve:"))
(if (= khoangcach nil) (setq khoangcach (/ (* dis12 5) 140)))
;---
   (setq off_set (polar pt21 (/ pi 2) khoangcach))	
(command "OFFSET" el2 off_set);offset
(setq el3 (entlast));el3
;-----lay dinh HCN = acet-geom-vertex-list
(setq toadodinh1 (acet-geom-vertex-list el3);    	  rpt4----rpt3
	  rpt11 (nth 0 toadodinh1);lay dinh                  |  bve |
	  rpt21 (nth 1 toadodinh1);lay dinh                 rpt1----rpt2
	  rpt31 (nth 2 toadodinh1);lay dinh 
	  rpt41 (nth 3 toadodinh1);lay dinh
;--
;lay trung diem
         mid121 (list (/ (+ (car rpt11) (car rpt21)) 2) (/ (+ (cadr rpt11) (cadr rpt21)) 2))
	  mid231 (list (/ (+ (car rpt2) (car rpt31)) 2) (/ (+ (cadr rpt21) (cadr rpt31)) 2))
	  mid341 (list (/ (+ (car rpt3) (car rpt41)) 2) (/ (+ (cadr rpt31) (cadr rpt41)) 2))
	  mid411 (list (/ (+ (car rpt4) (car rpt11)) 2) (/ (+ (cadr rpt41) (cadr rpt11)) 2))

;--
	  dis121 (distance rpt11 rpt21)
	  dis141 (distance rpt11 rpt41));setq
;----- Chia truong hop cao va dai
(if (> dis121 dis141)		  
	  (command "ALIGN" khungten "" kmid41 mid141 kmid23 mid231 "" "Y" "");T
	  (command "ALIGN" khungten "" kmid34 mid341 kmid12 mid121 "" "Y" "");F
) ;if
;-----	
(command "ERASE" el2 "");xoa hcn
(command "ERASE" el3 "");xoa hcn offset
(command "EXPLODE" el4 "")
;---------------
(command "undo" "e")
(KetThuc)
(setvar "cmdecho" OldEcho)
(princ "\n...Done...")
(princ)
);defun

Bạn viết code hoa cả mắt mới tìm thấy lỗi. Bạn sai cơ bản tại dòng này (setq ssbv (ssget "\nChon ban ve: ")) hàm ssget không có đối số

BS: Các bác port nhanh quá chưa kịp refresh xem có ai trả lời chưa.

Tháng 10 12, 2010

Xin hỏi, mình dùng lệnh mslide để tạo các slide hình ảnh, rồi dùng lisp để tạo menu hình ảnh đó, nhưng sao có nhiều slide vẫn không hiện trong menu hình ảnh (mình tạo 50 slide thì có chừng 7 slide không hiện), không biết là lỗi gì, ai biết thì tư vấn mình với, cám ơn nha.

Tháng 10 12, 2010

Cảm ơn các bác đã giúp em !!!. Đây là líp em sửa lại chạy thấy kết quả cũng tốt nhưng khổ nỗi dùng đc vài lần là lại hiện bảng báo lỗi như thế này:

FATAL ERROS: commands may not be nested more than 4 deeps

Còn đây là líp:

(defun BatDau() (setq OldOs (getvar "osmode")) (setvar "osmode" 0))

(defun KetThuc() (setvar "osmode" OldOs)(princ))

;=========== Lap Khung Ten ===========;

;====================================;
(defun c:khung (/ pt11 pt21 khungten dis121 dis141 rpt11 rpt21 rpt31 rpt41
mid121 mid231 mid341 mid411 off_set bn bp ssbv kmid12 kmid23 kmid34
kmid41 sel entkt Rec Rec1 pt1 pt2 rpt1 rpt2 rpt3 rpt4 mid12 mid23 mid34 
mid41 dis12 dis14 dis toadodinh toadodinh1 khoangcach i el1 el2 el3 el4
ssd en OldOs OldEcho )
(vl-load-com)
(setq OldEcho (getvar "cmdecho")) 
(setvar "cmdecho" 0)
(command "undo" "be")
;(princ "\n       © nguyentuyen6 @CadViet ")
(princ "\n Cai Express-Tools truoc khi su dung!!!")
;====================;
;;;XU LY KHUNG TEN;;;;
;====================;
(setq khungten (entsel "\nChon block khung ten: "))
(setq entkt (car khungten))
(setq Rec (acet-ent-geomextents entkt)
	  pt1 (nth 0 Rec) ;lay dinh
	  pt2 (nth 1 Rec))

;-----acet-ent-geomextents:diem thap nhat trai va cao nhat phai
(BatDau)
(command "RECTANG" pt1 pt2)
(KetThuc)	
(setq el1 (entlast));el1

;-----lay dinh HCN = acet-geom-vertex-list
(setq toadodinh (acet-geom-vertex-list el1)
	  rpt1 (nth 0 toadodinh);lay dinh
	  rpt2 (nth 1 toadodinh)
	  rpt3 (nth 2 toadodinh)
	  rpt4 (nth 3 toadodinh)
	  mid12 (list (/ (+ (car rpt1) (car rpt2)) 2) (/ (+ (cadr rpt1) (cadr rpt2)) 2));trung diem
	  mid23 (list (/ (+ (car rpt2) (car rpt3)) 2) (/ (+ (cadr rpt2) (cadr rpt3)) 2))
	  mid34 (list (/ (+ (car rpt3) (car rpt4)) 2) (/ (+ (cadr rpt3) (cadr rpt4)) 2))
	  mid41 (list (/ (+ (car rpt4) (car rpt1)) 2) (/ (+ (cadr rpt4) (cadr rpt1)) 2))
	  dis12 (distance rpt1 rpt2); khoang cach
	  dis14 (distance rpt1 rpt4)
);setq
;--
(setq kmid12 (polar mid12 (/ pi 2) (/ (* dis14 4) 100))
	  kmid34 (polar mid34 (/ (* pi 3) 2) (/ (* dis14 4) 100))
	  kmid23 (polar mid23 pi (/ (* dis12 20) 140))
	  kmid41 (polar mid41 0.0 (/ (* dis12 6) 140))
	  )


;====================;
;;;XU LY BAN VE;;;;
;====================;		 

 (setq bn (rtos (fix (* (getvar "CDATE") 100000)) 2 0)); block ban ve


 (while (not ssbv)
        (setq ssbv (ssget)))
 (command "_.BLOCK" bn kmid41 ssbv ""
          "_.INSERT" bn kmid41 1 1 0)
(setq el4 (entlast));el4    
;----
(setq Rec1 (acet-ent-geomextents el4)
  pt11 (nth 0 Rec1);lay dinh
  pt21 (nth 1 Rec1))

;-----acet-ent-geomextents:diem thap nhat trai va cao nhat phai
(BatDau)
(command "RECTANG" pt11 pt21)
(KetThuc)	
(setq el2 (entlast));el2

;-----khoang cach mac dinh

(setq khoangcach (/ (* dis12 15) 140))

;---
   (setq off_set (polar pt21 (/ pi 2) khoangcach))	
(command "offset" khoangcach el2 off_set "") ;offset
(setq el3 (entlast));el3
;-----lay dinh HCN = acet-geom-vertex-list
(setq toadodinh1 (acet-geom-vertex-list el3)
	  rpt11 (nth 0 toadodinh1);lay dinh
	  rpt21 (nth 1 toadodinh1)
	  rpt31 (nth 2 toadodinh1)
	  rpt41 (nth 3 toadodinh1)
;--
;lay trung diem
                 mid121 (list (/ (+ (car rpt11) (car rpt21)) 2) (/ (+ (cadr rpt11) (cadr rpt21)) 2))
	  mid231 (list (/ (+ (car rpt21) (car rpt31)) 2) (/ (+ (cadr rpt21) (cadr rpt31)) 2))
	  mid341 (list (/ (+ (car rpt31) (car rpt41)) 2) (/ (+ (cadr rpt31) (cadr rpt41)) 2))
	  mid411 (list (/ (+ (car rpt41) (car rpt11)) 2) (/ (+ (cadr rpt41) (cadr rpt11)) 2))

;--
	  dis121 (distance rpt11 rpt21)
	  dis141 (distance rpt11 rpt41));setq
;----- Chia truong hop cao va dai
(BatDau)
(if (> dis121 dis141)		  
	  (command "ALIGN" entkt "" kmid41 mid411 kmid23 mid231 "" "Y" "");T
	  (command "ALIGN" entkt "" kmid34 mid341 kmid12 mid121 "" "Y" "");F
) ;if
(KetThuc)	
;-----	
(command "ERASE" el1 "");xoa hcn
(command "ERASE" el2 "");xoa hcn
(command "ERASE" el3 "");xoa hcn offset
(command "EXPLODE" el4 "")
;---------------
(command "undo" "e")
(setvar "cmdecho" OldEcho)
(princ "\n...Done...")
(princ)
);defun

Tháng 10 12, 2010

Cảm ơn các bác đã giúp em !!!. Đây là líp em sửa lại chạy thấy kết quả cũng tốt nhưng khổ nỗi dùng đc vài lần là lại hiện bảng báo lỗi như thế này:

FATAL ERROS: commands may not be nested more than 4 deeps

Còn đây là líp:

(defun BatDau() (setq OldOs (getvar "osmode")) (setvar "osmode" 0))

(defun KetThuc() (setvar "osmode" OldOs)(princ))

;=========== Lap Khung Ten ===========;

;====================================;
(defun c:khung (/ pt11 pt21 khungten dis121 dis141 rpt11 rpt21 rpt31 rpt41
mid121 mid231 mid341 mid411 off_set bn bp ssbv kmid12 kmid23 kmid34
kmid41 sel entkt Rec Rec1 pt1 pt2 rpt1 rpt2 rpt3 rpt4 mid12 mid23 mid34 
mid41 dis12 dis14 dis toadodinh toadodinh1 khoangcach i el1 el2 el3 el4
ssd en OldOs OldEcho )
(vl-load-com)
(setq OldEcho (getvar "cmdecho")) 
(setvar "cmdecho" 0)
(command "undo" "be")
;(princ "\n       © nguyentuyen6 @CadViet ")
(princ "\n Cai Express-Tools truoc khi su dung!!!")
;====================;
;;;XU LY KHUNG TEN;;;;
;====================;
(setq khungten (entsel "\nChon block khung ten: "))
(setq entkt (car khungten))
(setq Rec (acet-ent-geomextents entkt)
	  pt1 (nth 0 Rec) ;lay dinh
	  pt2 (nth 1 Rec))

;-----acet-ent-geomextents:diem thap nhat trai va cao nhat phai
(BatDau)
(command "RECTANG" pt1 pt2)
(KetThuc)	
(setq el1 (entlast));el1

;-----lay dinh HCN = acet-geom-vertex-list
(setq toadodinh (acet-geom-vertex-list el1)
	  rpt1 (nth 0 toadodinh);lay dinh
	  rpt2 (nth 1 toadodinh)
	  rpt3 (nth 2 toadodinh)
	  rpt4 (nth 3 toadodinh)
	  mid12 (list (/ (+ (car rpt1) (car rpt2)) 2) (/ (+ (cadr rpt1) (cadr rpt2)) 2))
	  mid23 (list (/ (+ (car rpt2) (car rpt3)) 2) (/ (+ (cadr rpt2) (cadr rpt3)) 2))
	  mid34 (list (/ (+ (car rpt3) (car rpt4)) 2) (/ (+ (cadr rpt3) (cadr rpt4)) 2))
	  mid41 (list (/ (+ (car rpt4) (car rpt1)) 2) (/ (+ (cadr rpt4) (cadr rpt1)) 2))
	  dis12 (distance rpt1 rpt2); khoang cach
	  dis14 (distance rpt1 rpt4)
);setq
;--
(setq kmid12 (polar mid12 (/ pi 2) (/ (* dis14 4) 100))
	  kmid34 (polar mid34 (/ (* pi 3) 2) (/ (* dis14 4) 100))
	  kmid23 (polar mid23 pi (/ (* dis12 20) 140))
	  kmid41 (polar mid41 0.0 (/ (* dis12 6) 140))
	  )
;====================;
;;;XU LY BAN VE;;;;
;====================;		 

 (setq bn (rtos (fix (* (getvar "CDATE") 100000)) 2 0)); block ban ve
 (while (not ssbv)
        (setq ssbv (ssget)))
 (command "_.BLOCK" bn kmid41 ssbv ""
          "_.INSERT" bn kmid41 1 1 0)
(setq el4 (entlast));el4    
;----
(setq Rec1 (acet-ent-geomextents el4)
  pt11 (nth 0 Rec1);lay dinh
  pt21 (nth 1 Rec1))

;-----acet-ent-geomextents:diem thap nhat trai va cao nhat phai
(BatDau)
(command "RECTANG" pt11 pt21)
(KetThuc)	
(setq el2 (entlast));el2

;-----khoang cach mac dinh

(setq khoangcach (/ (* dis12 15) 140))

;---
   (setq off_set (polar pt21 (/ pi 2) khoangcach))	
(command "offset" khoangcach el2 off_set "") ;offset
(setq el3 (entlast));el3
;-----lay dinh HCN = acet-geom-vertex-list
(setq toadodinh1 (acet-geom-vertex-list el3)
	  rpt11 (nth 0 toadodinh1);lay dinh
	  rpt21 (nth 1 toadodinh1)
	  rpt31 (nth 2 toadodinh1)
	  rpt41 (nth 3 toadodinh1)
;--
;lay trung diem
                 mid121 (list (/ (+ (car rpt11) (car rpt21)) 2) (/ (+ (cadr rpt11) (cadr rpt21)) 2))
	  mid231 (list (/ (+ (car rpt21) (car rpt31)) 2) (/ (+ (cadr rpt21) (cadr rpt31)) 2))
	  mid341 (list (/ (+ (car rpt31) (car rpt41)) 2) (/ (+ (cadr rpt31) (cadr rpt41)) 2))
	  mid411 (list (/ (+ (car rpt41) (car rpt11)) 2) (/ (+ (cadr rpt41) (cadr rpt11)) 2))

;--
	  dis121 (distance rpt11 rpt21)
	  dis141 (distance rpt11 rpt41));setq
;----- Chia truong hop cao va dai
(BatDau)
(if (> dis121 dis141)		  
	  (command "ALIGN" entkt "" kmid41 mid411 kmid23 mid231 "" "Y" "");T
	  (command "ALIGN" entkt "" kmid34 mid341 kmid12 mid121 "" "Y" "");F
) ;if
(KetThuc)	
;-----	
(command "ERASE" el1 "");xoa hcn
(command "ERASE" el2 "");xoa hcn
(command "ERASE" el3 "");xoa hcn offset
(command "EXPLODE" el4 "")
;---------------
(command "undo" "e")
(setvar "cmdecho" OldEcho)
(princ "\n...Done...")
(princ)
);defun

Cái này lỗi do bạn sử dụng lệnh align. Mình cũng bị trường hợp này rồi. Bạn tham khảo cái nay nhé

Để viết lisp thay thế align thì:
-Chọn đối tượng.

-Chọn điểm xuất phát 1 (a), điểm đến 1 (:cheers:.

-Chọn điểm xuất phát 2 ©, điểm đến 2 (d).

-Lấy góc ac, dài ac.

-Lấy góc bd, dài bd.

Move đối tượng từ a đến b, rotate góc bằng góc bd-ac, scale tỉ lệ dài bd/ac.

và code Ironpat của mình

Cám ơn bác Duy và bác Bình. Nhờ ơn 2 bác mà lisp cua em chay ầm ầm.

(defun nhapsolieu ()
(initget 1)
(setq goc1 (getangle p01 "chon diem thu 2 theo huong hoac nhap goc: "))
(setq goc (/ (* goc1 180) pi))
(setq xulygoc (- 45 (/ goc 2)))
(setq gocra (/ (* pi xulygoc) 180))
(setq sina (sin gocra))
(setq cosa (sqrt (- 1 (expt sina 2))))
(setq tang (/ sina cosa))
(setq a (distance p2 p3))
(setq duongcheo (* a (sqrt 2)))
(setq b (/ duongcheo (* 2 tang)))
(setq anso (- b (/ duongcheo 2)))
(setq x (* anso 2))
(setq hs (+ (/ x duongcheo) 1))
)

(defun chondoituong ()
(princ "\nchon doi tuong: ")
(setq ssa (ssget))
(command ".copy" ssa "" "0,0" "0,0")
(setq ssb (ssget "l"))
(setq n (sslength ssb))
(setq i 0)
(while (< i n)
(setq n (sslength ssb))
(setq ent (ssname ssb i))
(setq name (cadr (entget ent)))
(if (equal name '(0 . "INSERT"))
(progn
(command "explode" ent)
(setq ssc (ssget "p"))
(setq n1 (sslength ssc))
(setq i1 0)
(while (< i1 n1)
(setq ent1 (ssname ssc i1))
(setq ssb (ssadd ent1 ssb))
(setq i1 (1+ i1))
)
)
)
(setq i (1+ i))
(setq n (sslength ssb))
)
)

(DEFUN stretchblock()
(batdau)  
(chondoituong)
 (setq P01 (getpoint "\nChon diem chen: "))
(delblock)
 (command "-Block" "vkc_temp1" "0,0" ssb "")
 (command "-insert" "vkc_temp1" "0,0" "" "" "")
 (setq sstt1 (entlast))
 (setq sstt (ssget "l"))
(blockrectang)
(nhapsolieu)
 (command "_.explode" sstt1)
 (setq ss0 (ssget "p"))
 (command "-block" "vkc_temp1" "y" p1 ss0 "")
 (command "line" p2 p1 "")
 (setq re (ssget "l"))
 (command "_.move" re "" p1 p01)
 (command "_.rotate" re "" p01 "45")
 (command "-insert" "vkc_temp1" "r" "45" p01 "" "")
 (setq blgoc (entlast))
 (Command "Explode" blgoc)
 (setq bl (ssget "p")) 
 (command "-Block" "vkc_temp2" P01 re "")
 (command "-Block" "vkc_temp3" P01 bl "")
 (Command "-Insert" "vkc_temp3" P01 "" hs "")  
 (setq dt1 (entlast))
 (Command "-Insert" "vkc_temp2" P01 "" hs "")  
 (Command "_.Explode" "l" "")
 (setq dt2 (entlast))
 (setq tt1 (entget dt2))
 (setq tt1 (vl-remove-if '(lambda (x) (/= 10 (car x))) tt1))
 (setq dinh11 (cdr (nth 0 tt1)))
 (setq quay (- 90 (/ (* (angle p01 dinh11) 180) pi)))
 (setq aa (distance p01 dinh11))
 (setq bb (distance p1 p2))
 (setq ab (/ bb aa))
 (command "_.rotate" dt1 "" p01 quay)
 (command ".scale" dt1 "" p01 ab)
 (command "_.erase" dt2 "")
 (command "_.explode" dt1)
(delblock)
(ketthuc)
 (princ)
)

(defun c:stb ()
(stretchblock)
)

(defun batdau ()
 (command "undo" "be")
 (setvar "cmdecho" 0)
 (setq 
    old_er *error*
    *error* myerror
 ) 
)

(defun myerror (errmsg)
(ketthuc)
(command "undo" "")
)

(defun ketthuc ()
 (setq *error* old_er)
 (setvar "cmdecho" 1)
 (command "undo" "e")
)
(defun delblock ()
(Command "-Purge" "B" "vkc_temp1" "Y" "Y")
(Command "-Purge" "B" "vkc_temp2" "Y" "Y")
(Command "-Purge" "B" "vkc_temp3" "Y" "Y")
)

(defun blockrectang ()
(while (setq e (ssname sstt 0))
(setq sstt (ssdel e sstt)
tmp (vla-getboundingbox (vlax-ename->vla-object e) 'p1 'p3)
p1 (vlax-safearray->list p1)
p3 (vlax-safearray->list p3) 
p1 (list (car p1) (cadr p1))
p3 (list (car p3) (cadr p3))
p2 (list (car p1) (cadr p3))
p4 (list (car p3) (cadr p1))
)
) 
)

Gà như mình còn viết được code này mà bon nó bán tận 27$

http://www.rayburndrafting.com/prod_desc_I...AT.html?sno=298

Đăng nhập

Hỏi về Lisp (thuật toán, ý tưởng, coding,...)

Các bài được khuyến nghị

phamthanhbinh 3.146

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ssg 1.102

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

master_worse 88

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ssg 1.102

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ndtnv 481

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

hochoaivandot 111

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

phamthanhbinh 3.146

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ssg 1.102

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

quangtvxd 1

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

gia_bach 1.549

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

nguyentuyen6 130

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Tue_NV 3.912

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

hochoaivandot 111

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

nguyentuyen6 130

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Tue_NV 3.912

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

gia_bach 1.549

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

nguyentuyen6 130

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

phamngoctukts 714

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

nguyentuyen6 130

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Tue_NV 3.912