Jump to content
InfoFile
Tác giả: hhhhgggg
Bài viết gốc: 44415
Tên lệnh: dm
Lisp đổi màu layer ?????????
Bạn thử dùng code này xem :

(defun c:dm ()
(setq mau (getint "\nNhap mau muon doi cho Layer PLINEDIACHAT :"))
(command "-layer" "m" "PLINEDIACHAT" "color" mau ""...
>>
Bạn thử dùng code này xem :

(defun c:dm ()
(setq mau (getint "\nNhap mau muon doi cho Layer PLINEDIACHAT :"))
(command "-layer" "m" "PLINEDIACHAT" "color" mau "" "")
(princ)
)

:cheers:

Bác Tuệ à. Lisp của bác thì chạy tốt , em cảm ơn bác nhé !


<<

Filename: 44415_dm.lsp
Tác giả: tranlaogia
Bài viết gốc: 69884
Tên lệnh: ckc
LISP tự động cộng liên tiếp khoảng cách giữa các điểm bất kỳ
Xin lỗi bạn, code trên Tue_NV nhầm, xin chỉnh lại :

(defun c:ckc()
(setq po1 (getpoint "\n Pick diem A :"))
(setq po2 (getpoint po1 "\n Pick diem B :"))
(setq po3 (getpoint...
>>
Xin lỗi bạn, code trên Tue_NV nhầm, xin chỉnh lại :

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

lisp này của bác Tuệ thật hay, nhưng bác có thể sửa lisp này theo 1 vài yêu cầu giúp em được kô? Tức là khi mình chọn điểm A sau đó chọn B lấy luôn giá trị này thay thế cho 1 giá trị trên bản vẽ và tiếp tục như thế khi chọn tiếp điểm c, d... Tồng các số được không bác. cám ơn bác nhé


<<

Filename: 69884_ckc.lsp
Tác giả: ndtnv
Bài viết gốc: 103085
Tên lệnh: idd
Chuyển trục tọa độ trong Trắc địa công trình
Để chuyển trục tọa độ thì dùng lệnh

UCS 3p

sau đó chọn điểm gốc, chọn tiếp điểm thứ 2 (phuong x), enter cho chọn điểm thứ 3

dùng lệnh sau để ghi ra file...

>>
Để chuyển trục tọa độ thì dùng lệnh

UCS 3p

sau đó chọn điểm gốc, chọn tiếp điểm thứ 2 (phuong x), enter cho chọn điểm thứ 3

dùng lệnh sau để ghi ra file text

(defun C:IDD ( / b f s pt)
(if (not (setq f (open (getfiled "Data file" "" "txt" 1) "a"))) (exit))

(write-line (strcat "\n"(getstring "Ghi chu" t)"\n") f)
(while (not b)
	(if (/= "" (setq s (getstring "\nTen diem :" )	))
		(progn
		(setq pt (getpoint "Vi tri")	)
		(write-line (strcat s "\t" (rtos (car pt) 2 3) "\t" (rtos (cadr pt) 2 3)) f)
)(setq b t)
		)
	)
(close f)
)


<<

Filename: 103085_idd.lsp
Tác giả: Phiphi-
Bài viết gốc: 76018
Tên lệnh: ft
Lisp căn lề text: Left, Center, Right và Fit (giống word)
Trước đây mình có thấy trong diễn đàn đã cung cấp công cụ căn lề text theo 3 kiểu Left, Center, Right. Tuy nhiên công cụ này ko viết bằng autolisp và chỉ chạy...
>>
Trước đây mình có thấy trong diễn đàn đã cung cấp công cụ căn lề text theo 3 kiểu Left, Center, Right. Tuy nhiên công cụ này ko viết bằng autolisp và chỉ chạy được các bản cad 2004, 2005 và 2006 nên mình viết một lisp tương tự để chạy được trên tất cả các bản cad.

- Lisp yêu cầu chọn tất cả các text (Dtext va MText) cần căn lề.

- Chọn một text làm chuẩn để căn lề các text đã chọn theo text đó

- Ngoài chức năng căn lề theo 3 vị trí. Left, Center, Right thì lisp này cung cấp thêm chức năng căn lề theo kiểu Fit, - kéo dãn các dòng cho dài bằng nhau (giống word) và dài bằng text chọn làm chuẩn.

canletxt.jpg

(defun c:ft()
(command "undo" "begin")
(setq oldos (getvar "osmode"))
(setq olcol (getvar "CEColor"))
(setq olstyle (getvar "textstyle"))
(prompt "\nchon cac text can can le ...")
(setq txt (ssget '((0 . "*TEXT"))))
(setq mau (entget (car (entsel "\nChon text chuan"))))
(setq TB  (textbox mau) LC  (car TB) RC (cadr TB) di (distance LC RC) i 0)
(setq x1 (cdr(assoc 10 mau)))
(setq x2 (list (+ (car x1) (* di 0.5)) (cadr x1)))
(setq x3 (list (+ (car x1) di) (cadr x1)))
(setq canle (cond (canle) ("Left")))
(initget "Left Center Right Fit")
(setq canle (cond ((getkword (strcat "\Vi tri can le <" canle ">"))) (canle)))
(repeat (sslength txt)
(setq txt_ent (entget (ssname txt i)))
(setq txt_val (cdr(assoc 1 txt_ent)))
(setq txt_st (cdr(assoc 7 txt_ent)))
(setq txt_lay (cdr(assoc 8 txt_ent)))
(setq txt_h (cdr(assoc 40 txt_ent)))
(setq txt_fctr (cdr(assoc 41 txt_ent)))
(setq txt_clr (cdr(assoc 62 txt_ent)))
(setq y1 (cdr(assoc 10 txt_ent)))
(if (cdr(assoc 43 txt_ent)) (setq txt_fctr 1 y1 (list (car y1) (- (cadr y1) txt_h))))
(setq pt1 (list (car x1) (cadr y1)))
(setq pt2 (list (car x2) (cadr y1)))
(setq pt3 (list (car x3) (cadr y1)))
(command "-style" txt_st "" "" txt_fctr "" "" "" "" "clayer" txt_lay "color" txt_clr "osmode" 0)
(if (eq canle "Left") (command "text" pt1 txt_h 0 txt_val))
(if (eq canle "Center") (command "text" "C" pt2 txt_h 0 txt_val))
(if (eq canle "Right") (command "text" "R" pt3 txt_h 0 txt_val))
(if (eq canle "Fit") (command "text" "F" pt1 pt3 txt_h txt_val))
(setq i (+ i 1))
(command "color" "bylayer")
);repeat
(setvar "textstyle" olstyle)
(setvar "CECOLOR" olcol)
(setvar "osmode" oldos)
(command "erase" txt "")
(prompt"\n by Thaistreetz - huuthais@yahoo.com\n")
(command "undo" "end")
);defun

Hiện tại thì mình đã khá hài lòng với lisp này nếu chỉ dùng để căn lề text. Tuy nhiên mình muốn thêm cho nó chức năng giãn dòng cho đều cũng với cách nhập số liệu như trên nhưng đang mắc về thuật giải. Xin nhờ mọi người giúp mình hoàn thiện lisp này với.

 

Edit: đã fix lỗi

Bác bổ xung thêm sao cho có thể sắp xếp các Text thẳng theo hàng ngang thì perfect. Thank you.

(nhưng không phải dùng lệnh DFX trong Lisp ft_df_dfx.lsp đâu nhé) http://www.cadviet.com/forum/index.php?showtopic=13897


<<

Filename: 76018_ft.lsp
Tác giả: buiquangnam
Bài viết gốc: 86137
Tên lệnh: draw name
viết lisp thống kê bản vẽ
Đã viết xong Lisp thống kê tên các bản vẽ , nhưng ngại vấn đề bảo hành và link như ý của Nataca nên chưa post lên.

Ban chạy thử và cho ý kiến.

>>
Đã viết xong Lisp thống kê tên các bản vẽ , nhưng ngại vấn đề bảo hành và link như ý của Nataca nên chưa post lên.

Ban chạy thử và cho ý kiến.

(defun c:draw_name (/ att doc i kyhieu lst lstatt msp pt row ss tblobj ten) ;Bang ten ban ve
;;  By : Gia Bach, Copyrightゥ December 2009                   ;;
;;  Contact : gia_bach @  www.CadViet.com                     ;;
 (defun VxGetAtts (Obj)
 (mapcar
   '(lambda (Att)
      (cons (vla-get-TagString Att)
     (vla-get-TextString Att) ) )
   (vlax-invoke Obj 'GetAttributes) ))
 (if (> (atof (substr (getvar "ACADVER") 1 4)) 16.0) (progn

 (if (setq ss (ssget "_A"(list (cons 0 "INSERT")(cons 66 1)(cons 2 "KHUNG CHUAN SEICO"))))
   (progn
     (vl-load-com)
     (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))
    msp (vla-get-modelspace doc))
     (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(setq lstAtt (VxGetAtts (vlax-ename->vla-object e))
      kyhieu (cdr (assoc "DWNNO" lstAtt))
      ten (cdr (assoc "DRAWING1" lstAtt)))
(setq lst (cons (cons kyhieu ten) lst))	   )
     (setq lst (vl-sort lst '(lambda (x y) (< (car x) (car y)) ) ))
     (setq i 1
    row 2
    pt (getpoint "\nDiem dat Bang :")
    TblObj (vla-addtable msp (vlax-3d-point pt) (+ (length lst) 2) 3 15 100))
     (vla-put-vertcellmargin TblObj 4)
     (vla-SetColumnWidth TblObj 0 50)
     (mapcar '(lambda (x)(vla-setTextHeight TblObj x 5))
      (list acTitleRow acHeaderRow acDataRow)	      )
     (mapcar '(lambda (x)(vla-setAlignment TblObj x 2))
      (list acTitleRow acHeaderRow acDataRow))
     (vla-setText TblObj 0 0 "list of drawings")      
     (vla-setText TblObj 1 0 "STT")
     (vla-setText TblObj 1 1 "Ten ban e")
     (vla-setText TblObj 1 2 "Ky hieu")
     (foreach pt lst
(vla-setText TblObj row 0 (itoa i))
(vla-setText TblObj row 1 (cdr pt))
(vla-setText TblObj row 2 (car pt))
(setq row (1+ row) i (1+ i))
)
     (vlax-release-object TblObj)
     (princ)  )  )  )
 (alert "\nPhien ban Cad cua ban khong ho tro tao Bang (TABLE)")
 ))

 

 

Cảm ơn bạn nhiều. nhưng bạn làm ơn chỉ rõ cách dùng được không

thanks


<<

Filename: 86137_draw_name.lsp
Tác giả: viendinhngoc
Bài viết gốc: 298652
Tên lệnh: brk
Nhờ viết lisp chia Line hoặc Polyline thành nhiều đoạn Polyline

 

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

 

(defun c:brk(/ ent os)
  (vl-load-com)
  (defun ints (o1 o2 / l0 l)
    (setq l...
>>

 

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

 

(defun c:brk(/ ent os)
  (vl-load-com)
  (defun ints (o1 o2 / l0 l)
    (setq l (vlax-Invoke (vlax-EName->vla-Object o1) "IntersectWith" (vlax-EName->vla-Object o2) acExtendBoth)
 l0 nil)
    (while l
      (setq l0 (append l0 (list (list (car l) (cadr l) (caddr l))))
   l (cdddr l)))
    l0
  )
  (command "undo" "be") 
  (setq ent (car (entsel "\nChon Line/Polyline bi cat:"))
os (getvar 'osmode))
  (setvar 'osmode 0)
  (prompt "\nChon cac Line/Polyline de cat:")
  (mapcar '(lambda(x) (mapcar '(lambda(y) (command "break" ent y y)) (ints ent x)))
    (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "LINE,*POLYLINE")))))))
  (command "undo" "e") (setvar 'osmode os)
)

 

 

Cảm ơn lisp của bạn nhưng mình muốn là sau khi cắt nó là 1 polyline gồm nhiều polyline con ( giống kích chọn 1 poly thì chọn luôn tất cả poly ấy)


<<

Filename: 298652_brk.lsp
Tác giả: tvgtyb08
Bài viết gốc: 157408
Tên lệnh: tdpl
Lisp thêm đỉnh cho PL

Mình cũng có 1 cái đây.

-Tên lệnh. TDPL:

-Chọn pline xong thì chọn các điểm muốn tạo thêm nút.

>>

Mình cũng có 1 cái đây.

-Tên lệnh. TDPL:

-Chọn pline xong thì chọn các điểm muốn tạo thêm nút.

(Defun C:tdpl ( )   
(command "undo" "be")
(chonduong)
(chidienthem)
(taothemnut)
(while
(chidienthem)
(taothemnut)
)
(command "undo" "end")
(Princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun chidienthem ( )  
 (setq luubatdiem (getvar "osmode")) 
 (setvar "osmode" 545)
(setq diemthem (getpoint "\nDiem muon tao nut tren duong dan:"))
(setq daidendiemthem (vlax-curve-getDistAtPoint doituongt diemthem))
(cond 
     ((= daidendiemthem nil) (princ "\nDiem chon khong thuoc doi tuong muon them, chon lai:") (chidienthem))
     ((/= daidendiemthem nil)
 )
 ) 
(setvar "osmode" luubatdiem)
(Princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun chonduong ( )  
(Prompt "\nChon doi tuong duong muon them nut")
(setq doituong1 (entsel))
(while
(null doituong1)
(Prompt "\nChon doi tuong duong muon them nut")
(setq doituong1 (entsel))
)
(chonduongd)
(Princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun chonduongd ( )  
(setq doituongt (car doituong1))
(setq doituong (entget doituongt))
(Princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun taothemnut ( )  
 (setq luubatdiem (getvar "osmode"))
 (setvar "osmode" 0)
(setq sodinh (cdr (assoc 90 doituong)))
(setq Rec (acet-geom-vertex-list doituongt))
(setq ttd 0)
(setq daidendiemdinh (vlax-curve-getDistAtPoint doituongt (nth ttd Rec)))
(while (< daidendiemdinh daidendiemthem)
(setq ttd (1+ ttd))
(setq daidendiemdinh (vlax-curve-getDistAtPoint doituongt (nth ttd Rec)))
)
(command "pedit" doituongt "E")
(while (< 0 (getvar "CMDACTIVE")) 
(repeat (fix (fix (- ttd 1)))
(command "n"))
(command "I" diemthem "x" ""))
(setvar "osmode" luubatdiem)
(Princ)
(Princ)
)

 

*THeo mình xoi thì lisp của bác ket không ổn: ví dụ có pline có 2 phân đoạn khi mình chọn điểm muốn chèn nút ở phân đoạn thứ 2 thì pline mới sẽ thay đổi hình dáng do ko xét vị trí của nút muốn thêm so với các phân đoạn. Mà mình cũng ngạc nhiên là người yêu cầu lại thấy ổn khi dùng. :blush:

 

Cái của bá Duy hình như ko được đâu?

 

thử chưa?


<<

Filename: 157408_tdpl.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 320845
Tên lệnh: cdt
Nhờ viết lisp đo khoảng cách và ghi ra text có sẵn

 

- ^^ thử viết nhanh cho bạn

(defun c:cdt(/ ss ename txt edd)
(prompt "chon dim mun  lay kich thuoc:")
(while...
>>

 

- ^^ thử viết nhanh cho bạn

(defun c:cdt(/ ss ename txt edd)
(prompt "chon dim mun  lay kich thuoc:")
(while (setq ss (ssget "+.:E:S" '((0 . "DIMENSION"))))
(if ss
(progn
(setq ename (entget (ssname ss 0)))
(setq txt (rtos (cdr (assoc 42 ename)) 2 0))
(setq edd (car (entsel "\nchon text mun gan:")))
(princ "\n")
(khoi edd (list (cons 1 txt) (cons 62 1)))
)
)
(prompt "chon dim mun  lay kich thuoc:")
)
)
;=============
(defun khoi (ten lst_new / lstcu)
(setq lstcu (entget ten))
(cond
	((= (cdr (assoc 0 lstcu)) "MTEXT")
		(foreach x lst_new
			(if (= (car x) 1) (setq lstcu (subst x (assoc 1 lstcu) lstcu)) (setq lstcu (append lstcu (list x))))))
	((= (cdr (assoc 0 lstcu)) "*POLYLINE")
		(foreach x lst_new
			(if (= (car x) 10) (setq lstcu (subst x (assoc 10 lstcu) lstcu)) (setq lstcu (append lstcu (list x))))))
	
	(t (setq lstcu (append lstcu lst_new)))
)
(entmod lstcu)
)
;;;;;;;

Hề hề hề,

 Nhóc thử coi lại xem cái (setq lstcu (append lstcu (list x))) sẽ ra cái gì nếu như (assoc 62 lstcu) khác với nil  nhé.

 Trong hàm (cond .......) tại sao vẫn để điều kiện (= (cdr (assoc 0 lstcu)) "*polyline") trong khi cái  (setq edd (car (entsel " chon text mun gan"))) và tại sao lại chỉ có điều kiện (= (cdr (assoc 0 lstcu)) "mtext") mà không có text ?????


<<

Filename: 320845_cdt.lsp
Tác giả: quochuyksxd
Bài viết gốc: 204893
Tên lệnh: db
Xin lisp về đếm block

Bạn dùng thử lisp này. Lệnh DB, nó chạy y như ý bạn muốn:

 

;;;------------------------------------------------(defun...
>>

Bạn dùng thử lisp này. Lệnh DB, nó chạy y như ý bạn muốn:

 

;;;------------------------------------------------(defun ss2ent(ss / sodt index ent lstent)(setq    sodt (if ss (sslength ss) 0)    index 0)(repeat sodt    (setq        ent (ssname ss index)        index (1+ index)        lstent (cons ent lstent)    ))(reverse lstent));;;------------------------------------------------(defun C:DB( / ss Le fn f e Le Ln Bn old X Res) ;;;Dem so luong Blocks(setq    ss (ssget '((0 . "INSERT")))    Le (ss2ent ss)    fn (getfiled "Save As" "" "txt" 1)    f (open fn "w"))(foreach e Le (setq Ln (append Ln (list (cdr (assoc 2 (entget e)))))))(foreach Bn Ln    (if (setq old (assoc Bn Res))        (setq Res (subst (cons bn (1+ (cdr old))) old Res))        (setq Res (append Res (list (cons Bn 1))))    ))(princ "KET QUA:\n\n" f)(foreach X Res  (princ (strcat (car X) " = " (itoa (cdr X)) "\n") f))(close f)(startapp "notepad" fn) (princ));;;------------------------------------------------

Mình thấy lips này vẫn khá thủ công. Bạn có thể chỉnh sửa làm sao để chọn vào một block mẫu mà mình cần thống kê thì nó sẽ đếm tất cả block giống nó trên bản vẽ được không? (Ứng dung như khi cần thống kê cửa đi, cửa sổ...)


<<

Filename: 204893_db.lsp
Tác giả: proconeng86
Bài viết gốc: 322749
Tên lệnh: xx
Sắp xếp thẳng hàng

 

Bản thân ket nhiều khi muốn sắp xếp các nhóm đối tượng cho ngay ngắn theo hàng lối, thường toàn kẻ Xline để gióng (hoặc kết...

>>

 

Bản thân ket nhiều khi muốn sắp xếp các nhóm đối tượng cho ngay ngắn theo hàng lối, thường toàn kẻ Xline để gióng (hoặc kết hợp F11) rồi move. Thật kỳ lạ >"<

Trong khi đoạn code ngắn như thế này giúp tăng tốc bao nhiêu. Ý tưởng của ReachAndre trên Augi

 

P/s : Tự gióng theo khoảng cách gần nhất giữa Delta X và Delta Y nhé ^^

(defun c:xx (/ p pt d xd yd s)
(command "undo" "Mark")
(while (not (setq p (getpoint "\n\U+0110i\U+1EC3m chu\U+1EA9n :: "))))
(while
	(setq s (ssget))
		(while(not(setq pt (getpoint "\n\U+0110i\U+1EC3m gi\U+00F3ng :" p))))
		(setq 	xd (abs (- (car pt) (car p)))
				yd (abs (- (cadr pt) (cadr p)))
				d	(cond 	((> xd yd)(list (car pt) (cadr p) (caddr pt)))
							((< xd yd)(list (car p) (cadr pt) (caddr pt)))
					)
		)
		(command "_move" s "" "non" pt "non" d)
)
(command "undo" "end")
(princ)
) 

 

 

li sp này quá hay, giảm được bao nhiêu thời gian mà lại thẳng hàng,trước toàn phải chọn f8 rồi from. like mạnh :D


<<

Filename: 322749_xx.lsp
Tác giả: jangboko
Bài viết gốc: 406124
Tên lệnh: mul sum
Nhờ Chỉnh Sửa Lisp Cộng Giá Trị Text Của Vật Tư Ngành Nước

 

Sửa giùm cho bạn nè!

;; free lisp from cadviet.com
;;; this lisp was downloaded from...
>>

 

Sửa giùm cho bạn nè!

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/165286-nho-chinh-sua-lisp-cong-gia-tri-text-cua-vat-tu-nganh-nuoc/
 (defun CheckObj(e MyType) (equal (cdr (assoc 0 (entget e))) MyType))
;;;-----------------------------------------
(defun FilObj (ss1 MyType / ss2 i e)
(setq ss2 (ssadd)
i 0
)
(repeat (sslength ss1)
(setq e (ssname ss1 i)
i (1+ i)
)
(if (CheckObj e MyType)
(ssadd e ss2)
)
)
(eval ss2)
)
;;;-----------------------------------------
(defun SelData (/ OK)
(setq OK nil)
(while (not OK)
(prompt "\tChon cac text can tinh:")
(setq ss (FilObj (ssget) "TEXT"))
(if (> (sslength ss) 0)
(setq OK T)
(princ "\nDoi tuong chon khong phai text")
)
)
)
;;;-----------------------------------------
(defun WriteRes (kq / OK e data)
(setq OK nil)
(while (not OK)
(setq e (car (entsel "\tChon text ghi ket qua:")))
(if (CheckObj e "TEXT")
(setq OK T)
(princ "\nDoi tuong chon khong phai text")
)
)
(entmod (subst (cons 1 kq) (assoc 1 (setq data (entget e)))  data))
(princ)
)
 
(defun getchar(s)
(vl-list->string (vl-remove-if '(lambda(x) (<= 48 x 57)) (vl-string->list s)))
)
;;;-----------------------------------------
(defun C:MUL (/ i m e ss vt chu dv)
(SelData)
(setq i 0
m 1.0
)
(repeat (sslength ss)
(setq e (ssname ss i)
i (1+ i))
(if (setq vt (vl-string-search "- L" (strcae (setq chu (cdr (assoc 1 (entget e)))))))
(setq m (* m (atof (substr chu (+ 4 vt)))))
)
(setq dv (getchar (substr chu (+ 4 vt))))
)
(WriteRes (strcat (rtos m) dv))
)
;;;-----------------------------------------
(defun C:SUM (/ i s e ss chu vt dv)
(SelData)
(setq i 0
s 0.0
)
(repeat (sslength ss)
(setq e (ssname ss i)
i (1+ i))
(if (setq vt (vl-string-search "- L" (strcase (setq chu (cdr (assoc 1 (entget e)))))))
(setq s (+ s (atof (substr chu (+ 4 vt)))))
)
(setq dv (getchar (substr chu (+ 4 vt))))
)
(WriteRes (strcat (rtos s) dv))
)

cảm ơn bác, Lisp hoạt động tốt lắm ạ

Bác có thể chỉnh sửa nâng cao giúp em lisp này được không ạ. Bài toán là trong 1 sơ đồ không gian cấp (thoát) nước có nhiều loại đường ống, D21 - L35m, D27 -L42m, D34 - L15m,..., em muốn click đầu tiên chọn loại đường kính ống mẫu, sau đó quét toàn bộ sơ đồ, lisp sẽ chỉ cộng các ống mẫu đã được chọn. Em cảm ơn bác nhiều.


<<

Filename: 406124_mul_sum.lsp
Tác giả: PUCH
Bài viết gốc: 45603
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) ) )
 (princ)
 )

Hi!!!!!!

thanks bạn

nhưng sao mình thử hok dc

chỉ mới xong bước chọn đối tượng thui

soa đó ho k thấy có tác dụng ji hết

XIn bạn chỉ dẫn cho mình tí

thank!!!!!!!!!


<<

Filename: 45603_chdai.lsp
Tác giả: ngtiens
Bài viết gốc: 321214
Tên lệnh: ha
Đánh cos cao độ tự động

Quick code xem đúng ý không, rồi edit sau.

 

;----- Random so trong khoang tu a den b.
(defun C:HA()
 (defun...
>>

Quick code xem đúng ý không, rồi edit sau.

 

;----- Random so trong khoang tu a den b.
(defun C:HA()
 (defun rand(a b)
;  (+ a (fix (* (- b a) (atof (strcat "0." (substr (rtos (getvar 'cdate) 2 18) 16 2)))))))
  (+ a (* (- b a) (atof (strcat "0." (substr (rtos (getvar 'cdate) 2 18) 16 2))))))
 (setq a (getreal "\nSo bat dau: "))
 (setq b (getreal "\nSo gioi han: ")) 
 (while (setq p (getpoint "\nPick point: "))
  (command "text" p "" "" (rtos (rand a b) 2 2) "")))

zị chắc được rồi ạ, nhưng không bít cách sử dụng làm sao. e không rành cái vụ này lắm. bây h làm sao load được cái file vlx để sử dụng trong cad dc :(


<<

Filename: 321214_ha.lsp
Tác giả: tiennguyenxd22
Bài viết gốc: 211753
Tên lệnh: mc
lisp vẽ mặt cắt dầm

đã sửa rồi đó bạn

(defun c:mc(/ dz ten p1 p2 y1 x1 cd rd nt nd pit pig pid cao tl bl tzo tt td lt lst l20t tzo olds pp ptl...
>>

đã sửa rồi đó bạn

(defun c:mc(/ dz ten p1 p2 y1 x1 cd rd nt nd pit pig pid cao tl bl tzo tt td lt lst l20t tzo olds pp ptl olay)
 (setq p1 (getpoint "\nchon diem 1: ")
       olds (getvar "osmode")
cd (getdist "\nchieu cao dam: ")
rd (getdist "\nchieu rong dam: ")
nt (getint "\nso luong thep tren: ")
pit (getstring "\nnhap duong kinh thep tren: ")
nd (getint "\nso luong thep duoi: ")
pid (getstring "\nnhap duong kinh thep duoi: ")
pig (getstring "\nnhap duong kinh thep dai: ")
cao (getstring "\nnhap cao do dam: ")
tl (getint "\nnhap ty le 1: ")
ten (getstring "\nnhap ten mat cat: ")
x1 (car p1)
y1 (cadr p1)
bl (getvar "dimdli")
tzo (getvar "textsize")
       olay (getvar "clayer")
       dz (getvar "dimzin")
)
 (setvar "dimzin" 8)  
 (setvar "osmode" 0)
 (setq p2 (list (+ x1 rd) (+ y1 cd))
)
 (command "layer" "n" "beam" "c" "2" "beam" "l" "continuous" "beam" "s" "beam" "")
 (command "rectang" p1 p2)
 (command "layer" "n" "rbar" "c" "7" "rbar" "l" "continuous" "rbar" "s" "rbar" "")
 (command "offset" "20" (entlast) (list (+ x1 20) (+ y1 20)) "")
 (command "fillet" "r" "10")
 (command "fillet" "p" "l")
 (command "change" "l" "" "p" "LA" "rbar" "")
 (command "line" (list (+ x1 37.0711) (- (+ y1 cd) 22.9289)) "@40<-45" "")
 (command "offset" "20" (entlast) p1 "")
 (command "layer" "n" "steel" "c" "2" "steel" "l" "continuous" "steel" "s" "steel" "")
 (command "donut" "0" "20" (list (+ x1 30) (-(+ y1 cd) 30)) "")
 (setq tt (entlast))
 (command "copy" tt "" p1 (strcat"@0," (rtos (- 60 cd)))"")
 (setq td (entlast))
 (command "array" tt "" "r" "1" nt (/ (- rd 60) (- nt 1)))
 (command "array" td "" "r" "1" nd (/ (- rd 60) (- nd 1)))
 (command "layer" "n" "dim" "c" "7" "dim" "l" "continuous" "dim" "s" "dim" "")
 (command "dimlinear" p1 (list x1 (cadr p2)) (strcat"@-" (rtos(* bl tl))",0"))
 (command "dimlinear" p2 (list x1 (cadr p2)) (strcat"@0," (rtos(* bl tl))))
 (command "solid" (list (- x1 (* bl tl)) (cadr p2)) (list (- x1 (* (- bl 2.5) tl)) (+(cadr p2) (* tl 2.5))) (list (- x1 (* (+ bl 2.5) tl)) (+(cadr p2) (* tl 2.5))) "" "")
 (setvar "textsize" (* tl 2.5))
 (command "layer" "n" "text 2.5" "c" "2" "text 2.5" "l" "continuous" "text 2.5" "s" "text 2.5" "")
 (command "text" (list (- x1 (* (+ bl 4.5) tl)) (+(cadr p2) (* tl 3))) "" "" cao)
 (command "layer" "s" "dim" "")
 (command "qleader" (list (+ x1 30) (-(cadr p2)30)) (strcat "@0," (rtos (* 4 tl))) (strcat "@" (rtos (+ rd (* 6 tl))) ",0") nil)
 (setq lt (entlast)
l20t (nth 20(entget lt))
)
 (repeat (- nt 1)
   (command "copy" lt "" p1 (strcat "@" (rtos (/ (- rd 60) (- nt 1))) ",0") "")
   (setq lt (entlast)
 	lst (entget lt))
   (setq lst (subst l20t (nth 20 lst) lst))
   (entmod lst)
   )
 (command "layer" "s" "text 2.5" "")
 (command "text" "j" "ML" (list (+ (cadr l20t)(* 1.25 tl)) (caddr l20t) (cadddr l20t)) "" "" (strcat (rtos nt) "%%c" pit))
 (command "layer" "s" "dim" "")
 (command "qleader" (list (+ x1 30) (+ y1 30)) (strcat "@0,-" (rtos (* 4 tl))) (strcat "@" (rtos (+ rd (* 6 tl))) ",0") nil)
(setq lt (entlast)
l20t (nth 20(entget lt))
)
 (repeat (- nd 1)
   (command "copy" lt "" p1 (strcat "@" (rtos (/ (- rd 60) (- nd 1))) ",0") "")
   (setq lt (entlast)
 	lst (entget lt))
   (setq lst (subst l20t (nth 20 lst) lst))
   (entmod lst)
   )
 (setvar "clayer" "text 2.5")
 (command "text" "j" "ML" (list (+ (cadr l20t)(* 1.25 tl)) (caddr l20t) (cadddr l20t)) "" "" (strcat (rtos nd) "%%c" pid))
 (command "layer" "s" "dim" "")
 (command "qleader" (list (-(car p2)20) (/(+ y1 (cadr p2)) 2)) (list (cadr l20t) (/(+ y1 (cadr p2))2)) nil)
 (setvar "clayer" "text 2.5")  
 (command "text" "j" "ML" (list (+ (cadr l20t)(* 1.25 tl)) (/(+ y1 (cadr p2))2)) "" "" (strcat "%%c" pig))
 (setq pp (list (/(+ x1 (car p2))2) (- y1 (* 14 tl))))
 (setq ptl (list (car pp) (-(cadr pp)(* 3.5 tl))))
 (setvar "clayer" "text 2.5")
 (command "text" "j" "C" ptl "" "" (strcat "TL 1:" (rtos tl)))
 (command "layer" "n" "text 5.0" "c" "1" "text 5.0" "l" "continuous" "text 5.0" "s" "text 5.0" "")
 (setvar "textsize" (* tl 5))
 (command "text" "j" "BC" pp "" "" (strcat "%%uMC " ten))  
 (setvar "osmode" olds)
 (setvar "textsize" tzo)
 (setvar "clayer" olay)
 (setvar "dimzin" dz)
 (princ)  
 )

anh giúp em chuyển cái mặt cắt này sang màu như của em giúp em vơi anh lp_Hai các thông số vẫn để như cũ, cảm ơn anh nhiều, mong sớm hồi âm của anh. Em thấy lisp này hay lắm nhưng màu thì em chưa ưng ý mà ko biết làm sao chuyển cho tiện. Mong anh giúp đỡ em mới tham gia diễn đàn lần đầu mong anh chỉ bảo thêm. Cảm ơn anh

http://www.cadviet.c...nh_lp_hai_1.dwg


<<

Filename: 211753_mc.lsp
Tác giả: namgiangduy89
Bài viết gốc: 386731
Tên lệnh: ha
Lisp đánh ký hiệu khung block att

 

Lisp thay đổi Att tăng dần 1 đơn vị cho các Block_Att được chọn theo Att được chọn đầu tiên.

>>

 

Lisp thay đổi Att tăng dần 1 đơn vị cho các Block_Att được chọn theo Att được chọn đầu tiên.

;; Thay doi att tang dan 1 don vi cho cac block_att duoc chon theo att duoc chon dau tien.
;; Doan Van Ha - CadViet.com - ngay 26/7/2013
(vl-load-com)
(defun C:HA( / ent ss tag lst pre suf int len num #SS->List #String:Split-First VxSetAtts)
 (defun #SS->List (ss / i lst)
  (repeat (setq i (sslength ss))
   (setq lst (cons (ssname ss (setq i (1- i))) lst))))
 (defun #String:Split-First (string symbol / i)
  (if (setq i (vl-string-position (ascii symbol) string))
   (list (substr string 1 (1+ i)) (substr string (+ 2 i)))
   (list string)))
 (defun VxSetAtts (Obj Lst / AttVal)
  (mapcar '(lambda (Att) (if (setq AttVal (cdr (assoc (vla-get-TagString Att) Lst))) (vla-put-TextString Att AttVal))) (vlax-invoke Obj 'GetAttributes))
  (vla-update Obj))
 (if
  (and
   (setq ent (car (nentsel "\nChon Att So hieu cua ban ve dau tien: ")))
   (princ "\nChon cac Block theo thu tu de thay So hieu ban ve...")
   (setq ss (ssget '((0 . "Insert") (66 . 1)))))
  (progn
   (setq tag (cdr (assoc 2 (setq elist (entget ent)))))
   (setq lst (#String:Split-First (cdr (assoc 1 elist)) "-"))
   (setq pre (car lst))
   (setq suf (cadr lst))
   (setq int (atoi suf))
   (setq len (strlen suf))
   (foreach n (#SS->List ss)
(setq num (itoa (setq int (1+ int))))
(repeat (- len (strlen num))
(setq num (strcat "0" num)))
(VxSetAtts (vlax-ename->vla-object n) (list (cons tag (strcat pre num))))))))
 

sao mình làm load nó bị lỗi như vậy là gì ai chỉ dùm với:

APPLOAD ha.lsp successfully loaded.

Command: ; error: syntax error
Command:

<<

Filename: 386731_ha.lsp
Tác giả: huaductiep
Bài viết gốc: 268092
Tên lệnh: 3d-%3E2d
Giúp đỡ về lệnh Convert 3D polyline to Polyline

Cái này chuẩn. Thanks các bác :)

 

Vẫn còn 1 cách nữa, xin tiếp cận tạo lisp để Convert 3D polyline to Polyline với các các hàm...

>>

Cái này chuẩn. Thanks các bác :)

 

Vẫn còn 1 cách nữa, xin tiếp cận tạo lisp để Convert 3D polyline to Polyline với các các hàm acet-... mà không cần nổ đối tượng:


;| Convert 3D polyline to Polyline Lispyeu cau: express tools day du|; (defun c:3d->2d (/ ssg ss lstptmp e L)  (prompt "\nSelect polyline: ")  (setq	ssg (ssget '((0 . "POLYLINE")))	lstptmp	nil	i 0)  (while (< i (sslength ssg))    (setq e (ssname ssg i))    (setq L (ACET-GEOM-VERTEX-LIST e))    (foreach ptemp L      (setq lstptmp (append lstptmp (list(list (car ptemp) (cadr ptemp)))))    )    (ACET-LWPLINE-MAKE (List lstptmp))    (setq i (1+ i)	  lstptmp nil    )    (entdel e)  )  (princ))

<<

Filename: 268092_3d-%3E2d.lsp
Tác giả: hiepttr
Bài viết gốc: 422341
Tên lệnh: don ddon
"góc nhờ vả" líp dồn viewport

Mì ăn liền ^^

(defun c:DON( / lst_va old view_lay ss lst_ss lst1 lst2 first_elem base_pt)
(setq lst_va '("osmode" "cmdecho"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(0 0))
(setq view_lay (entsel "\n Pick chon viewport mau: "))
(prompt "\n Chon viewports !")
;(setq ss (ssget (list (cons 0 "VIEWPORT"))))
(setq ss (ssget (list (cons 0 "LWPOLYLINE") (assoc 8 (entget (car...
>>

Mì ăn liền ^^

(defun c:DON( / lst_va old view_lay ss lst_ss lst1 lst2 first_elem base_pt)
(setq lst_va '("osmode" "cmdecho"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(0 0))
(setq view_lay (entsel "\n Pick chon viewport mau: "))
(prompt "\n Chon viewports !")
;(setq ss (ssget (list (cons 0 "VIEWPORT"))))
(setq ss (ssget (list (cons 0 "LWPOLYLINE") (assoc 8 (entget (car view_lay))))))
(if ss
	(progn
		(setq lst_ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
			  lst1 (mapcar '(lambda (x) (cons x (H:Getboundary x))) lst_ss)
			  lst1 (vl-sort lst1 '(lambda(x y) (< (car (cadr x)) (car (cadr y)))))
			  first_elem (car lst1)
			  lst2 (cdr lst1)
			  )
			(setq base_pt (list (car (last first_elem)) (cadr (cadr first_elem))))
		(foreach elem lst2
			(command ".move" (car elem) "" (cadr elem) base_pt)
			(setq base_pt (list (+ (car base_pt) (- (car (last elem)) (car (cadr elem)))) (cadr base_pt)))
		)
	)
)
;;xong tra ve:
(mapcar 'setvar lst_va old)
(princ)
)
;------------------------------------------------------------------------
(defun H:Getboundary (ent / dt tp)
(vla-getboundingbox (vlax-ename->vla-object ent) 'dt 'tp)
(mapcar 'vlax-safearray->list (list dt tp))
)
;-------------------------------------------------------------------------------
(defun c:DDON( / lst_va old view_lay ss lst_ss lst1 lst2 first_elem base_pt)
(setq lst_va '("osmode" "cmdecho"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(0 0))
(setq view_lay (entsel "\n Pick chon viewport mau: "))
(prompt "\n Chon viewports !")
;(setq ss (ssget (list (cons 0 "VIEWPORT"))))
(setq ss (ssget (list (cons 0 "LWPOLYLINE") (assoc 8 (entget (car view_lay))))))
(if ss
	(progn
		(setq lst_ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
			  lst1 (mapcar '(lambda (x) (cons x (H:Getboundary x))) lst_ss)
			  lst1 (vl-sort lst1 '(lambda(x y) (< (cadr (cadr x)) (cadr (cadr y)))))
			  first_elem (car lst1)
			  lst2 (cdr lst1)
			  )
			(setq base_pt (last first_elem))
		(foreach elem lst2
			(command ".move" (car elem) "" (list (car (last elem)) (cadr (cadr elem))) base_pt)
			(setq base_pt (list (car base_pt) (+ (cadr base_pt) (- (cadr (last elem)) (cadr (cadr elem))))))
		)
	)
)
;;xong tra ve:
(mapcar 'setvar lst_va old)
(princ)
)

 


<<

Filename: 422341_don_ddon.lsp
Tác giả: minhnghi
Bài viết gốc: 60280
Tên lệnh: batter b1
Lisp rải taluy trên đường cong
Đây là Lisp mà tôi hay dùng, mọi người cùng thưởng thức

;;; ======================== VE DUONG TALUY - LENH B1 (BATTER) =========================
;;;...
>>
Đây là Lisp mà tôi hay dùng, mọi người cùng thưởng thức

;;; ======================== VE DUONG TALUY - LENH B1 (BATTER) =========================
;;; ================================================================================


=======
;;;================================== Testlay (Tao ten va mau cho layer moi===============================
(defun testlay (lay co / tam)
	(setq datalay (list ""))	  
			  (setq tbl (tblnext "layer" 1))
			  (while tbl
				  (setq tam (cdr (assoc 2 tbl)))
		(setq datalay (append datalay (list tam)))
				  (setq tbl (tblnext "layer"))
			   )
	(setq datalay (cdr datalay))
	(if (= (member lay datalay) nil)
 (command "LAYER" "n" lay "c" co lay  "s" lay "")
 (command "LAYER"   "s" lay "")
	)	
)
;; ============================================= Batter ================================================
(defun c:Batter()
  (setvar "cmdecho" 0)
  (setvar "blipmode" 0)
  (setvar "aunits" 0)
  (setvar "angbase" (/ pi 2))
  (setvar "angdir" 1)
  (if (not lint) (setq lint 10.0))
  (setq int (getdist (strcat "\nInterval <" (rtos lint 2 3) ">: ")))
  (if int (setq lint int) (setq int lint))
  (command "line" (list 0.0 0.0) (list 0.0 0.0001) "")
  (if (tblsearch "block" "tadtick")
	 (command "block" "tadtick" "y" (list 0.0 0.0) (entlast) "")
	 (command "block" "tadtick" (list 0.0 0.0) (entlast) "")
  )
  (while (setq refent (entsel "\nSelect reference line: "))
  (command "undo" "group")
  (redraw (car refent) 3)
  (initget 1 "Cut Fill")
  (setq reply (getkword "\nut or ill batter: "))
  (setq s (ssget))
  (command "measure" refent "b" "tadtick" "y" int)
  (setq p (ssget "p") cn 0)
  (if s
	 (progn
		(while (< cn (sslength p))
		   (setq en (entget (ssname p cn)) p0 (cdr (assoc 10 en)) pt1 p0 pt2 nil b (cdr (assoc 50 en)))
		   (entdel (ssname p cn))
		   (setq p1 (polar p0 (+ (/ pi 2) b) 0.0001))
		   (command "line" p0 p1 "")
		   (command "extend" s "" (list (entlast) p1) "")
		   (setq xent (entget (entlast)))
		   (setq xdist (distance (cdr (assoc 10 xent)) (cdr (assoc 11 xent))))
		   (if (not (equal xdist 0.0001 0.0001))
			  (setq pt2 (cdr (assoc 11 xent)))
			  (progn
				 (command "extend" s "" (list (entlast) p0) "")
				 (setq xent (entget (entlast)))
				 (setq xdist (distance (cdr (assoc 10 xent)) (cdr (assoc 11 xent))))
				 (if (not (equal xdist 0.0001 0.0001))
					(setq pt2 (cdr (assoc 10 xent)))
				 )
			  )
		   )
		   (entdel (entlast))
		   (if pt2
			  (if (= reply "Fill")
				 (if (= (rem cn 2) 0) (command "line" pt1 pt2 "")
					(command "line" pt1 (polar pt1 (angle pt1 pt2) (/ (distance pt1 pt2) 2)) "")
				 )
				 (if (= (rem cn 2) 0) (command "line" pt2 pt1 "")
					(command "line" pt2 (polar pt2 (angle pt2 pt1) (/ (distance pt2 pt1) 2)) "")
				 )
			  )
		   )
		   (setq cn (1+ cn))
		)
	 )
  )
  (command "undo" "en")
  )
  (setvar "blipmode" 1)
  (princ)
)
(prompt "\nDraw cut/fill batter slope lines.")
;====================== BAT1 (BATTER)===========================================
(defun c:B1( / mode)

(testlay "BONG" "8")
(setvar "osmode" 0)
(c:batter)
(setvar "blipmode" 0)
(setvar "osmode" 167)
)

Cảm ơn bác philipdn nhiều, nhưng đúng là lisp của bác bất cập thật. Em thấy trường hợp chân taluy và đỉnh taluy mà không song song mà gấp khúc thì ký hiệu taluy không chuẩn và đẹp lắm. Không bít còn lisp nào ổn hơn không


<<

Filename: 60280_batter_b1.lsp
Tác giả: pawuta
Bài viết gốc: 341820
Tên lệnh: xx
Sắp xếp thẳng hàng

Bản thân ket nhiều khi muốn sắp xếp các nhóm đối tượng cho ngay ngắn theo hàng lối, thường toàn kẻ Xline để gióng (hoặc kết hợp...

>>

Bản thân ket nhiều khi muốn sắp xếp các nhóm đối tượng cho ngay ngắn theo hàng lối, thường toàn kẻ Xline để gióng (hoặc kết hợp F11) rồi move. Thật kỳ lạ >"<

Trong khi đoạn code ngắn như thế này giúp tăng tốc bao nhiêu. Ý tưởng của ReachAndre trên Augi

 

P/s : Tự gióng theo khoảng cách gần nhất giữa Delta X và Delta Y nhé ^^

(defun c:xx (/ p pt d xd yd s)
(command "undo" "Mark")
(while (not (setq p (getpoint "\n\U+0110i\U+1EC3m chu\U+1EA9n :: "))))
(while
	(setq s (ssget))
		(while(not(setq pt (getpoint "\n\U+0110i\U+1EC3m gi\U+00F3ng :" p))))
		(setq 	xd (abs (- (car pt) (car p)))
				yd (abs (- (cadr pt) (cadr p)))
				d	(cond 	((> xd yd)(list (car pt) (cadr p) (caddr pt)))
							((< xd yd)(list (car p) (cadr pt) (caddr pt)))
					)
		)
		(command "_move" s "" "non" pt "non" d)
)
(command "undo" "end")
(princ)
) 

 

 

Bản thân ket nhiều khi muốn sắp xếp các nhóm đối tượng cho ngay ngắn theo hàng lối, thường toàn kẻ Xline để gióng (hoặc kết hợp F11) rồi move. Thật kỳ lạ >"<

Trong khi đoạn code ngắn như thế này giúp tăng tốc bao nhiêu. Ý tưởng của ReachAndre trên Augi

 

P/s : Tự gióng theo khoảng cách gần nhất giữa Delta X và Delta Y nhé ^^

(defun c:xx (/ p pt d xd yd s)
(command "undo" "Mark")
(while (not (setq p (getpoint "\n\U+0110i\U+1EC3m chu\U+1EA9n :: "))))
(while
	(setq s (ssget))
		(while(not(setq pt (getpoint "\n\U+0110i\U+1EC3m gi\U+00F3ng :" p))))
		(setq 	xd (abs (- (car pt) (car p)))
				yd (abs (- (cadr pt) (cadr p)))
				d	(cond 	((> xd yd)(list (car pt) (cadr p) (caddr pt)))
							((< xd yd)(list (car p) (cadr pt) (caddr pt)))
					)
		)
		(command "_move" s "" "non" pt "non" d)
)
(command "undo" "end")
(princ)
) 

 

 

Bản thân ket nhiều khi muốn sắp xếp các nhóm đối tượng cho ngay ngắn theo hàng lối, thường toàn kẻ Xline để gióng (hoặc kết hợp F11) rồi move. Thật kỳ lạ >"<

Trong khi đoạn code ngắn như thế này giúp tăng tốc bao nhiêu. Ý tưởng của ReachAndre trên Augi

 

P/s : Tự gióng theo khoảng cách gần nhất giữa Delta X và Delta Y nhé ^^

(defun c:xx (/ p pt d xd yd s)
(command "undo" "Mark")
(while (not (setq p (getpoint "\n\U+0110i\U+1EC3m chu\U+1EA9n :: "))))
(while
	(setq s (ssget))
		(while(not(setq pt (getpoint "\n\U+0110i\U+1EC3m gi\U+00F3ng :" p))))
		(setq 	xd (abs (- (car pt) (car p)))
				yd (abs (- (cadr pt) (cadr p)))
				d	(cond 	((> xd yd)(list (car pt) (cadr p) (caddr pt)))
							((< xd yd)(list (car p) (cadr pt) (caddr pt)))
					)
		)
		(command "_move" s "" "non" pt "non" d)
)
(command "undo" "end")
(princ)
) 

 

Cảm ơn lisp của bạn, bạn có thể thêm phần chọn khoảng cách sắp xếp (X, Y) giữa điểm làm chuẩn và đối tượng cần dóng được không. Ý mình là sau khi chọn điểm chuẩn; chọn đối tượng (nhóm đối tượng) cần dóng; nhập khoảng cách trục X (nếu không cần thì Enter), trục Y (nếu không cần thì Enter) so với điểm chuẩn. Mong bạn hiểu ý mình nói!


<<

Filename: 341820_xx.lsp
Tác giả: nguyenbac_cd
Bài viết gốc: 319610
Tên lệnh: ddm
nhờ viết lisp vẽ thêm đường đồng mức phụ

 

Bạn thử cái này, quét 2 đường đồng mức rồi nhập số khoảng chia, ở đây là 5.

 

(defun...
>>

 

Bạn thử cái này, quét 2 đường đồng mức rồi nhập số khoảng chia, ở đây là 5.

 

(defun c:ddm (/ ss sk dd dn lst d1 dis n)
  
  (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "LWPOLYLINE"))))))
sk (getint "\nSo khoang chia:")
dd (car (vl-sort ss
   '(lambda (x y) (> (vlax-curve-getDistAtParam x (vlax-curve-getEndParam x))
     (vlax-curve-getDistAtParam y (vlax-curve-getEndParam y))))))
dn (car (vl-remove dd ss))
dd (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget dd)))
lst nil
  )
  (repeat (1- sk) (setq lst (cons '() lst)))
 
  (foreach d0 dd 
    (setq d1 (vlax-curve-getclosestpointto dn d0)
 dis (/ (distance d0 d1) sk)
          n 0)    
    (setq lst (mapcar '(lambda (x) (append x (list (polar d0 (angle d0 d1) (* (setq n (1+ n)) dis))))) lst)) 
  )
  (foreach v lst
    (entmake (append '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline"))
    (list (cons 90 (length v))) (mapcar '(lambda (x) (cons 10 x)) v  )
    ))
  )
  (princ)      
)

chào anh! em cảm ơn anh rất nhiều! em thấy lisp này chỉ nhận được dạng đường PL, chưa được làm trơn, chứ đường đồng mức được làm trơn rồi thì nó không nhận dạng được anh à :(  anh có thể fix lại được không ạ! ?122241_222.png122241_111.png


<<

Filename: 319610_ddm.lsp

Trang 229/330

229