Jump to content
InfoFile
Tác giả: pohan
Bài viết gốc: 285464
Tên lệnh: ha
Lisp Ghép Text Cần Giúp Đỡ

 

Lisp ghép từng cặp 2 text rời (dạng số) có khoảng cách 2 điểm chèn 1 hằng số, thành 1 text, thêm dấu chấm thập...

>>

 

Lisp ghép từng cặp 2 text rời (dạng số) có khoảng cách 2 điểm chèn 1 hằng số, thành 1 text, thêm dấu chấm thập phân.

;Doan Van Ha - CADViet.com - Ngay 11-6-2012
;Muc dich: Noi tung cap text kieu num gan nhau nhat, bang dau ".". VD: noi "5" va "32" thanh "5.32".
;Doi tuong chon va phan nhom theo tung cap co khoang cach giua 2 diem chen text la hang so.
(defun C:HA(/ ent1 ent2 lay1 lay2 kc ss lst x1 x2)
(while (not (setq ent1 (car (entsel "\nChon text so lon lam mau: ")))))
(while (not (setq ent2 (car (entsel "\nChon text so nho lam mau: ")))))
(princ "\nChon tap hop cac Text can noi...")
(setq lay1 (cdr (assoc 8 (entget ent1))) lay2 (cdr (assoc 8 (entget ent2))))
(setq kc (- (car (cdr (assoc 10 (entget ent1)))) (car (cdr (assoc 10 (entget ent2))))))
(setq ss (ssget (list (cons -4 "<AND") (cons 0 "TEXT") (cons -4 "<OR") (cons 8 lay1) (cons 8 lay2) (cons -4 "OR>") (cons -4 "AND>"))))
(setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(if (/= (rem (length lst) 2) 0)
  (alert "Yeu cau so luong 2 nhom Text phai bang nhau!")
  (foreach ent1 lst
   (setq x1 (car (cdr (assoc 10 (entget ent1)))))
   (foreach ent2 lst
	(setq x2 (car (cdr (assoc 10 (entget ent2)))))
	(if (equal (- x1 x2) kc 1E-8)
	(progn
  	(entmod (subst (cons 1 (strcat (cdr (assoc 1 (entget ent1))) "." (cdr (assoc 1 (entget ent2))))) (assoc 1 (entget ent1)) (entget ent1)))
  	(entdel ent2)
  	(setq lst (vl-remove ent1 (vl-remove ent2 lst))))))))
(princ))

Cái này bị lỗi bác ạ. Nó chỉ được 1 đôi đầu tiên trong tập hợp thôi, bác fix lại giúp em được ko?


<<

Filename: 285464_ha.lsp
Tác giả: hiepttr
Bài viết gốc: 424425
Tên lệnh: edac
Nhờ viết gium lisp autocad

Lại nghịch ^^

Và lý do là tại bạn đăng bài theo cách của bạn nên mình code lisp theo cách của mình, cụ thể:

File xuất ra có các cột: STT, k/c, góc rẽ & 02 cột tọa độ.

Với cột góc, số liệu xuất ra có đơn vị là độ (phần nghuyên & phần thập phân),

khi góc:

<180 ==> rẽ trái,

=180 ==> thẳng,

>180 ==> rẽ phải (khi...

>>

Lại nghịch ^^

Và lý do là tại bạn đăng bài theo cách của bạn nên mình code lisp theo cách của mình, cụ thể:

File xuất ra có các cột: STT, k/c, góc rẽ & 02 cột tọa độ.

Với cột góc, số liệu xuất ra có đơn vị là độ (phần nghuyên & phần thập phân),

khi góc:

<180 ==> rẽ trái,

=180 ==> thẳng,

>180 ==> rẽ phải (khi đó, giá trị trong dim của bạn bằng 360 trừ giá trị trong cột).

Good luck!

 

p/s:

Bạn không nên lưu file CAD tên tiếng Việt, lisp ko thịt đc ^^

 

;; https://www.cadviet.com/forum/topic/171694-nh%E1%BB%9D-vi%E1%BA%BFt-gium-lisp-autocad/
(defun c:EDAC( / ANG DIST ENT FN I LST_DATA LST_PT OLD PT PT_S PT_TR PW START VAR)
;;;export Distance, Angle, Coordinate
(vl-load-com)
(setq var '("osmode" "cmdecho"))
(setq old (mapcar 'getvar var))
(mapcar 'setvar var '(0 0))
(setq ent (car (entsel "\nChon PL: ")))
(setvar "osmode" 1)
(setq start (getpoint "\nPick chon diem dau: "))

(cond 
	((and ent start)
		(setq lst_pt (acet-geom-vertex-list ent))
		(if (not(equal (distance start (car lst_pt)) 0 0.001)) (setq lst_pt (reverse lst_pt)))
		(setq i 0 
			  lst_data (list (list 1 0 0 (car lst_pt)))
			  )
		(repeat (- (length lst_pt) 2)
			(setq i (1+ i)
				  pt_tr (nth (1- i) lst_pt)
				  pt (nth i lst_pt)
				  pt_s (nth (1+ i) lst_pt)
				  dist (distance pt pt_tr)
				  ang (deviant (angle pt pt_s) (angle pt_tr pt))
				  lst_data (append lst_data (list (list (1+ i) dist ang pt)))
				  )
		)
		(setq lst_data (append lst_data (list (list (+ 2 i) (distance pt_s pt) 0 pt_s))))
	;;;-----------------
		(setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
 		(setq pw (open fn "w"))
		(write-line "ORDER,DIST,ANG,COORD" pw)
		(foreach elem lst_data
 			(write-line (strcat (itoa (car elem)) "," (rtos (cadr elem) 2 3) "," (rtos (caddr elem) 2 3) "," (rtos (cadr (last elem)) 2 3) "," (rtos (car (last elem)) 2 3)) pw)
		)
		(close pw)
	)
	(t (alert "*** Bam lung tung, moi bam lai ! ***"))
)
(mapcar 'setvar var old)
(princ)
)
;;;====================
(defun deviant (ang2 ang1 / deviant_rad deviant_deg)
(setq deviant_rad (if (> ang2 ang1) (- ang2 ang1) (- (+ (* 2 pi) ang2) ang1))
	  deviant_deg (/ (* deviant_rad 180) pi))
)

 


<<

Filename: 424425_edac.lsp
Tác giả: phamthe
Bài viết gốc: 231501
Tên lệnh: ss
{Nhờ chỉnh sửa} Lisp tính diện tích

 

File CAD thì mình chưa xem, nhưng lisp này không biết bạn nào viết mà tệ quá. Phần chào mừng thì nhìn nick khá quen, như có thâm niên...

>>

 

File CAD thì mình chưa xem, nhưng lisp này không biết bạn nào viết mà tệ quá. Phần chào mừng thì nhìn nick khá quen, như có thâm niên Request ở CV ý ^^

Đọc qua thấy có vẻ giống lisp tính tổng diện tích các đối tượng được chọn, rồi ghi ra một text có sẵn, như vậy thì trên diễn đàn đã có khá nhiều. Mình code lại 1 cái gọn theo ý bạn :

 

(defun c:ss(/ i *error* oVars oVals s e a)(vl-load-com)
(defun *error*(msg)(princ msg)(if (and oVars oVals) (mapcar 'setvar  oVars oVals))(princ))
(setq oVars '("cmdEcho" "Dimzin") oVals (mapcar 'getvar oVars) i -1 a 0)
(mapcar 'setvar oVars '(0 0))
(cond
  ((setq s (ssget))
   (while  (setq e (ssname s (setq i (1+ i))))
	(if (vlax-property-available-p (setq e (vlax-ename->vla-object e)) 'Area)
  	(setq a (+ (vla-get-area e) a))
	)
   )
   (cond ((> a 0)
	(while (not (setq e (nentsel "\nChon text ghi ket qua :"))))
	(vla-put-textstring (setq e (vlax-ename->vla-object (car e)))(rtos (/ a 1000 1000.0) 2 2))
	(vla-put-color e 1)
   ))
  )
)
(*error* "\nDone!")
)

anh ơi có thể cho tính dtich bằng cách pick điểm và pick hình nào thì hatch tạm hình đó cho đỡ nhầm được không anh?


<<

Filename: 231501_ss.lsp
Tác giả: Mỹ Siro
Bài viết gốc: 415084
Tên lệnh: leglengthmod splitdims
Nhờ Viết Lisp Chia Dim Và Gộp Dim.

 

Lisp chia dim cho bạn

(defun c:LegLengthMod ( / ss dimobjs)
;; codehimbelonga KerryBrown@theSwamp...
>>

 

Lisp chia dim cho bạn

(defun c:LegLengthMod ( / ss dimobjs)
;; codehimbelonga KerryBrown@theSwamp 2010.05.28
(vl-load-com)
(if (and (setq ss (ssget '((0 . "DIMENSION"))))
(setq dimobjs (mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
)
)
)
(foreach dim dimobjs
(vla-put-extlinefixedlensuppress dim :vlax-true)
(vla-put-extlinefixedlen dim (* 2 (vla-get-textheight dim)))
)
)
(princ)
)
(defun c:SplitDims (/ sel newpt ent edata elist)
;; codehimbelonga KerryBrown@theSwamp 2010.05.28
(if (and (setq sel (entsel "\nSelect Dimension to Split."))
(setq newpt (getpoint "\Select new Dim Point"))
)
(progn (setq ent (car sel)
edata (entget ent)
elist (vl-remove-if
'(lambda (pair)
(member (car pair)
(list -1 2 5 102 310 300 330 331 340 350 360 410)
)
)
edata
)
)
(entmod (subst (cons 14 newpt) (assoc 14 elist) edata))
(entmakex (subst (cons 13 newpt) (assoc 13 elist) elist))
)
)
(princ)
)

cảm ơn bạn rất nhiều, đã thanks 1 điểm, mình có góp ý 1 chút là lisp chia dim dùng đã ok rồi nhưng mỗi lần chỉ pick chia dim được 1 lần rồi phải gọi lệnh lại để pick chia dim điểm tiếp theo, bạn có cách nào pick chọn dim cần chia 1 lần rồi mỗi lần mình pick điểm trên đối tượng là nó chia tiếp không, đến khi thoát lệnh thì thôi. Mình cảm ơn bạn trước :)

còn lisp gộp dim thì hình như code nhẫm lẩn hay ko mà nó không gộp dim, cảm ơn bạn !


<<

Filename: 415084_leglengthmod_splitdims.lsp
Tác giả: thiennvpecc1
Bài viết gốc: 385592
Tên lệnh: xuat
Xuất Tọa Độ Và Khoảng Cách Cộng Dồn Pline Ra File Excel

Cám ơn bạn rất nhiều

 

 

Bạn dùng thử cái này:

p/s: Bạn nên sửa tiêu đề trước khi bịi mod xóa bài...

>>

Cám ơn bạn rất nhiều

 

 

Bạn dùng thử cái này:

p/s: Bạn nên sửa tiêu đề trước khi bịi mod xóa bài :D

;Xuat X tuong doi va Y tuyet doi cua polyline
(defun c:XUAT( / ss lst_name fn pw i ename TT)
(vl-load-com)
(prompt "\nChon PL !")
(setq ss (ssget '((0 . "LWPOLYLINE"))))
(cond 
	(ss
		(setq lst_name (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
		(setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
		(setq pw (open fn "w"))
		(write-line "STT PL,Ten dinh,Y _tuyet doi,X _tuong doi" pw)
		(setq i 0)
		(while (< i (length lst_name))
			(setq	ename (nth i lst_name)
					i (1+ i)
					lst_ver (acet-geom-vertex-list ename)
					)
			(write-line (setq TT (itoa i)) pw)
			(MakeText (car lst_ver) TT 1 0 "C" nil "Lay_Lsp_XUAT" 2 nil)
			(foreach pnt lst_ver
				(write-line (strcat "," (rtos (1+ (vl-position pnt lst_ver))) "," (rtos (cadr pnt) 2 2) "," (rtos (- (car pnt) (car (car lst_ver))) 2 2)) pw)
			)
		)
	)
)
(close pw)
(alert (strcat "Da them " (itoa (length lst_name)) " Text STT PL vao ban ve !"))
(princ)
)
;===================================|;
(defun MakeText (point string Height Ang justify Style Layer Color xdata / Lst)
; Ang: Radial	
(setq Lst (list '(0 . "TEXT")
				(cons 8 (if Layer Layer (getvar "Clayer")))									
				(cons 62 (if Color Color 256))									
				(cons 10 point)									
				(cons 40 Height)									
				(cons 1 string)									
				(if Ang (cons 50 Ang))									
				(cons 7 (if Style Style (getvar "Textstyle")))									
				(cons -3 (if xdata (list xdata) nil)))				
				justify (strcase justify))	
				(cond ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))				
					  ((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))				
					  ((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))				
					  ((= justify "TL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 3)))))				
					  ((= justify "TC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 3)))))				
					  ((= justify "TR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 3)))))					
					  ((= justify "ML") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 2)))))				
					  ((= justify "MC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 2)))))				
					  ((= justify "MR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 2)))))				
					  ((= justify "BL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 1)))))				
					  ((= justify "BC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 1)))))				
					  ((= justify "BR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 1)))))
					  )	
					  (entmakex Lst)
);end

<<

Filename: 385592_xuat.lsp
Tác giả: quan08
Bài viết gốc: 164606
Tên lệnh: tt
Lsp lấy dữ liệu lệnh Massprop

Hôm qua bạn hỏi, tôi đang mày mò tìm câu trả lời thì topic bị xoá, có lẽ do thiếu 2 từ , vi phạm nội quy Cadviet. Đáng lẽ riêng...

>>

Hôm qua bạn hỏi, tôi đang mày mò tìm câu trả lời thì topic bị xoá, có lẽ do thiếu 2 từ , vi phạm nội quy Cadviet. Đáng lẽ riêng trường hợp bạn thì Cadviet cần thông cảm mới đúng, nhưng chuyện lỡ rồi thì thôi. Hôm nay bạn hỏi lại với câu hỏi rộng hơn. Tuy nhiên, do mót được trên Cadviet cái này (của tác giả nào thì tôi quên lưu tên, sorry tác giả) nên tôi gởi lại cho bạn: đó là lsp tính trọng tâm của 1 REGION hoặc SOLID.

Từ cách tính trọng tâm của 1 hình bạn có thể tính được trọng tâm của n hình theo nguyên tắc cân bằng cánh tay đòn của tích số diện tích và điểm trọng tâm. Hy vọng bạn làm được.

Thân thương!

(defun C:TT ()
 (vl-load-com)
 (if (and (setq sel (entsel "\nChon Region hoac 3D Solid: "))
      (wcmatch (cdr (assoc 0 (entget (setq ent (car sel)))))
           "REGION,3DSOLID"))
   (progn
     (entmake
   (list
     (cons 0 "point")
     (cons    10
       (vlax-safearray->list
         (vlax-variant-value
           (vlax-get-property
             (vlax-ename->vla-object ent)
             'Centroid))))))
     (sssetfirst (ssadd (entlast)) (ssadd (entlast))))
   (alert "Hay chon doi tuong REGION hoac SOLID!"))
 (princ))

Bạn có thể viết giúp đoạn lisp tính trọng tâm của n hình như bạn nói được không?Mình không rành về lisp.Cảm ơn bạn trước.


<<

Filename: 164606_tt.lsp
Tác giả: toiyeuvietnam
Bài viết gốc: 302154
Tên lệnh: cpy
Lisp copy nhanh đối tượng theo nhiều khoảng cách

 

Bạn dùng cái này. Sau khi copy xong nếu bạn dùng lệnh khác mà có select objects thì có thể đánh chữ "P" để lấy các đối tượng...

>>

 

Bạn dùng cái này. Sau khi copy xong nếu bạn dùng lệnh khác mà có select objects thì có thể đánh chữ "P" để lấy các đối tượng cuối cùng.

 

(defun c:cpy(/ ss pt hg os el en)
  (prompt "\nChon cac doi tuong de copy:")
  (setq ss (ssget) 
pt (getpoint "\nDiem goc:")
hg (getangle pt "\nTheo huong:")
os (getvar 'osmode))
  (setvar 'osmode 0)
  (while (setq kc (getreal "\nKhoang cach:"))
    (setq el (entlast))
    (command "copy" ss "" pt (polar pt hg kc))
    (setq ss (ssadd))
    (while (setq en (entnext el))
      (ssadd en ss)
      (setq el en))
  ) 
  (command "select" ss "")
  (setvar 'osmode os) (princ)
)

Tot77 ơi, cái này bạn có thể thêm chức năng lưu biến khoảng cách được không? cảm ỏn nhiều


<<

Filename: 302154_cpy.lsp
Tác giả: dragontalon0802
Bài viết gốc: 186424
Tên lệnh: c6 f6 ch6
lisp fillet,copy,champer, đo diện tích.

Hề hề hề, chả biết có phải là bạn cần cái này hay không, nhưng thú thực là mình không khoái cái thói ỷ lại của bạn. Là...

>>

Hề hề hề, chả biết có phải là bạn cần cái này hay không, nhưng thú thực là mình không khoái cái thói ỷ lại của bạn. Là một thành viên có hạng của CADviet rồi, bạn cũng đã yêu cầu không ít các vấn đề, và cũng không phải là người không biết gì về lisp. Những yêu cầu đơn giản kiểu này bạn hoàn toàn có đủ khả năng tự làm nếu như bạn thực sự là cần nó và muốn tự làm ra nó. Đằng này bạn hoàn toàn chả có ý gì muốn tự mình làm mà chỉ muốn đi nhờ và ăn sẵn. Như vậy thực là không hay chút nào, và nó chỉ làm bạn trở nên người lợi dụng bạn bè chứ chả thể khá lên được đâu.

Cũng chính vì lý do này nên mặc dầu không quá khó nhưng người muốn giúp bạn sẽ chả bao giờ là nhiều cả. Mình viết cái này có nhẽ chả phải là cho riêng bạn đâu nhưng mong rằng qua cái này bạn sẽ tự hiểu được mình cần gì để mà cố gắng chứ đừng ỷ lại nhé.


(defun c:c6 ()
       (command "copy" (car (entsel "\n Chon doi tuong goc")) "" (setq p1 (getpoint "\n Chon diem goc"))
                           (setq p2 (polar p1 (angle p1 (getpoint p1 "\n Chon huong copy")) 6000)))
)
(defun c:f6 ()
  	(command "fillet" "r" 6000 "fillet" (car (entsel "\n Chon doi tuong thu nhat")) (car (entsel "\n Chon doi tuong thu hai")))
)
(defun c:ch6 ()
     (command "chamfer" "d" 6000 "" "chamfer" (car (entsel "\n Chon doi tuong thu nhat")) (car (entsel "\n chon doi tuong thu hai")))
)

Chúc bạn chóng thành công trong cuộc sống.

Cảm ơn bác Thanh Bình đã viết lisp và góp ý. Nhưng thực sự mình không biết về thuật toán lisp và chưa có thời gian tìm hiểu. Nhờ các bạn viết lisp xong mình chỉ biết thay đổi thông số như "f6" và đơn vị như "6000" theo ý mình. Cũng có thể mình yêu cầu một số cái hơi nhỏ nhặt và đôi lúc vi phạm nội quy diễn đàn vì mình ít tham gia và mình không phải là người đam mê ngành lắm. Nhưng trước lúc yêu cầu mình đã cố gắng google nhưng không được. Cảm ơn sự nhiệt tình của các bạn trên diễn đàn.


<<

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

 

level lisp còn thấp cộng với thời gian hạn chế nên chỉ làm đc khung xương cho bạn

Phần bẫy lỗi còn kém, bạn dùng tạm,...

>>

 

level lisp còn thấp cộng với thời gian hạn chế nên chỉ làm đc khung xương cho bạn

Phần bẫy lỗi còn kém, bạn dùng tạm, có gì thắc mắc sẽ chỉnh sửa thêm

;; 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 (/ old i tong ent text_dim start end n)
;;sum dim
(setq old (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq i 0
	  tong 0)
(while (setq ent (nentsel "\n Pick dung vao text Dim: "))
	(setq i (1+ i)
		  text_dim (cdr(assoc 1 (entget (car ent))))
		  start (vl-string-search "[" text_dim)
		  end (vl-string-search "%%C" text_dim)
		  n (atoi (substr text_dim (+ 2 start) (- end start 1)))
		  tong (+ n tong)
	)
)
(alert (strcat "Tong cong " (itoa i) " dim la: " (itoa tong) " dai"))
(setvar "cmdecho" old)
(princ)
)

 

Cám ơn bạn hiepttr đã giúp đỡ

Lisp này đúng với yêu cầu của mình rồi, mình đã dùng thử nhưng vẫn còn 1 số hạn chế sau:

   - phải click đúng vào phần text của dim thì mới dùng được, click vào các đường trên dim là không dùng được

   - hiện tại đang phải click vào từng dim nên khá là lâu nếu dầm nhiều nhịp, ví dụ như mình có 1 dầm có 10 nhịp, sẽ có 30 khoảng bố trí đai như vậy phải click 30 lần mới tính được, khá mất thời gian. bạn có thể sửa lại hộ mình là có thể quét để chọn nhiều dim thay vì click vào từng dim được không

 

Mong bạn sửa giúp mình, mình cám ơn nhiều


<<

Filename: 295319_sd.lsp
Tác giả: tuandh
Bài viết gốc: 19521
Tên lệnh: tinhthang
Vẽ thang bằng lisp

Bạn mệt mỏi khi phải dóng để vẽ mặt đứng thang phức tạp?

 

Hãy để lisp tính thang của CADViet giúp bạn phần nào. Bạn copy đoạn code dưới đây vào file...

>>
Bạn mệt mỏi khi phải dóng để vẽ mặt đứng thang phức tạp?

 

Hãy để lisp tính thang của CADViet giúp bạn phần nào. Bạn copy đoạn code dưới đây vào file một file lisp rồi appload lên và dùng lệnh tinhthang.

 

(defun c:tinhthang()
 (defun l2bac(ent)
   (setq
     tt (entget ent)
     p1 (cdr (assoc 10 tt))
     p2 (cdr (assoc 11 tt))
   )
   (list p1 p2)
 )
 (setq
   ssbac (ssget '((0 . "LINE")))
   hbac (getdist "\nChieu cao bac")
   lstent (ss2ent ssbac)
   ttbac (mapcar 'l2bac lstent)
   index 0.0
 )
 (command ".3dmesh")
 (command (* 2 (length lstent)) 2)
 (foreach pp ttbac    
   (setq
     caoht (* index hbac)
     index (+ index 1.0)
     p1 (car pp)
  p2 (cadr pp)
  x1 (car p1)
  y1 (cadr p1)
  x2 (car p2)
  y2 (cadr p2)
  za caoht
  zb (+ caoht hbac)
     p1a (list x1 y1 za)
     p1b (list x1 y1 zb)
     p2a (list x2 y2 za)
     p2b (list x2 y2 zb)      
   )
   (command p1a p2a p1b p2b)
 )
)

 

Đầu tiên là mặt bằng của bạn:

Thang01.gif

 

bạn đổi viewport để xem dạng phối cảnh:

thang02.gif

 

dùng lệnh tinhthang để vẽ 3d của bậc thang:

thang03.gif

 

dùng lệnh shade để xem thang dạng có diện:

thang04.gif

 

Xoay để lấy mặt đứng biên:

thang05.gif

 

Lệnh tính thang không thể vẽ kỹ được thang cho bạn, nhưng chắc chắn nó sẽ giúp bạn làm những thao tác cơ bản để có được những nét phôi của thang. Từ đó bạn sẽ thêm nét để trở thành mặt chiếu hay phối cảnh của thang.

 

Rất mong có được sự hồi âm sau khi sử dụng Lisp.

 

không vẽ được như ý muốn !


<<

Filename: 19521_tinhthang.lsp
Tác giả: vothanhdn
Bài viết gốc: 200505
Tên lệnh: test
Lisp Dim R tại Arc của LWPolyline

(defun c:test()(command "qdim" (car (entsel "\nChon Pline :")) "" "R"))

 

Thank...

>>

(defun c:test()(command "qdim" (car (entsel "\nChon Pline :")) "" "R"))

 

Thank a!

Lisp của a chưa gải quyết triệt để được vấn đề của e cho lắm, nó còn 1 số chỗ:

1. Nếu LWPolyline của e có n đường Arc thì chỉ Dim được (n-1) đường thôi

2. A có thể chỉnh cho nét Dim của đường Arc nắm về hướng tâm của đường Arc được không ah, tại vì tất cả đường Dim này đều nằm hướng ra phía ngoài của đường Arc

 

Cảm ơn !


<<

Filename: 200505_test.lsp
Tác giả: vothanhdn
Bài viết gốc: 200947
Tên lệnh: darp
Lisp Dim R tại Arc của LWPolyline

Hề hề hề,

Khó thật đấy. Khó nhất là phải đọc những điều ..... dở hơi ở trên bạn ạ.

Hãy thử cái này coi...

>>

Hề hề hề,

Khó thật đấy. Khó nhất là phải đọc những điều ..... dở hơi ở trên bạn ạ.

Hãy thử cái này coi đã hết khó chưa ???


(defun c:darp (/ oldos ent obj elst plst blst p par pd i pt ssl)
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq ent (car (entsel "\n Chon lwpolyline chua arc"))
		obj (vlax-ename->vla-object ent)
		elst (entget ent)
		plst (list)
		blst (list)
)
(foreach a elst
  	(if (= (car a) 10)
  		(setq plst (append plst (list (cdr a))))
  	)
  	(if (= (car a) 42)
  		(setq blst (append blst (list (cdr a))))
  	)
)
(setq i 0)
(foreach b blst
  	(if (not (equal b 0 0.000001))
  		(progn
               (setq p (nth i plst)
                         par (vlax-curve-getparamatpoint obj p)
                         pd (vlax-curve-getpointatparam obj (+ par 0.5))
               )
               (command "undo" "be")
               (setq ssl  (acet-explode ent))
               (setq pt (cdr (assoc 10 (entget (ssname ssl i)))))
               (command "undo" "e")
               (command "undo" 1)
               (command "dimradius" pd (list (/ (+ (car pt) (car pd)) 2) (/ (+ (cadr pt) (cadr pd)) 2)))
  		)
  	)
  	(setq i (1+ i))
)
(setvar "osmode" oldos)
(princ)
)

 

Bạn hãy bỏ cái kiểu nói khó nghe ở trên đi nhé nếu còn muốn có sự giúp đỡ.

 

Thank a!

 

Cám ơn a và mọi người nhiều

Sorry mọi người vì nếu có câu nào làm mọi người không vui lòng


<<

Filename: 200947_darp.lsp
Tác giả: whatcholingon
Bài viết gốc: 169147
Tên lệnh: demo
Lisp cộng trừ text độ, phút, giây...

Ý định của mình là đưa ra đoạn code tham khảo, sau đó bạn có thể chỉnh sửa theo ý mình.

Mình làm lại cái theo đề nghị của...

>>

Ý định của mình là đưa ra đoạn code tham khảo, sau đó bạn có thể chỉnh sửa theo ý mình.

Mình làm lại cái theo đề nghị của bạn:

 

- Nhập tóan tử (+/-), mặc định là lần nhập trước nếu bỏ qua.

- Nhập text 1

- Nhập text 2

- Nhập điểm chèn kết quả

- Quay lại nhập text1 ... cho đến khi bỏ qua 1 bước nào đó.

 

à quên, cái này xuất ra dạng 00d00'00", nếu yêu cầu phải đúng định dạng như đầu vào thì phải thêm 1 đoạn nữa. Bác thấy có nhất thiết phải thế không?

 


(defun c:demo (/ e e1 e2 key)
(defun s2d (str / ret)
 (setq ret
 (vl-list->string
(vl-remove-if
 	'(lambda (x) (or (< x 48) (> x 57)))
 	(reverse (vl-string->list str))
)
 )
 )
 (angtof
(vl-list->string
 	(reverse
(vl-string->list
(strcat "\"" (substr ret 1 2) "'" (substr ret 3 2) "d" (substr ret 5))
   	)
 	)
)
 )
)

(if (not func) (setq func + #func " + "))
(setq key (getstring (strcat "\nEnter an option  <" #func">: ")))
(cond
 ((member key '("-" "_")) (setq #func " - ") (setq func -))
 ((member key '("+" "=")) (setq #func " + ")(setq func +))
)

(while
 (and  func
(setq e1 (car (entsel "\nChon text 1 <Exit>:?")))
(setq e1 (s2d (cdr (assoc 1 (setq e (entget e1))))))
(setq e2 (car (entsel (strcat "\nChon text 2  <Exit>:"))))
(setq e2 (s2d (cdr (assoc 1 (entget e2)))))
(setq p (Getpoint "\nDiem chen ket qua <exit>:"))
)
  	(setq e (subst (cons 10 p) (assoc 10 e) e))
  	(setq e (subst (cons 1  (angtos (func e1 e2) 1 4)) (assoc 1 e) e))
  	(entmake e)
 )
)

 

Thanks bạn rất nhìu. đúng như ý mìnhrùi.


<<

Filename: 169147_demo.lsp
Tác giả: whatcholingon
Bài viết gốc: 169200
Tên lệnh: demo
Lisp cộng trừ text độ, phút, giây...

 

Bạn xem cái này vừa ý không.

Format:

Space: 123 00 00

Dot: 123.0000

Comma: 123,0000

Dash:...

>>

 

Bạn xem cái này vừa ý không.

Format:

Space: 123 00 00

Dot: 123.0000

Comma: 123,0000

Dash: 123-00-00

Degress:123d00'00"

 

Toán tử: +, -

 

 

Nếu bỏ qua thì format và toán tử sẽ lấy lần nhập trước. Cái này có kiểm tra phím nhập, do đó khi nhập toán tử bạn phải nhập đúng ký tự +, -

 


(defun c:demo (/ e e1 e2 key #func)
(defun s2d (str / ret)
 (setq ret
 (vl-list->string
(vl-remove-if
 	'(lambda (x) (or (< x 48) (> x 57)))
 	(reverse (vl-string->list str))
)
 )
 )
 (angtof
(vl-list->string
 	(reverse
(vl-string->list
(strcat "\"" (substr ret 1 2) "'" (substr ret 3 2) "d" (substr ret 5))
   	)
 	)
)
 )
)
(defun format (value fm / lst mm ss)
(setq ss (vl-list->string (cdr (member 39 (vl-string->list value)))))
(if (= (strlen ss) 2) (setq value (strcat (substr value 1 (- (strlen value) 2)) "0" ss)))
(setq mm (vl-list->string (cdr (member 100 (vl-string->list value)))))
(if (= (strlen mm) 5) (setq value (strcat (substr value 1 (- (strlen value) 5)) "0" mm)))

 (setq lst '(("Space" . 32)
  	("dOt" . 46)
  	("Comma" . 44)
  	("dAsh" . 45)
 	)
 )
 (setq fm (cdr (assoc fm lst)))
 (cond
((member fm '(32 45))
(vl-list->string
 	(subst fm
 	100
 	(subst fm 39 (vl-remove 34 (vl-string->list value)))
 	)
))
((member fm '(44 46))
(vl-list->string
 	(subst fm
 	100
 	(vl-remove 39 (vl-remove 34 (vl-string->list value)))
 	)
))
(T value)
 )
)

(if (null func) (setq func +))
(if (null fm) (setq fm "Degress"))
(setq key T)
(while (not (member key '("-" "+" nil)))
(setq #func  (chr (cadr (reverse (vl-string->list (vl-princ-to-string func))))))
(initget "Degress Space dOt Comma dAsh + -")
(setq key (getkword (strcat "\nEnter an option <Default: "#func"/"fm">:")))
(cond
  ((member key '("-" "+")) (setq func (eval (read key))) nil)
  (T (setq fm key))
)
)

(while
 (and

(setq e1 (car (entsel "\nEnter Text 1 <Exit>:")))
(setq e1 (s2d (cdr (assoc 1 (setq e (entget e1))))))
(setq e2 (car (entsel (strcat "\nEnter Text 2  <Exit>:"))))
(setq e2 (s2d (cdr (assoc 1 (entget e2)))))
(setq p (Getpoint "\nDiem chen ket qua <exit>:"))
)
  	(setq e (subst (cons 10 p) (assoc 10 e) e))
  	(setq e (subst (cons 1  (format (angtos (func e1 e2) 1 4) fm)) (assoc 1 e) e))
  	(entmake e)
 )
 (princ)
)

 

Qủa là tuyệt. mún thanks bạn nhìu mà chỉ pick được có mỗi cái bạn ạ.

Thanks bạn nhiu nhiu...


<<

Filename: 169200_demo.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 424442
Tên lệnh: ha
không join bằng lệnh pe được !!

Trường hợp của bạn 8 Pline trong tổng số 17 đã có UCS với Z=-1 (có thể do mirror3D)

Extrusion direction relative to UCS:
                   X=   0.0000  Y=   0.0000  Z=  -1.0000

Để khắc phục (đưa UCS về với Z=0) bạn dùng lisp dưới đây, sau đó join vô tư.

P/S: có thể Cad đời cao nó nối được. Tôi dùng cad2007 thì phải dùng biện pháp này.

>>

Trường hợp của bạn 8 Pline trong tổng số 17 đã có UCS với Z=-1 (có thể do mirror3D)

Extrusion direction relative to UCS:
                   X=   0.0000  Y=   0.0000  Z=  -1.0000

Để khắc phục (đưa UCS về với Z=0) bạn dùng lisp dưới đây, sau đó join vô tư.

P/S: có thể Cad đời cao nó nối được. Tôi dùng cad2007 thì phải dùng biện pháp này.


(defun C:HA(/ ss)
 (if (setq ss (ssget '((0 . "LWPOLYLINE") (210 0.0 0.0 -1.0))))
  (command "mirror3d" ss "" "XY" '(0 0 0) "y"))
 (princ))

 


<<

Filename: 424442_ha.lsp
Tác giả: proconeng86
Bài viết gốc: 303662
Tên lệnh: xrefbind
Lisp Bind Xref các bản vẽ đang mở

 

Tên topic không hợp lệ, nhưng hơn hai tuần rồi topic vẫn còn (không bị xóa) chắc là mod bỏ qua rồi.

gửi bạn Lisp...

>>

 

Tên topic không hợp lệ, nhưng hơn hai tuần rồi topic vẫn còn (không bị xóa) chắc là mod bỏ qua rồi.

gửi bạn Lisp bind xref cho file hiện hành.

Nếu OK thì việc dùng cho các file đang mở chỉ là chuyện nhỏ.

(defun c:XrefBind ()
  (vlax-map-Collection (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object)))
    '(lambda (b)
       (if (= (vla-get-IsXRef b) :vlax-true)
	 (vl-catch-all-error-p
	   (vl-catch-all-apply 'vla-bind (list b :vlax-true)  ) )  )  )  ))

 

Mình đã dùng thử lisp và thấy rất hay nhưng lisp có 1 hạn chế. Đó là những layer đã bị đóng băng hay tắt đi rồi nhưng khi dùng lisp để bind ra thì nó lại hiện hết cả ra, làm bản vẽ không đúng như ban đầu nên không dùng được nữa. bạn có thể sửa lỗi đó không?


<<

Filename: 303662_xrefbind.lsp
Tác giả: girl
Bài viết gốc: 187433
Tên lệnh: sct
Sửa Lisp xoay thành scale đối tượng tại tâm

Trong lúc bác Tue_NV đi vắng, tạm thời giúp bạn vậy. Lisp này scale các loại đối tượng: Circle, Block, Donut, Rectangle.

>>

Trong lúc bác Tue_NV đi vắng, tạm thời giúp bạn vậy. Lisp này scale các loại đối tượng: Circle, Block, Donut, Rectangle.

;by Tue_NV + Doan Van Ha CADViet.com
(defun c:SCT(/ ci tl n i)
(prompt "\n Moi ban chon CIRCLE/DONUT/BLOCK")
(setq ci (ssget '((0 . "CIRCLE,LWPOLYLINE,INSERT"))))
(setq tl (getreal "\n Nhap ti le scale :") n (sslength ci) i 0)
(while (< i n)
 (setq ent (ssname ci i))
 (if (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
  (command "scale" ent "" (centre ent) tl)
  (command "scale" ent "" (cdr (assoc 10 (entget ent))) tl))
 (setq i (1+ i)))
(princ))
;-----
(defun centre(dt / cen)
(vl-load-com)
(if (or (= (cdr (assoc 0 (entget dt))) "REGION")
       	(and (wcmatch (cdr (assoc 0 (entget dt))) "*POLYLINE")
	(= (cdr (assoc 70 (entget dt))) 1)))
  	(if (and (wcmatch (cdr (assoc 0 (entget dt))) "*POLYLINE")
	(= (cdr (assoc 70 (entget dt))) 1))
       	(progn
			(setq cen (vlax-get (car (vlax-invoke (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
	                                  			'addregion (list (vlax-ename->vla-object dt)))) 'Centroid))
			(entdel (entlast)))
       	(setq cen (vlax-get (vlax-ename->vla-object dt) 'Centroid))))  
cen)

Anh DVH ạ ! Cái lisp này khá hay nhưng mà còn hạn chế như sau ? Không thể chọn nhiều đối tượng để scale được 1 lần. Anh sửa sao cho lisp có thể scale nhiều đối tượng tại tâm của mỗi đối tượng được ko ạ ? (Chắc là yêu cầu này hơi khó nhưng mà rất cần thiết ).


<<

Filename: 187433_sct.lsp
Tác giả: dothanhdatvtchd
Bài viết gốc: 215612
Tên lệnh: ha
Lisp tính tổng độ dài đoạn thẳng.

Viết nhanh cho bạn đây.


;Doan Van Ha - CADViet.com - Ngay 22/4/2012
;Muc dich: Tinh tong chieu dai cac doi tuong, ghi len...
>>

Viết nhanh cho bạn đây.


;Doan Van Ha - CADViet.com - Ngay 22/4/2012
;Muc dich: Tinh tong chieu dai cac doi tuong, ghi len text, ghi ra file.
(defun C:HA ()
(vl-load-com)
(setq lst '())
(while (setq ss (ssget '((0 . "*LINE,ARC,CIRCLE,ELLIPSE"))))
 (setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
 (setq cdai 0)
 (foreach ent entlst
  (setq cdai (+ cdai (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))))
 (setq a (assoc 1 (entget (setq ent (car (entsel "Chon Text de nhap chieu dai..."))))))
 (entmod (subst (cons 1 (rtos cdai 2 2)) a (entget ent)))
 (setq lst (cons cdai lst)))
(if (not ss)
 (progn
  (initget "Y N")
  (setq ghi (getkword "\nGhi ra file <Y>: "))
  (if (or (= ghi "Y") (= ghi nil))
   (progn
	(setq fn (getfiled "Chon file de xuat ket qua" "" "txt" 1))
	(setq pw (open fn "w"))
	(setq z 0 lst (reverse lst))
	(repeat (length lst)
     (princ (strcat "Tong " (itoa (1+ z)) " = " (rtos (nth z lst) 2 2) "\n") pw)
     (setq z (1+ z)))
	(close pw)))))
(princ))

 

Viết nhanh cho bạn đây.


;Doan Van Ha - CADViet.com - Ngay 22/4/2012
;Muc dich: Tinh tong chieu dai cac doi tuong, ghi len text, ghi ra file.
(defun C:HA ()
(vl-load-com)
(setq lst '())
(while (setq ss (ssget '((0 . "*LINE,ARC,CIRCLE,ELLIPSE"))))
 (setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
 (setq cdai 0)
 (foreach ent entlst
  (setq cdai (+ cdai (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))))
 (setq a (assoc 1 (entget (setq ent (car (entsel "Chon Text de nhap chieu dai..."))))))
 (entmod (subst (cons 1 (rtos cdai 2 2)) a (entget ent)))
 (setq lst (cons cdai lst)))
(if (not ss)
 (progn
  (initget "Y N")
  (setq ghi (getkword "\nGhi ra file <Y>: "))
  (if (or (= ghi "Y") (= ghi nil))
   (progn
	(setq fn (getfiled "Chon file de xuat ket qua" "" "txt" 1))
	(setq pw (open fn "w"))
	(setq z 0 lst (reverse lst))
	(repeat (length lst)
     (princ (strcat "Tong " (itoa (1+ z)) " = " (rtos (nth z lst) 2 2) "\n") pw)
     (setq z (1+ z)))
	(close pw)))))
(princ))

Bác Ha ạ. Có vài điểm chưa đúng lắm bác ạ:

1. Lisp trên tính chiều dài theo tỉ lệ 1:1

2. Ý em thì các bước là: Tính tổng chiều dài lần 1, sửa vào text 1, tiếp theo tính chiều dài lần 2 luôn, sửa lần 2, rồi tính chiều dài lần 3 luôn, sửa lần 3 luôn... Khi muốn kết thúc thì gõ dấu cách( sau khi sửa text), rồi hỏi: Có lưu không.

Bác giúp em lần nữa với/

Thanks bác


<<

Filename: 215612_ha.lsp
Tác giả: minhphuong_humg
Bài viết gốc: 187849
Tên lệnh: vec
Làm sao để thay thế (đối tượng bằng wipeout) ?

Lisp bác Bình khi di chuyển thì mất tính năng "đè"

Quick code cho bạn

Bạn thử xem :



(defun c:vec(/ ename...
>>

Lisp bác Bình khi di chuyển thì mất tính năng "đè"

Quick code cho bạn

Bạn thử xem :



(defun c:vec(/ ename i ss ssnc)
 (command "undo" "be")
 (if (setq ss (ssget '((0 . "CIRCLE") (8 . "stt"))) i -1)
 (Progn
   (setvar "clayer" "stt")
 (Repeat (sslength ss)
   (setq ename  (ssname ss (setq i (1+ i))))
   (if (= (cdr(assoc 0 (entget ename))) "CIRCLE")
     (progn
  	(command ".polygon" "360" (cdr(assoc 10 (entget ename)))
"I" (cdr(assoc 40 (entget ename))))
(setq ssnc (ssget "cp" (ACET-GEOM-VERTEX-LIST (entlast))
'((0 . "*LINE,*TEXT") (8 . "stt")) ))
(command ".wipeout" "p" "L" "y")

(entdel ename)
;(command ".draworder" (entlast) "" "a" ssnc "")
  	(command ".draworder" ssnc "" "a" (entlast) "")
   )
 )
 (command "undo" "end")

   )
)
)
)

Chú ý : Vòng tròn, Line và Text trong vòng tròn nằm ở Layer "STT"

Ui, anh ơi. Hôm nay em sử dụng lại có trường hợp xảy ra là với cái vòng tròn ở trên "Tử" là cái số thứ tự, dưới "Mẫu" là cái chiều cao cột; còn cái ở giữa là cái đường ngăn cách (Polyline). Em dùng lisp với lệnh VEC thì nó hiện lên hết; trừ cái "đường ngăn cách đó" là lại bị mất đi. Xin anh hướng dẫn. Trân trọng cảm ơn.

File:http://www.cadviet.com/upfiles/3/0_khongdetext.rar


<<

Filename: 187849_vec.lsp
Tác giả: pawuta
Bài viết gốc: 345518
Tên lệnh: thkl
Nhờ viết lisp thông kê giá trị trong block ATT

 

Hề hề hề,

Cám ơn bạn nhiều. Sở dĩ mình không hiểu vì lâu nay mình chỉ xài CAD2004 nên nó không có cái...

>>

 

Hề hề hề,

Cám ơn bạn nhiều. Sở dĩ mình không hiểu vì lâu nay mình chỉ xài CAD2004 nên nó không có cái field này. Do vậy khi mỡ bản vẽ của bạn thì nó không hiện giá trị số mà chỉ hiện nội dung dòng text như công thức của bạn. Do vậy mình chưa biết cách làm.

Mình mới dùng CAD2008 để mở thử thì thấy nó đã hiện giá trị số và căn cứ vào đó mình làm cái lisp như dưới đây để bạn dùng thử coi có đúng ý bạn không nhé.

Do mình mới tập tọe xài CAD2008 nên không rõ nó có phù hợp với của bạn hay không. Nếu có gì chưa được thì hãy post lên để mình test lại.

(DEFUN C:THKL (/ ssl dtl dtt e1 e2 e3 ltt et goc)
(setq ssl (acet-ss-to-list (ssget (list (cons 0 "insert") (cons 66 1)))))
(setq dtl (cdr (assoc 1 (entget (setq e1 (car (nentsel "\n Chon thuoc tinh loc")))))))
(setq goc 0)
(setq dtt (cdr (assoc 2 (entget (setq e2 (car (nentsel "\n Chon thuoc tinh can tinh")))))))
(setq ltt (list))
(foreach e ssl
    (setq et (entnext e))
    (while (/= (cdr (assoc 0 (entget et))) "SEQEND")
            (if (and (= (cdr (assoc 1 (entget et))) dtl) (= (cdr (assoc 2 (entget et))) (cdr (assoc 2 (entget e1)))))                          
                (setq ltt (append ltt (list e)))
            )
            (setq et (entnext et))
    )
)
(foreach e ltt
     (setq et (entnext e))
     (while (/= (cdr (assoc 0 (entget et))) "SEQEND")
              (if (= (cdr (assoc  2 (entget et))) dtt)
                  (setq goc (+ goc (atof (cdr (assoc 1 (entget et))))))
              )
              (setq et (entnext et))
      )
)
(entmod (subst (cons 1 (rtos goc 2 2)) (assoc 1 (entget (setq e3 (car (nentsel "\n Chon text can thay the"))))) (entget e3)))
(entupd e3)
)

Oke, lisp chạy rất tốt, đúng với yêu cầu mình đề ra luôn, hehe!

Bạn giúp mình thêm phần link giá trị kết quả khi thay đổi giá trị các att nguồn nhé. Cảm ơn bạn rất nhiều!


<<

Filename: 345518_thkl.lsp

Trang 254/303

254