Jump to content
InfoFile
Tác giả: duy782006
Bài viết gốc: 420580
Tên lệnh: fff
Cách dùng lệnh fillet trong lisp?
(defun c:fff (/ p d1 d2 d3 tm1 tm2)
(setq p (getpoint "\Chon diem dat:"))
(setq d1 (polar p (/ (* pi 90) 180) 1000))
(setq d2 (polar p 0 3000))
(setq d3 (polar d2 (/ (* pi 135) 180) 1000))
(command "line" p d1 "")
(setq tm1 (entlast))
(command "line" d2 d3 "")
(setq tm2 (entlast))
(setvar "FILLETRAD" 0.0)
(command "fillet" tm1 tm2 )
(princ)
)

 


Filename: 420580_fff.lsp
Tác giả: lp_hai
Bài viết gốc: 420828
Tên lệnh: test
-Chuyển tất cả Block attribute và Field sang Text
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:test(/ dt sdt ent id)
  (setq dt (ssget '((-4 . "<OR") 
		
		(0 . "TEXT")
		(0 . "MTEXT")		
		(-4 . "OR>")	
		))
	sdt (sslength dt)
	id 0	
	)
 ...
>>
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:test(/ dt sdt ent id)
  (setq dt (ssget '((-4 . "<OR") 
		
		(0 . "TEXT")
		(0 . "MTEXT")		
		(-4 . "OR>")	
		))
	sdt (sslength dt)
	id 0	
	)
  (repeat sdt
    (setq ent (ssname dt id)
	  id (1+ id))
    (a2t ent)
    (entdel ent)
    )
  (princ)
  )
;;;;;;;;;;;;;;;;;;;;;
(defun a2t(ent / lts lts2)
  (setq lts (entget ent))
  (if (= (cdr (assoc 0 lts)) "MTEXT")
    (setq lts2 (list (assoc 0 lts)(assoc 5 lts)(assoc 8 lts)(CONS 100 "AcDbEntity")(CONS 100 "AcDbMText")
		   (assoc 10 lts) (assoc 40 lts)(assoc 41 lts) (assoc 71 lts)(assoc 72 lts)(assoc 1 lts)
		   (assoc 7 lts) (assoc 210 lts) (assoc 11 lts)(assoc 42 lts)(assoc 43 lts)(assoc 50 lts)(assoc 73 lts)(assoc 44 lts)))
    (setq lts2 (list (assoc 0 lts)(assoc 40 lts)
			  (assoc 8 lts) (assoc 10 lts) (assoc 1 lts) (assoc 7 lts)))
    )
  (entmakex lts2)
  )

Với Att bạn dùng lệnh Burst, với text thì mình viết cho bạn 1 lisp, bạn quét chọn các text, có thể quét thoải mái không cần phải lựa có field hay không nhé ::


<<

Filename: 420828_test.lsp
Tác giả: duy782006
Bài viết gốc: 3924
Tên lệnh: ct
Viết Lisp theo yêu cầu

Có 2 điểm không chuẩn trong đoạn lisp trên của duy782006.

 

- Thứ nhất, vòng lặp while của bạn không có điều kiện thoát, vì vậy sẽ lặp vĩnh viễn. Bạn...

>>
Có 2 điểm không chuẩn trong đoạn lisp trên của duy782006.

 

- Thứ nhất, vòng lặp while của bạn không có điều kiện thoát, vì vậy sẽ lặp vĩnh viễn. Bạn hãy move đoạn code (setq b (getpoint "\nChon diem dat moi: ")) vào ngay sau while.

 

- Thứ hai, bạn select 2 lần, copy 2 lần đối tượng text, như vậy là thừa. Bạn hãy xóa các dòng lệnh thừa đó:

(Prompt "\nChon cac doi tuong chep theo...")

(Setq CDT (Ssget))

(command "copy" CDT "" (list xa ya) (list xb yb))

 

Như vậy, code sẽ trở thành như sau:

