(defun c:plvg (/ os p1 p2 p11 p22 p3)
(setq os (getvar "osmode")) 
(setq p1 (getpoint "\n Chon diem bat dau ")
p2 (getpoint p1...
>>

(defun c:plvg (/ os p1 p2 p11 p22 p3)
(setq os (getvar "osmode")) 
(setq p1 (getpoint "\n Chon diem bat dau ")
p2 (getpoint p1 "\n Chon diem thu hai "))
(setq p11 (polar p1 (* pi 0.5) 1) p22 (polar p2 0 1) p3 (inters p1 p11 p2 p22 nil))
(setvar "osmode" 0)
(vl-cmdf "pline" p1 p3 p2 "") (setvar "osmode" os) (princ))

Code nhanh cho bạn!!!

 

 

Chuẩn rồi thanks bác nhiều nhiều ^.^

<<

Download lisp

Filename: 337675_plvg.lsp

- nhoc mới thử viết bạn test thử ^^

(defun c:bongbong(/ c ss ename info text1 so num)
(setq c -1)
(prompt "Chon...
>>

- nhoc mới thử viết bạn test thử ^^

(defun c:bongbong(/ c ss ename info text1 so num)
(setq c -1)
(prompt "Chon text so: ")
 (if (setq ss (ssget '((0 . "TEXT"))))
 (progn
    (while (setq ename (ssname ss (setq c (1+ c))))
      (if (setq num (distof (cdr (assoc 1 (entget ename)))))
            num
      );if
	  (if num
	  (progn
	   (setq info (entget ename))
	   (setq text1 (distof (rtos (distof (cdr (assoc 1 info))) 2 2)))
	   (if (or (> (rem text1 0.1) 0.05) (equal (rem text1 0.1) 0.05 0.01))
	   (setq so (rtos (lamtron text1 0.1) 2 2))
	   (setq so (rtos (- text1 (rem text1 0.1)) 2 2))
	   )
	   (entmod (subst (cons 1 so) (assoc 1 info) info))
	   )
	   )
	   )
  )
 )
(princ)
)
(defun lamtron (n k / sodu)
  (setq sodu (rem n k))
  (if (/= sodu 0)
    (setq n (+ (- n sodu) k))
  )
  n
)	   

thank bác :D lisp dùng rất tốt :D 

<<

 

>>

 

http://www.cadviet.com/upfiles/5/103752_ho_1.lsp

Nhờ các anh sửa giúp em thêm lực nét của boundary = 1mm với ạ!

(defun c:HO ()
(vl-load-com)
(prompt "pick diem")  
 (COMMAND "-LAYER" "m" "Ho" "color" "5" "" "") ;;; "lw" "1" 
(command "boundary" pause "") (princ))

 

sao không đưa được code lên nhi

<<

không biết mục đích của bạn có phải tạo thêm các nút trên pline để nắn mềm bình độ không, nếu phải thì mình có đoạn code này...

>>

không biết mục đích của bạn có phải tạo thêm các nút trên pline để nắn mềm bình độ không, nếu phải thì mình có đoạn code này có thể giúp bạn được:

====================================
SUA DUONG BINH DO:
====================================
(defun C:SS (/ 	Thoi   chon3  chon  Chon1 ChonC  Chon1  ZC
 	S 	PTD	PTC   PL  PTT DongMucGoc
 	DongMucCuoi   X   Y  Z XT 	YT 	XC
 	YC 	Layer  I   D
)
 (command "_layer" "m" "SUA" "c" "2" "" "")
 (command "osmode" 512)
;(print "         		! LOAI DUONG DONG MUC PHAI LA POLYLINE MOI SUA DUOC !")
;(print "        	! De chuyen sang POLYLINE: dung ARGIC mo file VA EXPORT TO CAD !")
 (setq PTD (getpoint "\nCHON DIEM DAU TIEN XUAT PHAT TU BINH DO"))
 (command "osmode" 0)
 (setq Chon (ssget PTD))
 (setq Chon1 (ssname Chon 0))
 (setq DongMucGoc (entget Chon1))
 (setq Z (last (assoc 10 DongMucGoc)))
 (setq PL '())
 (setq X   (car PTD)
Y   (cadr PTD)
PTD (list X Y Z))
 (setq PL (append PL (list PTD)))
 (setq Layer (cdr (assoc 8 DongMucGoc)))
 (setq DongMucGoc
 (subst (cons 8 "SUA") (assoc 8 DongMucGoc) DongMucGoc)  )
 (entmod DongMucGoc)
 (setq Thoi 0)
 (setq PT1 PTD)
 (command "_layer" "m" "PLSUA" "c" "3" "" "")
 (while (= Thoi 0)
(if (= (setq PTT
(getpoint
 	"\nCHON DIEM TIEP THEO!!! bam CHUOT PHAI hoac ENTER truoc khi chon diem cuoi cung !!!")) nil)
 	(progn (setq Thoi 1)
(command "osmode" 512)) 	;end progn
 	(progn
(setq XT  (car PTT)
  	YT  (cadr PTT)
  	PTT (list XT YT Z))
(command ".pline" PT1 PTT "")
(setq PL (append PL (list PTT)))
(setq PT1 PTT)) 	; end progn
) 	; end if
 ) 	; end while
 (setq PTC (getpoint "\nCHON DIEM CUOI CUNG LOI VAO BINH DO"))
 (setq ChonC (ssget PTC))
 (setq ChonC1 (ssname ChonC 0))
 (setq DongMucCuoi (entget ChonC1))
 (setq ZC (last (assoc 10 DongMucCuoi)))
 (if (= ZC Z)
(setq X   (car PTC)
  Y   (cadr PTC)
  PTC (list X Y ZC))
(progn
 	(while (/= ZC Z)
(setq PTC
   	(getpoint
  "\nBAN DA CHON KHONG DUNG DOI TUONG BAN DAU !!! HAY CHON LAI DIEM CUOI CUNG !!!"))
(setq ChonC (ssget PTC))
(setq ChonC1 (ssname ChonC 0))
(setq DongMucCuoi (entget ChonC1))
(setq ZC (last (assoc 10 DongMucCuoi)))) 	; end while    
 	(setq X (car PTC)
Y (cadr PTC)
PTC (list X Y ZC))
) 	;end progn
 ) 	; end if
 (setq PL (append PL (list PTC)))
 (command ".pline" PT1 PTC "")
 (setq DongMucGoc
 (subst (cons 8 Layer) (assoc 8 DongMucGoc) DongMucGoc)  )
 (entmod DongMucGoc)
 (command "_layer" "m" Layer "c" "" "" "")
 (command "_break" Chon PTD PTC "")
 (setq Chon3 (ssget PTD))
 (foreach PT PL
(setq C (ssget PT))
(setq i 0)
(while (<= i (- (sslength C) 1))
 	(setq D (ssname C i))
 	(if (/= D nil)
(setq Chon3 (ssadd D Chon3))
 	) 	; end if
 	(setq i (+ i 1))
) 	; end while
 ) 	; end for PL
 (command "_select" Chon Chon3 "")
 (setq S (ssget "P"))
 (command "_pedit" "m" S "" "j" "" "")
(command "-osnap" "End,Mid,Int,Perp")
(prompt "\nDA NAN BINH DO XONG!")(PRINC))

Lisp của bạn là vẽ pline mới và xóa cái cũ đi. mục đích của mình là vẽ đường bao xung quanh điểm đo (tập hợp các point trên bản vẽ). Từ đó xây dựng mô hình tam giác và chọn đường bao cho mô hình.

<<

Hên xui :) Mình cũng chưa test được
 

(vl-load-com)
;;;--------------------------------------------------------------------
(defun _Length(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
(defun _Area(e)  (vlax-curve-getarea e))
;;;--------------------------------------------------------------------
(defun C:tcdt( / ss L S e)
(and (setq ss...
>>

Hên xui :) Mình cũng chưa test được
 

(vl-load-com)
;;;--------------------------------------------------------------------
(defun _Length(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
(defun _Area(e)  (vlax-curve-getarea e))
;;;--------------------------------------------------------------------
(defun C:tcdt( / ss L S e)
(and (setq ss (ssget  (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))
			L 0.0 S 0.0)

(while (setq e (ssname ss 0))
    (setq L (+ L (_Length e)) S (+ S (_Area e)))
    (ssdel e ss)
)
(alert (strcat "Total length = " (rtos L) " units.\nTotal Area = " (rtos S) "units.")))
)

Em có cái lisp copy array theo các tuỳ chọn rất hay. Nhưng hiện tại nó đang bị lỗi cái mục chọn Key "2". Bác pro nào sửa giúp em mục...

>>

Em có cái lisp copy array theo các tuỳ chọn rất hay. Nhưng hiện tại nó đang bị lỗi cái mục chọn Key "2". Bác pro nào sửa giúp em mục đó với ạ !

Code

;;;;;;;;;;;;;;;;;;=================== 44================
(DEFUN C:44 ()
 (Command "undo" "begin")

   )
 )
)

 

Nhắc bạn Hoàng Giang khi post code chú ý cho vào thẻ Code!

 

Mình nghĩ file của bạn sai UCS thôi. bạn chuyển về UCS World rồi dùng lệnh thử coi dc ko.

<<

 

Thật ra không phải do lsp mà là do 2 cái pline của bạn có chiều dài khác nhau dù rất nhỏ. Bạn cho luprec = 8 rồi nhấp vào từng pline...

>>

 

Thật ra không phải do lsp mà là do 2 cái pline của bạn có chiều dài khác nhau dù rất nhỏ. Bạn cho luprec = 8 rồi nhấp vào từng pline rồi ctr-1 sẽ thấy length khác nhau. Và vì vậy nên khi nhân độ dốc sẽ khác nhau (cũng do vấn đề làm tròn số) dù chỉ 1 mm.

Tôi sửa lại lsp để khử cái vụ chênh nhau 1 chút đó.

 

(defun c:ddo( / a b txt tt1 sole dd1 vt)
  (defun dxf (id v) (cdr (assoc id (entget v))))
  (defun ator (a sl) (atof (rtos a 2 sl)))
  (setq a (getpoint "\nChon diem da biet cao do: ")
       txt (car (entsel "\nText cao do tuong ung: "))
       tt1 (dxf 1 txt)
       sole (if (setq vt (vl-string-search "." tt1)) (- (strlen (substr tt1 vt)) 2) 0)
       dd1 (getreal (strcat "\nNhap do doc (+ len; - xuong) <" (rtos (if (not dd) (setq dd 0.01) dd)) ">: ")))
 (if dd1 (setq dd dd1))
 (while (setq b (getpoint a "\nChon diem can tinh cao do: "))
  (entmake (list '(0 . "TEXT") (cons 10 b) (cons 11 b) (cons 40 (dxf 40 txt)) (cons 41 (dxf 41 txt))
 (cons 8 (dxf 8 txt)) (cons 62 (if (dxf 62 txt) (dxf 62 txt) 256))
 (cons 7 (dxf 7 txt)) (cons 72 (dxf 72 txt)) (cons 73 (dxf 73 txt)) '(50 . 0)
 (cons 1 (rtos (+ (atof (dxf 1 txt)) (ator (* dd (ator (distance a b) sole)) sole)) 2 sole))))
 )
 (princ)
)

Những kiến thức chuyên sâu thế thì em không xử lý được. Lisp  anh sửa cho em dùng không bị lỗi thế rồi.

Em cảm ơn anh!

<<

Hề hề hề,

Vậy có phải tốt hơn không???

Sở dĩ bạn có kết quả như trên vì bạn chưa hiểu hết nội dung của...

>>

Hề hề hề,

Vậy có phải tốt hơn không???

Sở dĩ bạn có kết quả như trên vì bạn chưa hiểu hết nội dung của lisp mà thôi. Do lisp này viết theo yêu cầu của một người khác nên trình tữ thao tác không hoàn toàn giống như ý bạn. Tuy nhiên nó vẫn hoàn toàn có thể sử dụng cho yêu cầu của bạn nếu bạn lưu ý những điểm như sau: (điều này đã được đề cập trong topic của chủ thớt trước, bạn hãy tìm lại để đọc nhé)

1/- Khi chọn đường biên thứ nhất bạn phải chọn đúng về phía diểm bắt đầu củ đường chuẩn và đường biên thứ hai nằm về phía điểm cuối của đường kẻ chuẩn. Do trật tự chọn này của bạn chưa đúng nên các đường kẻ bon1ng (hay kẻ dốc như bạn gọ) sẽ bị hoặc là không cắt hoặc là cắt sai. Trong trường hợp đó đơn giản là bạn chỉ cần uondo và chọn lại đường biên theo thứ tự ngược lại là Ok.

2/- Khi chọn hướng kẻ bóng, thực chất điểm chọn sẽ là điểm giới hạn của các đường kẻ bóng thay cho việc chọn đường giới hạn của bạn. Vì thế khi điểm chọn của bạn nằm bên trong khung thì lisp chỉ kẻ các đường kẻ bóng tới khi đường kẻ tiếp theo sẽ nằm ngoài điểm giới hạn này, còn nếu điểm chọn của bạn nằm ngoài khung đủ lớn thì các đường kẻ bóng sẽ được kẻ vươt ra bên ngoài khung cho tới khi đạt tới điểm giớ hạn đó. (trong trường hợp này các đường kẻ nằm ngoài khung sẽ có chung độ dài như đường kẻ bóng cuối cùng trong khung). Với yêu cầu như bạn thì đơng giản chỉ là khi lisp yêu cầu chọn hướng rải đường kẻ bóng bạn chỉ cần pick một điểm bất kỳ nằm trên cái đường giớ hạn của bạn là Ok, và như vậy bạn cũng chả cần tới việc chọn đường giới hạn làm chi nữa.

3/- Yêu cầu bỏ qua bước nhập tên lớp mình đã bổ sung theo cách nếu bạn muốn bỏ qua thì khi lisp hỏi bạn cứ nhấn enter. Sở dĩ mình vẫn để bước lisp hỏi này là để nhỡ có lúc bạn lại cần đưa các dường kẻ bóng này vào một lớp riêng biệt nào đó như bạn chủ thớt trước thì có cái mà dùng.

4/- Việc các đường kẻ bóng cần phải là màu 8 mình cũng đã bổ sung vào lisp. Nhưng việc chọn chiều dày nét vẽ là 0.9 như bạn yêu cầu thì mình chưa làm. Việc này bạn có thể tự làm được với việc sử dụng lệnh change - Thickness

5/- Về trình tự thao tác nhập dữ liệu cho lisp có thể khác với cái trình tự bạn yêu cầu, nhưng mình nghĩ bạn hoàn toàn có thể thay đổi lại cho phù hợp được nên mình cũng không sửa nữa do lười và cũng không dư nhiều thời gian. Vậy mong bạn thông cảm.

 

Đây là cái lisp trước mình đã chỉnh sửa chút xíu cho phù hợp với những điều bạn yêu cầu nhưng không hoàn toàn đúng như đã giải thích ở trên. Bạn hãy dùng thử và lưu ý các điểm 1,2 ở trên xem đã trúng với cái bạn cần chưa nhé.

 

(defun c:kbg (/ e1 e2 a  a1 e  k p pd pc dis B)
(vl-load-com)
(command "undo" "be")
(command "ucs" "w")
(setq e1 (car(entsel "n Chon duong bien thu nhat"))
       e2 (car(entsel "n Chon duong bien thu hai"))
       e (car (entsel "n Chon duong ke chuan"))
       ;;; a (getreal "n Nhap khoang cach chuan: ")
       k (Getreal "n Nhap he so khoang cach: ")
       p (getpoint "n Chon huong rai duong ke bong")
       dis (distance p (vlax-curve-getClosestPointTo (vlax-ename->vla-object e) p T))
       b 0
)
(if (not a1) (setq a1 (getreal "n Nhap khoang cach chuan: ")))
(if (/= a1 nil)
(setq a a1)
(setq a 10))
(setq la (getstring t "n Nhap ten layer: "))
(if (and (/= la nil) (/= la " "))
   (progn
         (if (= (tblsearch "layer" la) nil)
             (command "layer" "m" la "c" 8 "" "")
         )
         ;;;;;(setvar "clayer" la)
         (command "change" e "" "p" "la" la "")
   )
)

(while (and (< b dis) (> a 0.01))
(command "offset" a e p "")
(setq e (entlast)
    		a (* k a)
    		b (+ b a)
    		pd (vlax-curve-getstartpoint e)
    		pc (vlax-curve-getendpoint e)
    		d1 (vlax-curve-getclosestpointto e1 pd T)
)
(if (setq p1 (acet-geom-intersectwith e e1 0))
		(command "trim"  e1 ""  pd "")
		(command "extend" e1 "" pd "")
)

(if (setq p2 (acet-geom-intersectwith e e2 0))
		(command "trim" e2 "" pc "")
		(command "extend" e2 "" pc "")
)
(command "change" e "" "p" "c" "8" "")
)
;;;(command "ucs" "p")
(command "undo" "e")
(princ)
)

 

Chúc bạn vui khi tham gia diễn đàn và mong bạn lưu ý các quy định chung của diễn đàn bạn nhé.

Cảm ơn Bác Bình rất nhiều em đã thực hiện được công việc của mình. Có gì sai sót mang Bác Bình thong cảm! thanks!!!!!

<<

(vl-load-com)
;;;--------------------------------------------------------------------
(defun _Length(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
(defun _Area(e)  (vlax-curve-getarea e))
(defun wtxt (txt p / sty d h)
(setq
    sty (getvar "textstyle")
    d (tblsearch "style" sty)
    h  (getvar "textsize")
)
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p)
        ...
>>

(vl-load-com)
;;;--------------------------------------------------------------------
(defun _Length(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
(defun _Area(e)  (vlax-curve-getarea e))
(defun wtxt (txt p / sty d h)
(setq
    sty (getvar "textstyle")
    d (tblsearch "style" sty)
    h  (getvar "textsize")
)
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p)
          (if (> h 0) (cons 40 h) (assoc 40 d)) (assoc 41 d))
)
)
;;;--------------------------------------------------------------------
(defun C:tcdt( / ss L S e)
(and (setq ss (ssget  (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))
            L 0.0 S 0.0)

(while (setq e (ssname ss 0))
    (setq L (+ L (_Length e)) S (+ S (_Area e)))
    (ssdel e ss)
)
(alert (strcat "Total length = " (rtos L) " units.\nTotal Area = " (rtos S) "units."))

     )
  (wtxt (rtos L 2 0)  (getpoint "\nPoint to write Total length : "))
  (wtxt (rtos S 2 0)  (getpoint "\nPoint to write Total Area : "))
)

Xem được chưa bạn

1. Lệnh massprop chỉ tác dụng với region hoặc 3dsolid. Trong bản vẽ của ssg, chỉ có pline kín. Muốn biết diện tích, anh bấm chọn nó, gõ MO sẽ thấy area.

 

2. Dù có "vẽ...

>>

1. Lệnh massprop chỉ tác dụng với region hoặc 3dsolid. Trong bản vẽ của ssg, chỉ có pline kín. Muốn biết diện tích, anh bấm chọn nó, gõ MO sẽ thấy area.

 

2. Dù có "vẽ theo hàm", kết quả cũng là một tập hợp rời rạc các điểm. Cái khác nhau giữa làm thủ công và dùng chương trình là anh có thể chọn số điểm lớn tuỳ ý (nhờ tốc độ xử lý nhanh) -> độ chính xác tăng lên (cũng có thể tuỳ ý) nhưng không bao giờ đạt được "độ chính xác tuyệt đối" như trong toán học lý thuyết. Ngay cả các đối tượng AutoCAD vẫn là một tập rời rạc các điểm. AutoCAD, hay bất kỳ trình CAD nào khác, cũng chỉ xử lý đến một độ chính xác nào đó theo khả năng cũng như mức độ chấp nhận được của kỹ thuật thôi.

 

3. Các hệ số hoặc số mũ trong 2 phương trình anh nêu lên không đúng theo hình biên dạng tàu trong bản vẽ anh đã post. Anh thử thay số y=23.5 vào phương trình đầu xem, kết quả nhận được là 475.xxxx chứ không phải là 27 như trên bản vẽ.

 

4. Cả 2 phương trình của anh đều có một dạng tổng quát:

 

X = k1.Y^m + k2.Y^2m

 

với k1, k2, m có thể >0 hoặc <0

 

Anh dùng lisp sau để vẽ đồ thị dạng trên, lệnh BDT (biên dạng tàu):

;;;-------------------------------------------------------
(defun ShipProfile(k1 k2 m y1 y2 n)
(setq y y1 dy (/ (- y2 y1) n))
(command "pline")
(while (<= y y2)
   (setq x (+ (* k1 (expt y m)) (* k2 (expt y (* 2 m)))))
   (command (list x y))
   (setq y (+ y dy))
)
(command "")
)
;;;-------------------------------------------------------
(defun C:BDT( / k1 k2 m y1 y2 n oldos)
;;;Ve bien dang tau theo pt: x = k1*y^m + k2*y^2*m
(if (not n0) (setq n0 100))
(setq
   k1 (getreal "\nHe so thu 1:")
   k2 (getreal "\nHe so thu 2:")
   m (getreal "\nSo mu:")
   y1 (getreal "\nGia tri Ymin:")
   y2 (getreal "\nGia tri Ymax:")
   n (getint (strcat "\nSo doan chia <" (itoa n0) ">:"))
   oldos (getvar "osmode")
)
(if (not n) (setq n n0) (setq n0 n))
(setvar "osmode" 0)
(ShipProfile k1 k2 m y1 y2 n)
(setvar "osmode" oldos)
(princ)
)
;;;-------------------------------------------------------

 

Chương trình yêu cầu nhập các hệ số và số mũ, giá trị Ymin, Ymax và số đoạn chia. Mặc định số đoạn chia ban đầu là 100 trong dấu móc nhọn (nếu chấp nhận chỉ Enter không cần nhập số). Giá trị số đoạn chia của lần chạy trước sẽ tự nhớ cho các lần chạy sau. Anh muốn tăng độ chính xác thì tăng số đoạn chia lên. Cái giá phải trả như ssg đã nói ở bài trước.

Rất cảm ơn,

-Mình đã học được thêm lệnh MO để tìm diện tích và một số lisp mình đang rất cần.

-Tất cả là tương đối theo lý thuyết Albert Einstein, và mình cũng không tham vọng gì lớn nhưng mình muốn tăng độ chính xác cao nhất có thể trong thiết kế mà khi trình làng một vấn đề nào đó theo một hướng nào đó mọi người chấp nhận được tất nhiên là trên cơ sở kỹ thuật chính thống. Về lý thuyết toán học chúng cũng tiếp tục phát triển nó cũng là tương đối cả thôi

-Đúng như ssg biểu diễn hàm, nhưng khi vẽ mình có một số điểm chế lại. Riêng về điểm y=23.5 vào phương trình vẫn là kết quả 54... là cả một chiều ngang mạng tàu và sau đó mình chia cho 2 là 27...là 1 nữa mạng tàu mà mình chưa trình bày rõ với ssg chứ không phải kết quả nhận được là 475.xxxx.

Cảm ơn ssg nhiều nhiều.

À mình muốn hỏi thêm ssg có thể giúp lập trình khi nhập các toạ độ thì có thể vẽ ra một chiếc tàu theo 2D hoặc 3D như sau không?:(tất nhiên việc này mình với ssg còn phải trao đổi nhiều).

http://www.cadviet.com/upfiles/NT06_5.dwg

<<

Lệnh XO của lisp dưới đây sẽ xoay góc nghiêng của Attribute Block về 0.

 

 

(defun c:XO(...
>>

Lệnh XO của lisp dưới đây sẽ xoay góc nghiêng của Attribute Block về 0.

 

 

(defun c:XO( / ssdt sodt index tt entdt)
(setq ssdt (ssget)
sodt (sslength ssdt)
index 0
)
(repeat sodt
(setq entdt (ssname ssdt index)
index (1+ index)
entdt (entnext entdt)
tt (entget entdt)
tt (subst (cons 50 0.0) (assoc 50 tt) tt)
)
(entmod tt)
(entupd entdt)
)
(princ)
)

Sử dụng đặc hiệu trong trường hợp block ký hiệu trục nằm nghiêng.

Sau khi sử dụng lệnh xo thì text trong att block bị lệch vị trí mọi người có biết tại sao không giúp mình với

<<

Download lisp

Filename: 408299_xo.lsp

Khuyên bạn: Trước khi đặt câu hỏi bạn nên thử tự tìm câu trả lời cho mình trước đã. ok?

Font sử dụng khi điền tọa độ cũng như khi thống kê bảng chính...

>>

Khuyên bạn: Trước khi đặt câu hỏi bạn nên thử tự tìm câu trả lời cho mình trước đã. ok?

Font sử dụng khi điền tọa độ cũng như khi thống kê bảng chính là font của textstyle đang hiện hành lúc bạn chạy lisp. không khó để nhận ra điều đó. Nếu bạn không hiển thị tốt tiếng việt trong bảng thống kê thì chuyển sang 1 textstyle khác dùng các font thuộc bảng mã TCVN3.

Về yêu cầu của bạn: mình hiểu là khi chạy lisp bạn sẽ tiến hành các bước: nhập cao text -> nhập tên mốc -> nhập chiều dài các cạnh của bảng rồi mới bắt đầu thực hiện pick truy vấn tọa độ mốc đúng không?

=> 1. quá rườm rà

=> 2. Bạn có chắc chiều dài cạnh bạn nhập không quá rộng hoặc không quá hẹp so với cao text? lisp trên đã được tính toán để text được bố trí vào bảng một cách hợp lý nhất. vì thế mình không sửa lại theo yêu cầu nhập chiều dài các cạnh của bảng nữa.

Riêng phần xuất ra file text, mình chưa bg fải làm việc với những file text chứa tọa độ điểm nên không hiểu nội dung của nó sẽ được bố trí như thế nào vì đây không fải chuyên ngành của mình. thế nên mình bó tay khoản này.

 

đây là lisp bạn có thể nhập tên mốc theo ý muốn của mình

;GHI TOA DO CAC DIEM VA THONG KE THANH BANG
----------------------------------------------
(defun C:td (/ diem PT1 PT2 PT3 tapx tapy 
	   x y xx yy h n di kc ten
	   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:")
ten (getstring "\nNhap ten diem:"))


(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 ten (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

Trong qúa trình chọn điểm chèn tọa độ điểm thường hay bị vướng vào các đường nét khác.

bạn có thể khắc phục để cho di chuyển đến vị trí thích hợp đặt điểm đó không ?

Ví dụ như mình dùng block động.

Mong ban giúp

<<

 

Thế thì phải thêm 1 điểm pick Nhoc ah :) , test nhé :

;GHI TOA DO CAC DIEM VA THONG KE THANH...
>>

 

Thế thì phải thêm 1 điểm pick Nhoc ah :) , test nhé :

;GHI TOA DO CAC DIEM VA THONG KE THANH BANG
----------------------------------------------
(defun textM (pt height string / lst) 
(setq lst (list '(0 . "TEXT") (cons 10 pt) (cons 40 height) (cons 1 string) (cons 50 0) (cons 72 4) (cons 11 pt) (cons 7 (getvar "Textstyle"))))
(entmakeX Lst)  )
(defun C:td (/ diem PT1 PT2 tapx tapy obj ss
		   x y xx yy h n di kc ten
		   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:")
	ten (getstring "\nNhap ten diem:"))
(while
  (setq diem (getpoint "\nChon cac vi tri co toa do can ghi:"))
	(setq   PT1 (getpoint diem "Nhap diem thu 2") 
		 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 ten (rtos k 2 0))
		stt (append stt (list N))	  );setq
(if (> (distance diem PT1) (* 1.8 h)) (setq PT2 (polar diem (angle diem PT1) (- (distance diem PT1) (* 1.8 h)))) (setq PT2 NIL))
  (setvar "osmode" 0)
(setq obj (textM pt1 h x)) (setq ss (entlast)) 
;(command "text" "j" "BL" PT1 h 0 x)
(setq TB (textbox (entget ss)) 
LC (car TB) RC (cadr TB) di (distance LC RC) C PT1);setq
(command "erase" ss "" "pline" diem pt2 ""
		 "circle" C (* 1.8 h))
		 (textM C h N) 
	(setvar "osmode" om)	);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 "" "line" p3 p4 "")
	   (textM p11 h "STT") ;"text" "j" "m" p11 h 0 "STT" 
	   (textM p22 h "T\U+1ECDa \U+0111\U+1ED9 X") ;"text" "j" "m" p22 h 0 "Täa ®é X"
	   (textM p33 h "T\U+1ECDa \U+0111\U+1ED9 Y") ;"text" "j" "m" p33 h 0 "Täa ®é Y"
  (while (< k n) 
	(setq xx (nth k tapx)
	  yy (nth k tapy)
	 tstt(nth k stt))
		 (textM PTD h tstt) ;"text" "j" "m" PTD h 0 tstt 
		 (textM PTX h xx) ;"text" "j" "m" PTX h 0 xx 
		 (textM PTY h yy) ;"text" "j" "m" PTY h 0 yy 
		(command "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))	);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)))	);if
(command "line" p3 PT ""
	  "line" p4 PTC ""
	  "line" L1 L11 ""
	  "line" L2 L22 "")
(setvar "osmode" om ) (setvar "cmdecho" 1)
  (command "Undo" "End")  (princ

Bản lisp này mình thấy rất hay. Nhưng khi sử dụng mình cần đổi trục tọa đội (lệnh ucs) sang vị trí khác thì các điểm nút A1,A2... bay ra khỏi vị trí vòng tròn. Bạn phụng có thể giúp mình được không! Cảm ơn bạn nhiều!

<<

Download lisp

Filename: 405252_td.lsp

8 phút trước, Doan Van Ha đã nói:

Ưu điểm là...

>>

8 phút trước, Doan Van Ha đã nói:

Ưu điểm là dù không biết tùy chọn "M" vẫn dùng được, hehe! Có lẽ chủ topic chưa sử dụng chức năng Multiple?

+ Với tùy chọn "Multyple" , em nghĩ nó cũng không nhanh hơn bình thường là bao ^^ . Chắc bằng thời gian nhấn 1 nút "Cách"  :v

+ Chắc chủ thớt này muốn bo tròn , nhưng 2 tập đối tượng này xa nhau quá. Nên mới yêu cầu vậy:

	(defun c:test ( / A B I)

	; Danh Cong - Cadviet.com

	  (setq a (ssget '((0 . "*LINE")))

	    b (ssget '((0 . "*LINE")))

	    i 0)

	  (or radianR (setq radianR 1))

	  (setq radianR (cond ((getreal (strcat "\nNhap ban kinh: < " (rtos radianR 2 2) " >:")))(radianR))) 

	  (if (= (sslength a) (sslength b))

	      (progn     (setvar "FILLETRAD" radianR)

	        (repeat (sslength a)

	        (progn     (command "FILLET" (cdr (assoc -1 (entget (ssname a i)))) (cdr (assoc -1 (entget (ssname b i)))))

	            (setq i (+ i 1)))))

	    (alert "So luong 2 ben khong bang nhau")

	    ); end if

	  (princ))

<<

Sửa lỗi trong trường hợp gọi lệnh trong hệ tọa độ của người sử dụng UCS

và bổ sung phần các điểm chọn trùng với 2 đầu mút.

>>

Sửa lỗi trong trường hợp gọi lệnh trong hệ tọa độ của người sử dụng UCS

và bổ sung phần các điểm chọn trùng với 2 đầu mút.

(defun c:brk(/ cobj ent ov pt1 pt2 tmp vl); brk -> Break Curve
 (vl-load-com)
 (command "undo" "be")
 (setq vl '("osmode" "orthomode" "cmdecho") ; Sys Var list
ov (mapcar 'getvar vl))              ; Get Old values
 (mapcar 'setvar vl '(545 0 0))
 (if (and (setq Ent (car (entsel "\nChon doi tuong can chia :")))
   (wcmatch (cdr (assoc 0 (entget ent))) "*LINE,ARC")
   (not (redraw ent 3))
   (setq pt1 (getpoint "\nDiem dau :"))
   (setq pt2 (getpoint "\nDiem cuoi :"))   )
   (progn
     (if (not (tblsearch "LTYPE" "HIDDEN2"))
(command "._linetype" "_load" "HIDDEN2" "acad.lin" ""))
     (setq cObj (vlax-ename->vla-object Ent)
    pt1 (vlax-curve-getClosestPointto cObj (trans pt1 1 0))
    pt2 (vlax-curve-getClosestPointto cObj (trans pt2 1 0)))
     (if (> (vlax-curve-getParamAtPoint cObj pt1)
     (vlax-curve-getParamAtPoint cObj pt2))
(setq tmp pt1 pt1 pt2 pt2 tmp) )      
     (command "._break" ent "_non" (trans pt2 0 1) "_non" (trans pt2 0 1))
     (if (equal pt1 (vlax-curve-getStartPoint cObj) 0.001)
(command "change" ent "" "p" "c" "8" "lt" "hidden2" "")
(progn
  (command "._break" ent "_non" (trans pt1 0 1) "_non" (trans pt1 0 1))
  (command "change" (entlast) "" "p" "c" "8" "lt" "hidden2" "")
  )
)
     (redraw ent 4)
     (mapcar 'setvar vl ov) ; reset Sys Vars
     (command "undo" "e")
     )
   (alert "Khong hop le !"))
 (princ))

 

Lísp của bạn viết rất hay. Bạn có thể viết lại cái lisp : Khi cắt các line,Pl,arc... thì layer của đoạn bị cắt là một layer mình đang chọn (Chứ không phải layer hidden2) để lisp này chủ động hơn cho mọi người dùng không?

Cảm ơn bạn.

<<

Nhờ các bác xem lại giùm đoạn lisp. Không biết lý do tại sao, biến TLE không lưu lại giá trị trong lần xuất lệnh sau?

Xin cám ơn!

(Defun c:TILE (/ TLE BCAO)
 (if (= TLE nil)
  (progn
     	(setq TLE (getreal "\nNhap ti le ban ve 1/<1.000>: "))
     	(if (= TLE nil) (setq TLE 1000.0))
);end progn
  );end if
  (setq BCAO (strcat "Ban da nhap ti le la: 1/" (rtos TLE 2 2)))
  (princ...
>>

Nhờ các bác xem lại giùm đoạn lisp. Không biết lý do tại sao, biến TLE không lưu lại giá trị trong lần xuất lệnh sau?

Xin cám ơn!

(Defun c:TILE (/ TLE BCAO)
 (if (= TLE nil)
  (progn
     	(setq TLE (getreal "\nNhap ti le ban ve 1/<1.000>: "))
     	(if (= TLE nil) (setq TLE 1000.0))
);end progn
  );end if
  (setq BCAO (strcat "Ban da nhap ti le la: 1/" (rtos TLE 2 2)))
  (princ BCAO)
(princ)
)

Xuất phát từ nhu cầu in ấn, cần phải xác định chỉ số màu của từng đối tượng để đặt nét in, tôi viết lisp này để...

>>

Xuất phát từ nhu cầu in ấn, cần phải xác định chỉ số màu của từng đối tượng để đặt nét in, tôi viết lisp này để phục vụ forum. Ai có nhu cầu thì down về dùng.

Ưu điểm của lisp này là xác định rất nhanh chỉ số màu của các đối tượng con: di mouse tới đâu thì hiện lên tới đó.

Nhược điểm: có một số hạn chế chưa khắc phục được + đang chờ mọi người test và góp ý.

;Doan Van Ha - CADViet.com - Ngay 08/05/2014.
;Chuc nang: Xac dinh nhanh mau sac cua doi tuong bang cach di chuyen chuot tren man hinh.
(defun C:HA( / rad gr code pt ent1 ent2 col)
 (vl-load-com)
 (setq rad (/ (* (getvar "Viewsize") (getvar "Pickbox")) (cadr (getvar "Screensize")))
       ent2 (entmakex (list (cons 0 "Point") (cons 10 '(0 0)))))
 (princ "\nDi chuy\U+1EC3n Mouse \U+0111\U+1EBFn t\U+1EEBng \U+0111\U+1ED1i t\U+01B0\U+1EE3ng \U+0111\U+1EC3 xem m\U+00E0u...")
 (while (and (setq gr (grread 't 15 1) code (car gr) pt (cadr gr)) (/= code 3) (/= code 25) (not (equal gr '(2 13))))
  (redraw) (entdel ent2)
  (Draw_Grvecs pt rad 3)
  (if (setq ent1 (car (nentselp pt)))
   (setq ent2 (MakeMtext (strcat "Color  " (itoa (setq col (Get_Color ent1)))) (polar pt (/ pi -4) (* 3 rad)) col))
   (setq ent2 (MakeMtext "Object ?" (polar pt (/ pi -4) (* 3 rad)) 1))))
 (redraw) (entdel ent2) (princ))
(defun *error* (msg)
 (redraw)
 (if ent2 (entdel ent2))
 (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **")))
 (princ))
(defun Get_Color (ent / col)
 (setq col (vla-get-ColorIndex (vla-get-TrueColor (vlax-ename->vla-object ent))))
 (cond
  ((= col 256) (setq col (Get_Color_Layer (cdr (assoc 8 (entget ent))))))
  ((= col 0)
   (if (setq ss (Select_SS pt rad))
    (if (= (cdr (assoc 0 (setq elst (entget (ssname ss 0))))) "DIMENSION")
     (if (not (setq col (cdr (assoc 62 elst))))
 (setq col (Get_Color_Layer (cdr (assoc 8 elst)))))))))
 col)
(defun Select_SS(pt rad / p0 p1 p2 p3)
 (setq p0 (polar pt (/ pi -2) rad) p1 (polar p0 0 rad) p2 (polar p1 (/ pi 2) (* 2 rad)) p3 (polar p2 (/ pi -1) (* 2 rad)))
 (ssget "c" p1 p3))
(defun Get_Color_Layer(name)
 (cdr (assoc 62 (entget (Tblobjname "Layer" name)))))
(defun Draw_Grvecs(pt rad col / p0 p1 p2 p3 p4)
 (setq p0 (polar pt (/ pi -2) rad) p1 (polar p0 0 rad) p2 (polar p1 (/ pi 2) (* 2 rad)) p3 (polar p2 (/ pi -1) (* 2 rad)) p4 (polar p3 (/ pi -2) (* 2 rad)))
 (grvecs (list col p1 p2 p2 p3 p3 p4 p4 p1)))
(defun MakeMtext(txt pt col) 
 (entmakex (list (cons 0 "Mtext") (cons 100 "AcDbEntity") (cons 100 "AcDbMText")
   (cons 8 "0") (cons 1 (_Text txt)) (cons 10 pt) (cons 40 (/ (getvar 'Viewsize) 40)) (cons 62 col) (cons 71 1) (cons 90 3) (cons 63 256) (cons 45 1.5))))
(defun _Text (txt)
 (strcat "{\\fTimes New Roman|b1|i0|c0|p34;" txt "}")) ;(strcat "{\\fArial|b1|i0|c0|p34;" txt "}"))
 

Hề hề hề,

Thanh bác DoanVanHa về lisp xác định màu này.

Sau khi test thử mình thấy có một vài ý kiến như sau:

1/- Mình xài CAD2004 nên khi xài lisp thì việc di chuột trên màn hình bị giật cục chứ không mịn màng như trước và rất khó chọn trúng đối tượng cần xác định. 

2/- Vị trí đối tượng được chọn (cái ô màu xanh lá) chỉ hiển thị sau khi có hiển thị màu của đối tượng và do đó nếu chọn nhầm thì chỉ có nước .... chọn lại.

3/- Thời gian để xác định màu của một đối tượng chưa .....nhanh lắm bởi với CAD2004 của mình thì mất khoảng > 3 giây, và không có việc lưu lại kết quả này,(chỉ hiển thị xong rồi lại biến mất khi chuột di chuyển. Như vậy với cái trí nhớ cà lăm của mình thì đôi khi chọn được rồi lại phải chọn lại.

 

Rất mong bác nếu có thể sẽ hoàn thiện thêm để lisp có ứng dụng thuận tiện hơn.

Chúc bác khỏe và vui.

<<

Cái này mình mạn phép chỉnh bản quyền của tác giả 1 ty để làm theo yêu cầu của bạn

Có gì pm nhé

;; free lisp from cadviet.com
(defun c:RFT (/...
>>

Cái này mình mạn phép chỉnh bản quyền của tác giả 1 ty để làm theo yêu cầu của bạn

Có gì pm nhé

;; free lisp from cadviet.com
(defun c:RFT (/ code data f h line pt pxy spc txt stt ten)
				;Read File Txt
     ;|  By : Gia Bach, gia_bach @  www.CadViet.com             |;
 (vl-load-com)
 (defun Split (str / i kitu line lst txtPhanbiet)
   (setq i 1
  txtPhanbiet
   (strcat (chr 9) (chr 32) (chr 44))
   )
   (while (< i (strlen str))
     (setq kitu (substr str i 1))
     (if (vl-string-search kitu txtPhanbiet)
(progn
  (if (null Lst)
    (setq Lst (list (substr Str 1 (- i 1))))
    (setq Lst (append Lst (list (read (substr Str 1 (- i 1))))))
  )
  (setq	Str (substr Str (+ i 1))
	i   1
  )
)
(setq i (1+ i))
     )
   )
   (setq Lst (append Lst (list Str)))
 )
 (or *h* (setq *h* 2))
 (initget 6)
 (setq	h (getdist (strcat "\nNhap chieu cao Text <" (rtos *h*) "> :")
  )
 )
 (if h
   (setq *h* h)
   (setq h *h*)
 )
 (if (setq ten (getfiled "Chon File txt" (getvar "dwgprefix") "txt" 8))
   (progn
     (or (tblsearch "layer" "Point")
  (command "-layer" "n" "Point" "")
     )
     (or (tblsearch "layer" "Sothutu")
  (command "-layer" "n" "Sothutu" "c" 3 "Sothutu" "")
     )
     (or (tblsearch "layer" "Caodo")
  (command "-layer" "n" "Caodo" "c" 4 "Caodo" "")
     )
     (or (tblsearch "layer" "Code")
  (command "-layer" "n" "Code" "c" 2 "Code" "")
     )
     (setq spc	(vla-get-ModelSpace
	  (vla-get-ActiveDocument (vlax-get-Acad-Object))
	)
     )
     (setq f (open (findfile ten) "r"))
     (while (setq Line (read-line f))
(if (wcmatch
      Line
      (strcat "*" (chr 9) "*,*" (chr 32) "*,*`" (chr 44) "*")
    )
  (progn
    (setq data (split Line)
	  code (last data)
    )
    (if	(and
	  (= (vl-list-length data) 5)
	  (setq pt (vl-remove code (cdr data)))
	  (not (vl-catch-all-error-p
		 (vl-catch-all-apply 'vlax-3d-point pt)
	       )
	  )
	)
;;;neu du lieu data co 5 bien so
      (progn
	(setq stt (car data)
	      pXY (list (car pt) (cadr pt))
	)
	(vla-put-Layer
	  (vla-addpoint spc (vlax-3d-point pXY))
	  "Point"
	)
	(vla-put-Layer
	  (setq	txt (vla-addtext
		      spc
		      stt
		      (vlax-3d-point (list 0 0 0))
		      h
		    )
	  )
	  "Sothutu"
	)
	(vla-put-Alignment txt 8)
	(vla-put-TextAlignmentPoint txt (vlax-3d-point pXY))
	(vla-put-Layer
	  (setq	txt (vla-addtext
		      spc
		      code
		      (vlax-3d-point (list 0 0 0))
		      h
		    )
	  )
	  "Code"
	)
	(vla-put-Alignment txt 6)
	(vla-put-TextAlignmentPoint
	  txt
	  (vlax-3d-point (polar pXY 0 (* 0.2 h)))
	)
	(vla-put-Layer
	  (vla-addtext spc (caddr pt) (vlax-3d-point pXY) h)
	  "Caodo"
	)
      )
      ;;het progn list data=5
;;;neu du lieu data co 4 bien so (ban co the dung ham COND hoac if de bay loi
      (progn
	(setq pt (vl-remove code (cdr data)))
	(not (vl-catch-all-error-p
	       (vl-catch-all-apply 'vlax-3d-point pt)
	     )
	)
	(setq stt (car data)
	      pXY (list (car pt) (cadr pt))
	)
	(vla-put-Layer
	  (vla-addpoint spc (vlax-3d-point pXY))
	  "Point"
	)
	(vla-put-Layer
	  (setq	txt (vla-addtext
		      spc
		      stt
		      (vlax-3d-point (list 0 0 0))
		      h
		    )
	  )
	  "Sothutu"
	)
	(vla-put-Alignment txt 8)
	(vla-put-TextAlignmentPoint txt (vlax-3d-point pXY))
	(vla-put-Layer
	  (vla-addtext spc (last data) (vlax-3d-point pXY) h)
	  "Caodo"
	)
      )
;;;het progn list=4
    )
  )
)
     )
   )
 )
 (princ)
)

Nhờ Bạn giúp mình chỉnh cách thể hiện lại trên Cad theo hệ trắc địa, X của mình hiện nay sang Y, và Y của mình hiện nay sang X.

Rất mong được sự giúp đở của Bạn

<<

Bạn viết thế này:

(defun saveVars()
  (setq userName (get_tile "username"))
  (setq userAge (atoi(get_tile "userage")))
)
 
(defun C:SAMPLE()
  (setq dcl_id (load_dialog "SAMPLE.dcl"))
  (if (not (new_dialog "SAMPLE" dcl_id))
    (progn
      (alert "The SAMPLE.DCL file could not be loaded!")
      (exit)
      )
    )
  (if userName (set_tile "username" userName))
  (if userAge (set_tile "userage" (rtos userAge)))...
>>

Bạn viết thế này:

(defun saveVars()
  (setq userName (get_tile "username"))
  (setq userAge (atoi(get_tile "userage")))
)
 
(defun C:SAMPLE()
  (setq dcl_id (load_dialog "SAMPLE.dcl"))
  (if (not (new_dialog "SAMPLE" dcl_id))
    (progn
      (alert "The SAMPLE.DCL file could not be loaded!")
      (exit)
      )
    )
  (if userName (set_tile "username" userName))
  (if userAge (set_tile "userage" (rtos userAge)))  
  (action_tile "accept" "(setq ddiag 2) (saveVars) (done_dialog)")
  (action_tile "cancel" "(setq ddiag 1) (done_dialog)")
  (start_dialog)
  (unload_dialog dcl_id)
  (if(= ddiag 1)
    (princ "\n Sample2 cancelled!")
    )
  (if(= ddiag 2)
    (progn
      (princ "\n The user pressed Okay!")
      (setq userAgebyDay (* userAge 365))
      (alert (strcat userName " is " (itoa userAgebyDay) " days old."))
      )
    )
  (princ)
)

Nếu bạn cần nó thì đây :

(defun c:gpo()
 (mapcar '+ (getpoint "\n Diem goc :") (list (getreal "\nx = ") (getreal "\ny = ")...
>>

Nếu bạn cần nó thì đây :

(defun c:gpo()
 (mapcar '+ (getpoint "\n Diem goc :") (list (getreal "\nx = ") (getreal "\ny = ") 0.0))
)

 

 

Vô cùng cảm ơn bác :D.

<<