(Defun C:ct ( )
(prompt "\nChon Text mau.")
(setq DTD (car (entsel)))
(setq DT (entget DTD))
(setq NDT (cdr (assoc 1 DT)))
(setq a (getpoint "\nChon diem lam chuan: "))
(setq xa (car a))
(setq ya (cadr a))

(while (setq b (getpoint "\nChon diem dat moi: "))
(luuos)
(setvar "osmode" 0)
(setq xb (car :s_dead:)
(setq yb (cadr :ph34r:)

(command "copy" DTD "" (list xa ya) (list xb yb))
(setq DTDM (entlast))

(if (and (>= (ascii NDT) 48) (<= (ascii NDT) 57))
(setq NDT (itoa (+ (atoi NDT) 1)))
(setq NDT (chr (+ (ascii NDT) 1)))
)

(setq Elist (entget DTDM))
(setq Oldlist (assoc 1 Elist))
(setq Oldtext (cdr Oldlist))
(setq Oldtext (strcase Oldtext nil))
(setq Newlist (cons '1 NDT))
(setq Elist (subst Newlist Oldlist Elist))
(entmod Elist)

(traos)
)

(Princ)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun luuos ()
(setq
DUY_OSMODE (getvar "OSMODE")
DUY_AUTOSNAP (getvar "AUTOSNAP")
DUY_LAYERHH (getvar "CLAYER")
DUY_THANGXEOHH (getvar "ORTHO")
DUY_filletrad (getvar "FILLETRAD")
DUY_TEXTSTYLE (getvar "TEXTSTYLE")
)
)
(defun traos ()
(if DUY_OSMODE
(setvar "OSMODE" DUY_OSMODE)
)
(if DUY_LAYERHH
(setvar "CLAYER" DUY_LAYERHH)
)
(if DUY_THANGXEOHH
(setvar "ORTHO" DUY_THANGXEOHH)
)
(if DUY_AUTOSNAP
(setvar "AUTOSNAP" DUY_AUTOSNAP)
)
(if DUY_filletrad
(setvar "FILLETRAD" DUY_filletrad)
)
(if DUY_TEXTSTYLE
(setvar "TEXTSTYLE" DUY_TEXTSTYLE)
)
)

 

Có thể mọi người ngạc nhiên tại sao tôi lại ngồi sửa từng lỗi lisp cho các thành viên? Rất dễ hiểu thôi, tôi cũng đã từng tự học lisp như các bạn. Khi đó chưa có mạng internet, không có chương trình visual lisp, không có ai để hỏi. Nhiều khi mắc một lỗi lisp tìm cả tháng mới biết cách khắc phục. Vì vậy, tôi rất hiểu mong muốn của mọi người khi post các bài thực hành lisp lên đây. Tôi đã và sẽ sửa tiếp như thế! He he!!!

 

Cám ơn bác nhưng cái (Prompt "\nChon cac doi tuong chep theo...") là để copy các đối tượng khác mà người dùng muốn copy theo (không phải là text vừa rồi) nên không phải là thừa. Ví dụ vẽ hoàn chỉnh phần đánh trục kích thước sau đó thì copy chọn text trước rồi chọn vòng tròn sau thì sẽ được vậy mà. Vậy là sai 1 lổi thôi nghen.


<<

Filename: 3924_ct.lsp
Tác giả: dunguss3581
Bài viết gốc: 354546
Tên lệnh: dkctd
Lisp dãn cách các text đè lên nhau với khoảng cách cho trước

Hề hề hề,

Vì topic trôi đi nhanh quá nên mình không kịp xem yêu cầu của bạn. Vấn đề bạn nêu không khó và hoàn...

>>

Hề hề hề,

Vì topic trôi đi nhanh quá nên mình không kịp xem yêu cầu của bạn. Vấn đề bạn nêu không khó và hoàn toàn có thể làm được. Tuy nhiên như mình đã nói, trong khi chưa có bạn hoàn toàn vẫn có thể xài lisp cũ kèm theo thằng move sau khi chạy lisp mà. Như vậy vừa được việc vừa đỡ sốt suột bạn ạ.

Hãy chờ chút xíu, mình sẽ xem và bổ sung điều bạn cần.

 

A, đây rồi, lisp nóng......

 

 

 
;;;;;;Sap xep cac text dung theo khoang cach ngang nhap vao. Co hai lua chon: sap xep tu trai qua phai va nguoc lai
 
 
(defun c:dkctd (/ oldos p d enlst i ht cn cd ort)
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq ;;;;; p (getpoint "\n Chon diem chuan ")
        d (getreal "\n Nhap khoang cach chuan: ") )
(prompt "\n Chon nhom text can sap xep")
(setq  enlst (acet-ss-to-list (ssget (list (cons 0 "text") ))))
(while enlst
   	(command "undo" "be")
   	(setq i 0)
   	(setq enlst (vl-sort enlst '(lambda (x y) (< (caar (acet-ent-geomextents x)) (caar (acet-ent-geomextents y))))))
   	(setq ort (getstring "\n Chon huong gian text <T or P>: "))
   	(if (= (strcase ort) "T")
   	(setq p (if (or (/= (cdr (assoc 72 (entget (car enlst)))) 0) (/= (cdr (assoc 73 (entget (car enlst)))) 0))
                        (cdr (assoc 11 (entget (car enlst)))) (cdr (assoc 10 (entget (car enlst))))  )
       		cn (cdr (assoc 72 (entget (car enlst))))
       		cd (cdr (assoc 73 (entget (car enlst))))
   	)
   	(setq p (if (or (/= (cdr (assoc 72 (entget (last enlst)))) 0) (/= (cdr (assoc 73 (entget (last enlst)))) 0))
                        (cdr (assoc 11 (entget (last enlst)))) (cdr (assoc 10 (entget (last enlst))))  )
       		cn (cdr (assoc 72 (entget (last enlst))))
       		cd (cdr (assoc 73 (entget (last enlst))))
               enlst (reverse enlst)
   	)
   	)
   	(foreach en enlst
            (setq encode (entget en)
                    ht (cdr (assoc 40 encode))                  
                    encode (subst (cons 72 cn) (assoc 72 encode) encode)
                    encode (subst (cons 73 cd) (assoc 73 encode) encode)                  
     		)
     		(if (= (strcase ort) "T")
         		(setq  encode (subst (cons 11 (list (+ (car p)  (* i (+ d ht))) (caddr (assoc 11 encode)))) (assoc 11 encode) encode))
         		(setq  encode (subst (cons 11 (list (- (car p)  (* i (+ d ht))) (caddr (assoc 11 encode)))) (assoc 11 encode) encode))
     		)
     		(entmod encode)
     		(setq  i (1+ i))
        )
   	;;; (setq ans (getstring "\n Ban muon tiep tuc chinh text <Y or N> : "))
   	;;; (if (= (strcase ans) "Y")
   	;;; 	(progn
         		(prompt "\n Hay chon nhom text can sap xep tiep theo")
         		(setq enlst (acet-ss-to-list (ssget (list (cons 0 "text")))))
   	;;; 	)
   	;;; 	(setq enlst nil)
   	;;; )
        (command "undo" "e")
)
(setvar "osmode" oldos)
 
(princ)
)            

LISP RẤT HỮU ÍCH VÀ HAY NHƯNG NHỜ BÁC PHAMTHANHBINH CHỈNH GIÚP BIẾN KHOẢNG CÁCH "d" VÀ BIẾN TRÁI "t" PHẢI "p" NHẬN GIÁ TRỊ NHẬP TRƯỚC ĐÓ NẾU THỰC HIỆN NHẤN ENTER CÒN NẾU NHẬP GIÁ TRỊ KHÁC THÌ BIẾN SẼ NHẬN GIÁ TRỊ MỚI. VẬY ĐỠ MẤT NHIỀU THAO TÁC NHẬP LIỆU. OK?


<<

Filename: 354546_dkctd.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 312547
Tên lệnh: dd
Xin lisp tính độ dốc giữa 2 điểm nằm trên một đường polyline

Bạn dùng cái này.

 

(defun c:dd(/ t1 t2 pl dai eg pnt)
  (setq t1 (car (entsel "\nChon text cao do 1:"))
t2...
>>

Bạn dùng cái này.

 

(defun c:dd(/ t1 t2 pl dai eg pnt)
  (setq t1 (car (entsel "\nChon text cao do 1:"))
t2 (car (entsel "\nChon text cao do 2:"))
pl (car (entsel "\nChon polyline:"))
pnt (getpoint "\nVi tri dat text:")
eg (entget t1)
dai (vlax-curve-getDistAtParam pl (vlax-curve-getEndParam pl))
  )
  (entmake (list '(0 . "TEXT") (assoc 7 eg) (assoc 72 eg) (assoc 73 eg) (assoc 8 eg)
(assoc 40 eg) (assoc 41 eg) (cons 10 pnt) (cons 11 pnt) (cons 50 0)
(cons 1 (strcat (rtos (* 100 (/ (- (atof (cdr (assoc 1 (entget t1))))
                                (atof (cdr (assoc 1 (entget t2))))) dai)) 2 3) "%"))))
  (princ)
)

Bác Bình nói tôi không hiểu ý bác, ở đây chỉ lấy chiều dài pline thôi, không để ý đến hai đầu, vả lại text mình nhấp chọn từng cái chứ không quét. Lúc đầu cũng định quét nhưng nghĩ nhiều khi user muốn có số âm, nên nhấp chọn là tốt nhất, tuy có hoi nhiều thao tác.

Hề hề hề,

Ý của mình là các text cao độ được chọn có thể không phải là cao độ chính xác của hai điểm đầu và cuối pline mà có thể là của hai điểm nào đó trên pline ( gần hoạc xa hai điểm đầu và cuối pline ) bác ạ. Bởi vì thực tế cũng có thể có trường hợp pline rất dài nhưng chỉ cần tính độ dốc 1 đoạn của pline mà đoạn này đã được xác định bởi hai điểm có sẵn các text cao độ trên bản vẽ.


<<

Filename: 312547_dd.lsp
Tác giả: hoangkimoanh
Bài viết gốc: 305942
Tên lệnh: gb
lisp-Làm thế nào để tìm số đối tượng sinh ra bởi lệnh Boundary

 

Đầu tiên, em xin chân thành cảm ơn bác tdvn và bác Nguyen Hoanh đã trợ giúp cho em.

Lisp của bác Hoành chạy OK. Em đã vận dụng...

>>

 

Đầu tiên, em xin chân thành cảm ơn bác tdvn và bác Nguyen Hoanh đã trợ giúp cho em.

Lisp của bác Hoành chạy OK. Em đã vận dụng cái Lisp của bác vào việc tính diện tích của một hình đa giác kín và bị khoét n lỗ ở trong.

Lisp đã chạy OK. Nhưng trước khi chạy ra kết quả (hiện ra hộp thoại AutoCAD mesage) thì nó lại hiện ra hộp thoại Question, em phải ấn No. Và số lần em ấn No bằng với số đối tượng do lệnh Boundary tạo ra. Thiết nghĩ nguyên nhân này do lỗi vòng lặp mà em chưa biết lỗi do đâu bác Hoành ạ. Bác và mọi người trên diễn đàn có thể giải thích dùm Tue_NV nguyên nhân được không?

Đây là hình ảnh của hộp thoại question :

question.jpg

Còn đây là đoạn Code mà Tue_NV viết để tính tính diện tích của một hình đa giác kín và bị khoét n lỗ ở trong.

(defun c:gb()
(setq frome (entlast));; chon doi tuong cuoi cung truoc khi boundary
(command ".boundary" pause "");; boundary
(setq toe (entlast));; chon doi tuong cuoi cung sau khi boundary

(setq cur frome; khoi tao
ss (ssadd)
S 0
)
(while (not (eq cur toe));; chon cac doi tuong tu frome den toe
(setq
cur (entnext cur)
ss (ssadd cur ss))
(command "area" "S" "O" ss "" "")
(setq t (getvar "area"))
(setq S (+ S t))
)
(command "area" "A" "O" "L" "" "")
(setq t (getvar "area"))
(setq S (+ S (* t 2))) 

(alert (strcat "Area = " (rtos S 2 2)))

(Princ)
)
Cảm ơn mọi người thật nhiều

em xin lỗi vì bài viết trước, bài này của anh TUE mới đúng. em muốn khi pick vào đối tượng cần tính diện tích là hình đa giác kín bị khoét lỗ thì hiện lên đường bao màu đỏ tạm thời và xóa đi sau khi kết thúc lệnh (để mình biết nó bao có đúng không) kết quả diện tích cho mình ED vào Text có sẵn


<<

Filename: 305942_gb.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 187030
Tên lệnh: cvt3d
Xin lisp chuyển từ Text 2d sang 3d và ngược lại

Ngồi rảnh mò mẫm lại mấy cái lisp cũ và mò lại topic có trong diễn đàn thấy có nhưng không có ai trả lời nên mạo muội...

>>

Ngồi rảnh mò mẫm lại mấy cái lisp cũ và mò lại topic có trong diễn đàn thấy có nhưng không có ai trả lời nên mạo muội gửi cho bạn. Những ai cần dùng thì ô sờ kê.

Lisp chuyển text 2D sang 3D. Còn ngược lại thì dùng lệnh flattend của Cad.

(defun Diemchuan (ent)
 (setq Ma10  (cdr (assoc 10 (entget ent))))
 (setq Ma11  (cdr (assoc 11 (entget ent))))
 (setq X11 (car Ma11))
 (setq Ma71  (cdr (assoc 71 (entget ent))))
 (setq Ma72  (cdr (assoc 72 (entget ent))))
 (if (or (and (= Ma71 0) (= Ma72 0) (= X11 0))
     (and (= Ma71 0) (= Ma72 3) )
     (and (= Ma71 0) (= Ma72 5) )
 	)
Ma10
Ma11
  )

(defun C:CVT3D (/ ss item temp Tdo Caodo h Pnt )
 (command "undo" "be")
 (command "osnap" "off")
  (setq ss (ssget (list (cons 0  "TEXT"))))
 	(setq ss (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex ss))))
 	(foreach item ss
   (setq temp  (entget item))
  	(setq   Tdo (Diemchuan item ))
   	(setq  Caodo (cdr (assoc 1 temp))
       	h (cdr (assoc 40 temp))
			Pnt   (list (car Tdo)
           	(cadr Tdo)
           	(atof caodo)
         	)
	)
   (entdel item)
;;;    (command "text" Pnt h 0 Caodo)
;;;    (command "text" "J" "MC" Pnt h 0 Caodo)
   (entmake (list (cons 0 "TEXT")  (cons 1  Caodo) (cons 10 Pnt) (cons 40 h)))
 	)
 (command "undo" "end")
 (princ)

)


)

 

P/s: Ngồi thử từng kiểu justify nên làm theo cách ấy. Ai có ý kiến thì xin chỉ giáo. :mellow:

Hề hề hề,

Thực tình đọc tiếng Việt mà mình chả hiểu mô tê răng rứa chi cả??? Thế nào text 2D và thế nào là text 3D hè??? Nó khác nhau ở cái chi chi??? và tại sao lại phải chuyển đi chuyển lại cho nó .... bác học vậy????

Hề hề hề....


<<

Filename: 187030_cvt3d.lsp
Tác giả: proconeng86
Bài viết gốc: 295447
Tên lệnh: sd
lisp tính tổng số đai trong dim

Bạn dùng tạm cái này

Chú ý: đang còn hạn chế, Khi chọn nhầm các loại Dim style không phù hợp thì lisp lỗi ko chạy :D :D :D

>>

Bạn dùng tạm cái này

Chú ý: đang còn hạn chế, Khi chọn nhầm các loại Dim style không phù hợp thì lisp lỗi ko chạy :D :D :D

;; Lisp cong gia tri Dim, phuc vu tinh tong so cot dai theo y/c:
;;http://www.cadviet.com/forum/topic/102605-yeu-cau-lisp-tinh-tong-so-dai-trong-dim/
(defun c:SD (/ i tong ss ent info ds ds_name hs text_dim start end n)
;;sum dim
(setq i -1
	  tong 0)
(prompt "\n Chon Dim can tinh tong: ")
(setq ss (ssget '((0 . "DIMENSION"))))
(while (and ss (< i (1- (sslength ss))))
	(setq ent (ssname ss (setq i (1+ i)))
		  info (entget ent)
		  ds (cdr (assoc 3 info))
		  ds_name (tblobjname "dimstyle" ds)
		  hs (cdr (assoc 143 (entget ds_name)))
	)
	(cond ((= (cdr(assoc 1 info)) "") (setq n (fix (+ 0.5 (* (cdr(assoc 42 info)) hs)))))
		  (t (setq text_dim  (cdr(assoc 1 info))
				   start (vl-string-search "[" text_dim)
				   end (vl-string-search "%%C" text_dim)
				   n (atoi (substr text_dim (+ 2 start) (- end start 1)))
				   )
			)
	)
	(setq tong (+ n tong))
)
(alert (strcat "Tong cong " (itoa (1+ i)) " dim la: " (itoa tong) " dai"))
(princ)
)

Đúng là khi chọn nhầm dim khác bị lỗi, ko chạy được nhưng cám ơn bạn đã nhiệt tình giúp mình nhé


<<

Filename: 295447_sd.lsp
Tác giả: huunhantvxdts
Bài viết gốc: 360893
Tên lệnh: dopl
Lisp đo khoảng cách các điểm trên polyline

 

 

Trường hợp này không dùng hàm command được.

Bạn test thử code nhé :

(defun...
>>

 

 

Trường hợp này không dùng hàm command được.

Bạn test thử code nhé :

(defun c:dopl()
    (setq acadObj (vlax-get-acad-object))
    (setq doc (vla-get-ActiveDocument acadObj))
 
    (setq modelSpace (vla-get-ModelSpace doc))
  (setq i 0)
  (if (and (setq e (car(entsel "\n Chon Pline : "))) (setq ddat (getpoint (vlax-curve-getstartpoint e) "\nDist (Pick diem) :")))
     (progn
       (setq obj (vlax-ename->vla-object e))
       (setq dis (distance ddat (vlax-curve-getclosestpointto e ddat)))
     (Repeat (fix (vlax-curve-getEndParam e))
       (if (= 0 (vla-GetBulge obj i))
      (vla-AddDimAligned modelSpace
                    (vlax-3d-point (vlax-curve-getpointatparam e i)) (vlax-3d-point (vlax-curve-getpointatparam e (1+ i)) )
                    (vlax-3d-point (polar (vlax-curve-getpointatparam e (+ i 0.5))
                           (- (angle '(0 0 0) (vlax-curve-getFirstDeriv e (+ i 0.5))) (/ pi 2.0)) dis)
                    )
      )

          (vla-AddDimArc modelSpace (vlax-3d-point (mapcar '+ (vlax-curve-getpointatparam e (+ i 0.5)) (vlax-curve-getSecondDeriv e (+ i 0.5))))
                    (vlax-3d-point (vlax-curve-getpointatparam e i)) (vlax-3d-point (vlax-curve-getpointatparam e (1+ i)) )
                    (vlax-3d-point (polar (vlax-curve-getpointatparam e (+ i 0.5))
                           (- (angle '(0 0 0) (vlax-curve-getFirstDeriv e (+ i 0.5))) (/ pi 2.0)) dis)
                    )
      )
        );if
    (setq i (1+ i))
    );Repeat
  );progn
 );if
)

Đã ok rồi

Cám ơn Bác


<<

Filename: 360893_dopl.lsp
Tác giả: vndesperados
Bài viết gốc: 2409
Tên lệnh: dii ii
Lệnh insert block
Hay, sáng tạo!

vndesperados đã tạo ra 1 cặp lệnh. DII để insert một block chuẩn đầu tiên, sau đó dùng lệnh II để insert 1 block theo cấu hình như lệnh DII vừa...

>>
Hay, sáng tạo!

vndesperados đã tạo ra 1 cặp lệnh. DII để insert một block chuẩn đầu tiên, sau đó dùng lệnh II để insert 1 block theo cấu hình như lệnh DII vừa rồi.

Ưu điểm:

- Giúp người dùng có một cặp lệnh để hạn chế phải nhập thông tin insert nhiều khối cùng 1 tính chất.

- Giao diện tiếng Việt.

Nhược:

- Mã nguồn đóng.

 

Thật ra thì không đến mức phức tạp như chương trình của vndesperados chúng ta cũng có thể có được 2 lệnh trên. Sử dụng luôn hộp thoại insert của AutoCAD để làm thao tác insert block chuẩn. Vẫn dùng 2 lệnh DII và II như chương trình của vndesperados.

Đoạn mã của chương trình đó như sau:

(defun c:dii ()
 (command ".ddinsert" pause)
 (if (/= "*" (substr (getvar "INSNAME") 1 1))
   (setq tt	    (entget (entlast))
  cv_blname (getvar "INSNAME")
  cv_xscale (cdr (assoc 41 tt))
  cv_yscale (cdr (assoc 42 tt))
  cv_yscale (cdr (assoc 43 tt))
  cv_rotate (cdr (assoc 50 tt))
   )
   (setq 
  cv_blname (substr (getvar "INSNAME") 2)
  cv_xscale 1.0
  cv_yscale 1.0
  cv_yscale 1.0
  cv_rotate 0.0
   )
 )
 (princ)
)
(defun c:ii ()
 (if (and cv_blname cv_xscale cv_yscale cv_rotate)
   (command ".insert" cv_blname pause cv_xscale cv_yscale cv_rotate)
   (princ "\nBan phai dung lenh dii truoc khi dung lenh ii")
 )
 (princ)
)

 

 

Lâu lắm mới gặp "đối thủ" nặng ký như bác NguyenHoanh. Nói chơi thôi chứ chẳng có ý định ganh đua gì ở đây.

Cách của bác rất hay nhưng gặp trường hợp người dùng sử dụng lệnh DII rồi vẽ thêm vài cái Object bằng các lệnh khác nữa thì lệnh II của bác "nỏ làm gì được mô" (Xin lổi anh em vì nghe tiếng vợ nói mãi thành quen thế).

Còn mục đích của mình khi viết lệnh này là giữ lại thông tin của lần chèn Block cuối cùng, bạn có thể sử dụng bất kỳ lệnh gì trong ACAD rồi gọi lại DII hay II cũng được.

Anh em muốn dùng lệng DII hay II trước thì cũng được.

DXX = Dialog - XX command

Câu lệnh cho hai lệnh trước là

DME = Dialog Measure, DM=Measure

DDV = Dialog Divide, DV=Divide

Mọi người sẽ hỏi cần gì phải viết lại các lệnh này?

Câu trả lời: Các lệnh này sẽ giữ lại thông tin về lần sử dụng lệnh trước đó.

Mà thôi anh em cứ dùng qua thì sẽ thấy hiệu quả.

Còn nữa; mình không phải là dân dùng CAD nên chẳng có ý tưởng gì hay đâu. Anh em nào có ý tưởng gì thì Post lên đây cùng giải quyết nhưng mà đừng có lan man giống như cái "đọc ổ USB bằng LISP" ấy. Cái chuyện đó để HĐH nó làm. Còn mình thì tập trung giải quyết các vấn đề trong CAD thôi kẻo lung tung quá "dở thầy dở thợ" thì không giống ai...

 

Còn bây giờ vào với vợ một lát, khổ thế, tối nào không có mình xoa lưng là vợ nó ngủ không được.

"Ừ, em ơi! Anh xong rồi đây..."


<<

Filename: 2409_dii_ii.lsp
Tác giả: bach1212
Bài viết gốc: 212121
Tên lệnh: dcd
Nhờ các bác viết dùm Lisp đánh cao độ
Tue_NV chỉnh sửa lại Lisp
 (defun c:dcd(/ tlv blm blname dmo cdm cd dm cdmi dmoc bl) (setvar "attreq" 1) (setvar "cmdecho" 0) (setq oldim (getvar...
>>
Tue_NV chỉnh sửa lại Lisp
 (defun c:dcd(/ tlv blm blname dmo cdm cd dm cdmi dmoc bl) (setvar "attreq" 1) (setvar "cmdecho" 0) (setq oldim (getvar "DimZin")) (setvar "Dimzin" 0) (setq tlv (/ 1 (getreal "\n Nhap ti le ve : 1/"))) (setq bl (car(entsel "\n Pick chon Block mau / Text mau :"))) (setq blm (entget bl)) (setq dmo (getpoint "\n Pick diem moc : ")) (setq cdm (getreal "\n Nhap cao do cua diem moc \ Enter pick text cao do : ")) (if (null cdm) (setq cdm (atof (cdr(assoc 1 (entget(car (entsel "pick text cao do : "))))))) ) (if cdm (progn (if (= cdm 0) (setq cd (strcat "%%p" (rtos cdm 2 3)))) (if (> cdm 0) (setq cd (strcat "+" (rtos cdm 2 3)))) (if (< cdm 0) (setq cd (rtos cdm 2 3))) (command "copy" bl "" "_non" (cdr(assoc 10 blm)) "_non" dmo) (if (and (wcmatch (cdr(assoc 0 (entget (entlast)))) "INSERT") (= (cdr(assoc 66 (entget (entlast)))) 1)) (setq el (entget (entnext (entlast)) ))) (if (wcmatch (cdr(assoc 0 (entget (entlast)))) "TEXT") (setq el (entget (entlast))) ) (entmod (subst (cons 1 cd) (assoc 1 el) el)) (setq dmoc dmo) (while (setq dm (getpoint dmoc "\n Pick diem tiep theo :")) (if (> (cadr dm) (cadr dmo)) (setq cdmi (+ (* (- (cadr dm) (cadr dmo)) tlv) cdm) ) ) (if (<= (cadr dm) (cadr dmo)) (setq cdmi (- cdm (* (- (cadr dmo) (cadr dm)) tlv) ) ) ) (if (= cdmi 0) (setq cdi (strcat "%%p" (rtos cdmi 2 3)))) (if (> cdmi 0) (setq cdi (strcat "+" (rtos cdmi 2 3)))) (if (< cdmi 0) (setq cdi (rtos cdmi 2 3))) (command "copy" bl "" "_non" (cdr(assoc 10 blm)) "_non" dm) (if (and (wcmatch (cdr(assoc 0 (entget (entlast)))) "INSERT") (= (cdr(assoc 66 (entget (entlast)))) 1)) (setq el (entget (entnext (entlast)) ))) (if (wcmatch (cdr(assoc 0 (entget (entlast)))) "TEXT") (setq el (entget (entlast))) ) (entmod (subst (cons 1 cdi) (assoc 1 el) el)) (setq dmoc dm) ) (setvar "Dimzin" oldim) )) (princ) ) 

Có thể sử dụng với Text

E tìm mãi ko ra. Không biết dòng nào của bác Tuenv làm cho blog insert ra có giá trị đều giống blog mẫu mà không nhận cao độ. Hic... Còn phần mở rộng thêm cho text thì oki rùi.


<<

Filename: 212121_dcd.lsp
Tác giả: quang_lac
Bài viết gốc: 407924
Tên lệnh: tt
Lisp tạo viewport từ khung chọn bên model.

Tìm thấy trong máy rồi:

>>

Tìm thấy trong máy rồi:

http://www.cadviet.com/upfiles/6/141736_tachviewports.lsp

(defun c:tt (/ create-layout copy2layout sort-xy-lr acadapp acaddoc cur_tab e ent i layname ln lst lstp maxp minp obj ss ssold)

(setq acadapp (vlax-get-acad-object)

acaddoc (vla-get-ActiveDocument acadapp))

(defun create-layout (name)

(vl-catch-all-apply '(lambda () (vla-add (vla-get-layouts acaddoc) name)))

(vla-item (vla-get-layouts acaddoc) name))

(defun sort-xy-lr (ptlist delta-y)

(setq ptlist (vl-sort ptlist

'(lambda (x y)

(cond ((equal (caaar x) (caaar y) delta-y) (> (cadaar x) (cadaar y)))

((< (caaar x) (caaar y))))))))

(defun copy2layout (minp maxp layName / lobj n ss tab)

(setvar 'ctab cur_tab)

(if (setq ss (ssget "_C" minp maxp (list (cons 410 cur_tab))))

(progn (repeat (setq n (sslength ss))

(setq lobj (cons (vlax-ename->vla-object (ssname ss (setq n (1- n)))) lobj)))

(vlax-invoke acaddoc 'CopyObjects lobj (vla-get-block (vla-item (vla-get-layouts acaddoc) layName)))

(setvar 'Ctab layName)

(vla-ZoomExtents acadapp))))

;; *** MAIN ***

(vl-load-com)

(vla-startundomark acaddoc)

(if (and (setq ss (ssget (list '(0 . "VIEWPORT") (cons 410 (setq cur_tab (getvar "CTAB"))))))

(setq ln (getstring "\nTen Layout <No_>: ")))

(progn (if (eq ln "")

(setq ln "No_"))

(repeat (setq i (sslength ss))

(setq ent (ssname ss (setq i (1- i)))

obj (vlax-ename->vla-object ent))

(vla-getBoundingBox obj 'Minp 'Maxp)

(setq lstp (mapcar 'vlax-safearray->list (list Minp Maxp)))

(setq lst (cons (cons lstp ent) lst)))

(setq lst (sort-xy-lr lst 0))

(setq i 0)

(repeat (length lst)

(setq layName (strcat ln (itoa (1+ i))))

(create-layout layName)

(setvar 'Ctab layName)

(if (setq ssold (ssget "_X" (list (cons 410 layName))))

(mapcar '(lambda (e) (entdel e)) (mapcar 'cadr (ssnamex ssold))))

(copy2layout (car (car (nth i lst))) (cadr (car (nth i lst))) layName)

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

(setvar 'ctab cur_tab)

(vla-endundomark acaddoc)

(princ))

P/s: Cái của bác KangKung hình như chưa đúng yêu cầu.

 

Bác viết thêm tính năng khi tách thành các layout thì đồng thời move tất cả các viewport đó về 1 tọa độ (ví dụ tọa độ 0,0) để tiện cho việc copy tọa độ


<<

Filename: 407924_tt.lsp
Tác giả: ngochop
Bài viết gốc: 72520
Tên lệnh: chdai
LISP tính toán chiều dài đoạn thẳng
Bạn chạy thử LISP này :

(defun C:Chdai( / ss e d cdai total )
 (setq ss (ssget '((0 . "LINE")))
total 0
)
 (while (setq e (ssname ss 0))
   (setq d (entget e)
  cdai (distance...
>>
Bạn chạy thử LISP này :

(defun C:Chdai( / ss e d cdai total )
 (setq ss (ssget '((0 . "LINE")))
total 0
)
 (while (setq e (ssname ss 0))
   (setq d (entget e)
  cdai (distance (cdr(assoc 10 d)) (cdr(assoc 11 d)))
  total ( + total cdai)
  )
   (write-line (strcat "chieu dai : " (rtos cdai) ) )
   (ssdel e ss)
   )
 (write-line (strcat "Tong chieu dai : " (rtos total) ) )
 (textscr)
 (princ)  
 )

Em cũng đã dùng mấy cái lisp tính chiều dài rồi, nhưng dùng cái líp này không thấy kết quả đâu vậy , em dùng cad 2008, mong các bác xem lại


<<

Filename: 72520_chdai.lsp
Tác giả: gia_bach
Bài viết gốc: 109315
Tên lệnh: rt
Ứng dụng REACTOR trong quản lý bản vẽ theo layer.
Cái RECTOR này rất hay và độc đáo

Cái này mình đang nghiên cứu và thấy được cái tuyệt vời của nó (nhưng chưa hiểu nó lắm)

Mình sẽ gửi cho các bạn file...

>>
Cái RECTOR này rất hay và độc đáo

Cái này mình đang nghiên cứu và thấy được cái tuyệt vời của nó (nhưng chưa hiểu nó lắm)

Mình sẽ gửi cho các bạn file Rector.lsp (lệnh tắt : RT) minh họa nhé thử tự như sau :

1. Load file RECTOR.lsp

2. Bấm kệnh RT

3. Chọn hình tròn CIRCLE thứ 1

4. Chọn hình tròn CIRCLE thứ 2 (hoặc POLYLINE) bất kỳ

5. Chương trình sẽ tạo ra cái đường thẳng (LINE) liên kết giữa dt 1 và dt 2

6. Hay 1 chỗ là khi ban di chuyển (MOVE) 1 trong 2 thằng thì cái thằng LINE sẽ tự động nối giữa 2 dt cho dù bạn di chuyển đằng trởi

 

Độc như thịt chuột là chỗ đó

 

(defun C:RT ()
................
'((:vlr-modified . ConnectFix)
       ;(:vlr-erased . ConnectKill)
............

Một vd rất hay của Bill Kramer về Reactor ?!

Bạn nghiên cứu viết thêm hàm ConnectKill khi đối tuợng bị xóa. (anh này dấu nghề?)

;(:vlr-erased . ConnectKill)

 

Độc như thịt chuột là chỗ đó

Thịt chuột mà độc á?

How about "thịt chó"?

he he, cuối tuần rồi : 2 mơ ... :(


<<

Filename: 109315_rt.lsp
Tác giả: Polyline
Bài viết gốc: 255312
Tên lệnh: ttt
Nhờ viết Lisp xác định lý trình và khoảng cách tới tim

Viết nhanh cho bạn

(defun C:ttt(/ e obj pt pt1 dis lt)

(vl-load-com)

(setq e (car (entsel "Chon...

>>

Viết nhanh cho bạn

(defun C:ttt(/ e obj pt pt1 dis lt)

(vl-load-com)

(setq e (car (entsel "Chon PL")))

(setq obj (vlax-ename->vla-object e))

(setq pt (getpoint "Pick diem"))

(setq pt1 (vlax-curve-getClosestPointTo obj pt))

(setq dis (distance pt pt1))

(setq lt (vlax-curve-getDistAtPoint obj pt1))

(alert (strcat "Ly trinh = " (rtos lt 2 2) "\nKhoach cach den tim = " (rtos dis 2 2)))

)

Đã giải quyết được yêu cầu của chủ thớt trong trường hợp đơn giản nhất, tuy nhiên, nó cần được mở rộng thêm các tính năng sau:

- Cho phép chọn điểm bất kỳ (nằm trên Pline) làm gốc, lý trình gốc có thể thay đổi được (bằng cách nhập vào).

- Cho phép chọn hướng bất kỳ để làm chiều tăng của lý trình (theo chiều hoặc ngược chiều của Pline).

- Cho phép xuất ra text trên bản vẽ (nên có hướng vuông góc với Pline tại vị trí đo lý trình).

- Cho phép tỉ lệ bất kỳ (nghĩa là lý trình bằng chiều dài Pline nhân với một hệ số tỷ lệ).

 

Cũng nhiều phết, nếu bác thể hiện nó bằng hộp thoại thì tốt quá! :)


<<

Filename: 255312_ttt.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 285877
Tên lệnh: rft
lisp phun toạ độ lên CAD

Nhờ các member ai biết chỉnh sửa giúp mình Lisp phun tọa độ từ file TXT vào trong CAD với

- File txt mình có cáu trúc...

>>

Nhờ các member ai biết chỉnh sửa giúp mình Lisp phun tọa độ từ file TXT vào trong CAD với

- File txt mình có cáu trúc STTXYZ

- Khi chạy lisp, nó không hiển thị giá trị Z

Help !

 

;; free lisp from cadviet.com

;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/20044-yeu-cau-lisp-phun-toa-do-cac-diem-tu-file-txt-vao-cad/page-3

;; 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)

 

)

Hề hề hề,

Cái này đã nói đến nhiều lần trong cái topic mà bạn down load lisp này. Hãy tìm và đọc lại, đừng bắt người khác làm  cái  việc mà chính bạn cũng không muốn.

Hãy nhớ lời khuyên của thầy thuốc, đọc kỹ hướng dẫn sử dụng trước khi dùng.


<<

Filename: 285877_rft.lsp
Tác giả: proconeng86
Bài viết gốc: 322013
Tên lệnh: dmau
sửa lisp đổi màu đối tượng

 

Viết mới sướng hơn nhiều

Code nhanh cho bạn 

 

(defun c:dmau(/ mau)
  (if (setq ss (ssget '((0...
>>

 

Viết mới sướng hơn nhiều

Code nhanh cho bạn 

 

(defun c:dmau(/ mau)
  (if (setq ss (ssget '((0 . "*TEXT,DIMENSION")))) (progn
            (setq mau (ACAD_COLORDLG 7))
            (command "._DIMOVERRIDE" "dimclrt" mau "" ss "")
        (command "._chprop" (ssget "P" '((0 . "*TEXT"))) "" "c" mau "")
  ))
 )
(defun c:dmau(/ mau)
  (if (setq ss (ssget '((0 . "*TEXT,DIMENSION")))) (progn
(setq mau (ACAD_COLORDLG 7))     
        (command "._chprop" (ssget "P" '((0 . "*TEXT"))) "" "c" mau "")
  (command "._DIMOVERRIDE" "dimclrt" mau "" (ssget "P" '((0 . "DIMENSION"))) )
  ))
 )

 

Bạn Tue_NV siêu thật đó, li sp nhìn ngắn ghê mà dùng rất tốt, chuyển màu nhanh không bị lag. Tuy nhiên có 1 lỗi nhỏ đó là khi chuyển màu dim xong nó hiện "nil" và dòng lệnh thấy lại báo có vẻ như là lỗi mặc dù đã đổi màu thành công. Mình không hiểu vì sao, mình chụp ảnh lại đây, bạn xem lại chút nhé

Mình cám ơn

9928_loi_lisp_doi_mau_dim.jpg


<<

Filename: 322013_dmau.lsp
Tác giả: huunhantvxdts
Bài viết gốc: 318172
Tên lệnh: tty+%C2%A0
Nhờ sửa Lisp Copy Text Cad sang Excel

Cái này cũng gần giống cái trên.

 

(defun c:tty  (/ ss ss1 y xlApp xlCells row col i iPt)
  (vl-load-com)
  (setq...
>>

Cái này cũng gần giống cái trên.

 

(defun c:tty  (/ ss ss1 y xlApp xlCells row col i iPt)
  (vl-load-com)
  (setq xlApp   (vlax-get-or-create-object "Excel.Application")
            xlCells (vlax-get-property
                      (vlax-get-property
                        (vlax-get-property
                          (vlax-invoke-method
                            (vlax-get-property xlApp "Workbooks")
                            "Add") "Sheets") "Item" 1) "Cells") row 0 col 1)
  (vla-put-visible xlApp :vlax-true)
  
  (while (setq ss (ssget '((0 . "*TEXT"))))      
      (setq ss (mapcar '(lambda (x) (list (vlax-get (vlax-ename->vla-object x) 'InsertionPoint)
 (vlax-ename->vla-object x))) 
      (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))    
      (while ss
(setq  ss (vl-sort ss '(lambda (x y) (> (cadr (car x)) (cadr (car y)))))
      ss1 (vl-remove-if-not '(lambda (x) (equal (cadr (caar ss)) (cadr (car x)) 0.2)) ss)
      ss1 (vl-sort ss1 '(lambda (x y) (< (caar x) (caar y))))
      ss (vl-remove-if '(lambda (x) (member x ss1)) ss)
)
(foreach z ss1
          (setq iPt (car z)
y (list (vla-get-TextString (last z))  (rtos (car iPt) 2 2)  (rtos (cadr iPt) 2 2) (rtos (caddr iPt) 2 2))
 ) 
          (if (> row 65536) (setq col 5))
          (setq i -1 row (1+ row))
          (mapcar '(lambda (x) (vlax-put-property xlCells "Item" row  (+ col (setq i (1+ i))) x)) y)
)
      )
    )
  (mapcar 'vlax-release-object (list xlApp xlCells))
  (princ)
)

Bạn Tot có thể chỉnh lại cho mình xuất theo hàng không và cột được không (Bên cad thế nào xuất qua excel thế nấy, muốn xuất bảng khối lượng trong cad qua excel)


<<

Filename: 318172_tty+%C2%A0.lsp
Tác giả: lolo0011
Bài viết gốc: 209822
Tên lệnh: ha
lisp đổi layer cho các text.

Hoặc đây:

(defun C:HA()
(if (not (tblsearch "layer" "Text am")) (Command "layer" "N" "Text am" ""))
(if (not (tblsearch...
>>

Hoặc đây:

(defun C:HA()
(if (not (tblsearch "layer" "Text am")) (Command "layer" "N" "Text am" ""))
(if (not (tblsearch "layer" "Text duong")) (Command "layer" "N" "Text duong" ""))
(if (not (tblsearch "layer" "Text xh")) (Command "layer" "N" "Text xh" ""))
(princ "\nChon doi tuong...")
(setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget)))))
(initget "1 2 3") (setq kieu (getkword "\nLoai Text doi Layer <1>: "))
(if (= kieu nil) (setq kieu "1"))
(foreach ent entlst
 (cond
  ((and (= kieu "1") (> (distof (cdr (assoc 1 (entget ent)))) 0))
(entmod (subst (cons 8 "Text duong") (assoc 8 (entget ent)) (entget ent))))
  ((and (= kieu "2") (< (distof (cdr (assoc 1 (entget ent)))) 0))
(entmod (subst (cons 8 "Text am") (assoc 8 (entget ent)) (entget ent))))
  ((and (= kieu "3") (/= (distof (cdr (assoc 1 (entget ent)))) nil))
(entmod (subst (cons 8 "Text xh") (assoc 8 (entget ent)) (entget ent))))))
(princ))

he he! Hôm qua cũng vấn đề này nhưng diễn giải mãi bay giờ bạn đã hiểu ý mình và cách làm rất là Ok. Cảm ơn sự nhiệt tình của bạn van Ha; cảm ơn bạn Tue_NV nữa nhé. Mình chạy 2 lisp của 2 bạn rồi. Bạn Tue_NV hiểu nhầm ý mình lisp của bạn là đổi layer đang có. Ý của mình giống như lisp của bạn Ha ấy! hình như chọn 3 không chọn layer cho test là chữ. Chỉ được 1 và 2 thôi.Nhưng dù sao sao như vay cũng OK lắm rồi.


<<

Filename: 209822_ha.lsp
Tác giả: xaydung
Bài viết gốc: 11041
Tên lệnh: s2p
Em muốn viết một Lisp để chuyển Spline thành Pline
Mình hiểu thủ thuật của bạn, chỉ cần dùng lệnh pline như dưới đây là OK. Tuy nhiên, cách làm như vậy không hay lắm. Phải "nhờ vả" các lệnh của AutoCAD như measure, divide......
>>
Mình hiểu thủ thuật của bạn, chỉ cần dùng lệnh pline như dưới đây là OK. Tuy nhiên, cách làm như vậy không hay lắm. Phải "nhờ vả" các lệnh của AutoCAD như measure, divide... để lấy toạ độ điểm là việc làm bất đắc dĩ, khi không còn cách nào khác.

Bạn dùng thử trình sau. Tất cả các dòng code mình đều có comment. Nếu còn lơ mơ thì lật Help ra xem, thường họ có kèm ví dụ, đọc là hiểu ngay.

Cái "đinh" của chương trình dưới là dùng họ function vlax-curve-xxxx để xử lý. Cái này hay lắm, dùng cho cả line, pline, spline, circle, arc...

Về cách dùng command, bạn đọc code chắc là hiểu chứ? Bản chất của vấn đề là bạn có thể "chen ngang" các biểu thức lisp nhưng vẫn không huỷ bỏ quá trình đang thực hiện dở dang của command (giống như phương thức transparent vậy).

Có gì vướng mắc bạn cứ nêu, mình sẽ giải thích thêm.

 

(defun C:S2P( / d1 e ps pe d d2 oldos p2 ans)
;;;Convert Spline to Pline
(if (not d0) (setq d0 0.50)) ;;;Init dividual distance, global variable
(setq d1 (getreal (strcat "\nLength of 1 segment <" (rtos d0 2 2) ">:"))) ;;;Input distance
(if d1 (setq d0 d1) (setq d1 d0)) ;;;Reset or get distance
(vl-load-com) ;;;Load Visual LISP extensions before use vlax-xxxx functions
(setq
   e (car (entsel "\nSelect spline:")) ;;;Spline entity
   ps (vlax-curve-getStartPoint e) ;;;Start point
   pe (vlax-curve-getEndPoint e) ;;;End point
   d (vlax-curve-getDistAtPoint e pe) ;;;Length of spline e
   d2 d1 ;;;Init variable distance
   oldos (getvar "osmode") ;;;Save osmode
)
(setvar "osmode" 0) ;;;Disable osmode
(command "pline") ;;;Call pline command
(command ps) ;;;Start point
(while (<= d2 d) ;;;While not over end point pe
   (setq p2 (vlax-curve-getPointAtDist e d2)) ;;;Variable point at d2 = length along spline
   (command p2) ;;;Continue pline command from current point to p2
   (setq d2 (+ d2 d1)) ;;;Increment distance d2 by d1
)
(command pe) ;;;Pline command to end point pe
(command "") ;;;Finish pline command
(initget "Y N") ;;;Init key words
(setq ans (getkword "\nErase original spline <N>:")) ;;;Get answer from user
(if (= ans "Y") (command "erase" e "")) ;;;Erase spline if ans = "yes"
(setvar "osmode" oldos) ;;;Reset osmode
(princ) ;;;Silent quit
)

Anh ssg ơi,

Thế nếu đối tượng chọn không phải là spline mà là arc hay circle thì phải làm thế nào ạ?


<<

Filename: 11041_s2p.lsp

Trang 252/330

252