Jump to content
InfoFile
Tác giả: tuvanthietke.hcm
Bài viết gốc: 118521
Tên lệnh: mcd
Tổng hợp LISP và nhờ các cao thủ CHỈNH SỬA
Mình sửa cho bạn nè

;;LE QUOC VIET ; 2/8/2002
; CHUONG TRINH VE MC DAM
(defun c:MCD (/ A B C BV D E D1 E1 F P1 P2 S)
(setq oldosmode (getvar "osmode"))
      ...
>>
Mình sửa cho bạn nè

;;LE QUOC VIET ; 2/8/2002
; CHUONG TRINH VE MC DAM
(defun c:MCD (/ A B C BV D E D1 E1 F P1 P2 S)
(setq oldosmode (getvar "osmode"))
       (setvar "osmode" 0)
       (setq 
	A (getreal "\nBe rong mc DAM:")
	B (getreal "\nBe dai mc DAM:")
	S (getreal "\nBe day san:")
	BV (getreal "\nLop bv mc DAM:")
	D (getint "\nS.luong thep ngang mc DAM:")
	E (getint "\nS.luong thep doc mc DAM:")
	P1 (getpoint  "\nDiem chen:")
               F (/ A 20)
		D1 (/ (- A (* 2 BV) (* F 2)) (- D 1))
	E1 (/ (- B (* 2 BV) (* F 2)) (- E 1))
       ); end of setq
(command ".rectangle" "f" (* bv 0.5) (list (+ (car P1) BV) (+ (cadr P1) BV)) 
			(list (+ (car P1) (- A BV)) (+ (cadr P1) (- B BV))) 				"" "f" "0" ""
	".change" "L" "" "P" "C" 1 ""
	".pline" (Polar P1 0 (/ A 2)) "W" 0 0 	
				P1
(setq P11 (list (car P1) (+ (cadr P1) (- B S))))
(setq P11 (list (- (car P11) (* 2 S)) (cadr P11)))
(list (car P11) (- (cadr P11) (* 0.4 S)))
(setq P11 (list (car P11) (+ (cadr P11) (* 0.4 S))))
(setq P11 (list (- (car P11) (* 0.4 S)) (cadr P11)))
(setq P11 (list (+ (car P11) (* 0.8 S)) (+ (cadr P11) (* 0.2 S))))
(setq P11 (list (- (car P11) (* 0.4 S)) (cadr P11)))
(list (car P11) (+ (cadr P11) (* 0.8 S)))
(setq P11 (list (car P11) (+ (cadr P11) (* 0.4 S))))
(setq P11 (list (+ (car P11) (* 2 S) (/ A 2)) (cadr P11)))
                          ""
	".mirror" "L" "" (Polar P1 0 (/ A 2)) P11 ""
               ".pedit" "l" "j" "p" "l" "" ""

       ); end of command
       (setq 	P2 (list (+ (car P1) BV F) (+ (cadr P1) BV F)))
    	(repeat D 
	(command ".donut" 0 F P2 ^C)
       	(setq P2 (polar P2 0 D1))
     	); end of repeat1
       (setq 	P2 (list (+ (car P1) BV F) (+ (cadr P1) (- B BV F) )))
    	(repeat D 
	(command ".donut" 0 F P2 ^C)
       	(setq P2 (polar P2 0 D1))
     	); end of repeat2
       (setq 	P2 (list (+ (car P1) BV F) (+ (cadr P1) BV F)))
       (repeat (- E 2)
      		(setq P2 (polar P2 (/ pi 2)  E1))
	(command ".donut" 0 F P2 ^C)
       ); end of repeat3
 	(setq 	P2 (list (+ (car P1) (- A BV F)) (+ (cadr P1) BV F)))
	(repeat (- E 2)
      		(setq P2 (polar P2 (/ pi 2)  E1))
	(command ".donut" 0 F P2 ^C)
       ); end of repeat3
(setvar "osmode" oldosmode)
)

 

Cảm ơn bạn!

 

Mình có thể làm chách nào để chỉnh size của hình chấm tròn (thép) đó cảm ơn.

 

Tiện thể có bạn nào có lisp vẽ mc dọc của dầm không (không phải mcngang nhé) cảm ơn


<<

Filename: 118521_mcd.lsp
Tác giả: hanh.phuc
Bài viết gốc: 430352
Tên lệnh: ccd
Nhờ các Bro sửa lips cao độ
(defun c:ccd ( / bo bn )
  (setq bn "CD4H")
  (if (and c:kb (tblsearch "BLOCK" bn ))
  (while (setq dchon (getpoint "\nSpecify point: "))
    (setq cddc (+ cdg (/ (- (cadr dchon) (cadr dgoc)) tyle)))
    (and (setq bo (vla-InsertBlock
               (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
               (vlax-3d-point (trans dchon 1 0))
               bn 1.0 1.0 1.0 0.0
               )
          )
    (vlax-get-property bo 'hasAttributes)
   ...
>>
(defun c:ccd ( / bo bn )
  (setq bn "CD4H")
  (if (and c:kb (tblsearch "BLOCK" bn ))
  (while (setq dchon (getpoint "\nSpecify point: "))
    (setq cddc (+ cdg (/ (- (cadr dchon) (cadr dgoc)) tyle)))
    (and (setq bo (vla-InsertBlock
               (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
               (vlax-3d-point (trans dchon 1 0))
               bn 1.0 1.0 1.0 0.0
               )
          )
    (vlax-get-property bo 'hasAttributes)
    (mapcar '(lambda (a b) (and a b (vla-put-textstring a b))) (vlax-invoke bo 'GetAttributes) (list (rtos cddc 2 tp) ))
         )
    )
    (alert "\nKhông có gì block \"CD4H\", or KB.lsp not loaded!")
  )
  (princ)
  )

 


<<

Filename: 430352_ccd.lsp
Tác giả: 790312
Bài viết gốc: 162564
Tên lệnh: oo
Lệnh offset đặc biệt

Của bạn đây :

(defun c:oo (/ ss objlst dist entlst1 entlst2 kwrd)
(grtext -1 "Free from CADviet @ketxu")
(or #dist(setq #dist...
>>

Của bạn đây :

(defun c:oo (/ ss objlst dist entlst1 entlst2 kwrd)
(grtext -1 "Free from CADviet @ketxu")
(or #dist(setq #dist 110))
(setq dist (getdist (strcat "\nKho\U+1EA3ng c\U+00E1ch Offset : < " (rtos #dist 2 1) " >: ")))
(if dist (setq #dist dist))
(princ "\nCh\U+1ECDn c\U+00E1c \U+0111\U+1ED1i t\U+01B0\U+1EE3ng Offset :")
(setq ss (ssget '((0 . "LWPOLYLINE,LINE,ARC,CIRCLE,ELLIPSE,SPLINE"))))
(if ss
(progn
(setq objlst (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
(initget (+ 2 4) "c k")
(setq kwrd (getkword "\nX\U+00F3a \U+0111\U+1ED1i t\U+01B0\U+1EE3ng g\U+1ED1c kh\U+00F4ng ?   "))
(if (null kwrd)
(setq kwrd "K")
)
(foreach obj objlst
(vla-offset obj #dist)
(setq entlst1 (cons (vlax-ename->vla-object (entlast)) entlst1)) 
(vla-offset obj (* #dist -1))
(setq entlst2 (cons (vlax-ename->vla-object (entlast)) entlst2))
(mapcar '(lambda (x) (vla-put-layer x (getvar "clayer"))) entlst1)
(mapcar '(lambda (x) (vla-put-layer x (getvar "clayer"))) entlst2)
(if (eq kwrd "C")
(vla-erase obj)
)
)
)
)
(princ)
)

 

Chú ý là nếu bước hỏi có xóa đối tượng gốc hay không, bạn có thể ấn Space (mặc định là không )

Khi hỏi có xoá đối tượng gốc hay không?Nhấn C thì nó vẫn không xoá đối tượng gốc.Nhờ bạn xem lại giúp.Thanks.

 

Đã up lại code


<<

Filename: 162564_oo.lsp
Tác giả: lengan
Bài viết gốc: 121151
Tên lệnh: c
cách chọn đối tượng vừa được copy ra ?

Thế thì dùng tí lisp vào vậy.

Với cách này sau khi sử dụng lệnh copy xong,sẽ selection các đối tượng vừa copy.Bạn cứ thao tác bình thường.Muốn thực hiện lệnh gì với...

>>
Thế thì dùng tí lisp vào vậy.

Với cách này sau khi sử dụng lệnh copy xong,sẽ selection các đối tượng vừa copy.Bạn cứ thao tác bình thường.Muốn thực hiện lệnh gì với các đối tượng này thì dùng tham số p

VÍ dụ Sau khi copy xong,bạn muốn đặt các đối tượng ra chỗ kác thì : move -> p

Tron code mình đặt mặc định c là copy,bạn có thể change nếu thấy dùng thích hợp

(defun c:c (/ ss)
 (and (setq ss (AT:Copy))
      (command "_.select" ss )
 ) 
) 

(defun AT:Copy (/ #SS #Pnt1 #Pnt2 #Pnts #SSAdd #Copy)
 (vl-load-com)
 (cond
   ((and (setq #SS (ssget "_:L"))
         (setq #Pnt1 (getpoint "\nSpecify base point: "))
         (setq #Pnt2 (acet-ss-drag-move #SS #Pnt1 "\nSpecify placement point: " T))
    ) ;_ and
    (or *AcadDoc* (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
    (setq #Pnts (mapcar '(lambda (x) (vlax-3d-point (trans x 1 0)))
                        (list #Pnt1 #Pnt2)
                ) ;_ mapcar
    ) ;_ setq
    (setq #SSAdd (ssadd))
    (vlax-for x (setq #SS (vla-get-activeselectionset *AcadDoc*))
      (ssadd (vlax-vla-object->ename (setq #Copy (vla-copy x))) #SSAdd)
      (vla-move #Copy (car #Pnts) (cadr #Pnts))
    ) ;_ vlax-for
    (vl-catch-all-apply 'vla-delete (list #SS))
   ) ;_ cond
 ) ;_ cond
 #SSAdd
) 

 

 

Thank anh ketxu, hồi mới tham gia diễn đàn em em có hỏi câu hỏi này và cũng nhận được một số trả lời o topic nay

http://www.cadviet.com/forum/index.php?sho...amp;#entry16767


<<

Filename: 121151_c.lsp
Tác giả: SoftvnBin
Bài viết gốc: 207741
Tên lệnh: tko
Lisp lọc các số sau chữ L, rồi tính tổng.

Hề hề hề,

Bạn dùng thử cái này coi đã ưng ý chưa nhé.

Cái này được viết theo yêu cầu của người khác nên...

>>

Hề hề hề,

Bạn dùng thử cái này coi đã ưng ý chưa nhé.

Cái này được viết theo yêu cầu của người khác nên cách dùng có khác với cách bạn trình bày.

1/- Gõ lệnh tko

2/- Quét chọn toàn bộ vùng chứa các text mà bạn muốn tính.

3/- Nhập giá trị đường kính mà bạn muốn tính

4/- Lisp trả ra kết quả tổng chiều dài các đoạn ống có đường kính đã chọn và nằm trong vùng chọn của bạn.

5/- Nếu muốn lisp có thể thay thế giá trị này vào một text đã có trên bản vẽ của bạn.

 

Hãy dùng thử và nếu có ý kiến gì thì post lên mình sẽ sửa lại.

 

 (defun c:tko ( / sst L DK n els )(command "undo" "be")(setq sst (acet-ss-to-list (ssget (list (cons 0 "text") (cons 8 "chu_thich") (cons 1 "*L#*")))))(setq L 0)(setq DK (getstring "\n Nhap loai ong can tinh tong chieu dai: ")          n (strlen DK))(foreach en sst(setq els (entget en))(cond   	((= (substr (cdr (assoc 1 els)) 1 n)  DK)        (setq L (+ L  (atof (substr (cdr (assoc 1 els)) (+ n 3))))) ) 				(T nil)))(alert (strcat "\n Tong chieu dai ong duong kinh " DK " la: "  (rtos L 2 2) "m"))   (if (= (strcase (getstring "\n Ban muon chon text ghi ket qua <y or n>: ")) "Y") 	(progn 	(setq els (entget (car (entsel "\n Chon text can thay the "))))   		(entmod (subst (cons 1 (rtos L 2 2)) (assoc 1 els) els)) 	))  (command "undo" "e")(princ))

 

Chúc bạn vui...

 

Nhờ các bạn giúp mình sửa như sau:

 

1. Nhập tên lệnh: AAA

2. Chọn vùng tính toán

3. Pick vị trí đặt bảng <đỉnh mép trái>:

4. Ghi chú: Lisp chỉ chọn các *text có định dạng chung là "*** D***, L = *****m

Kết quả sẽ cho ra như sau:

17200_thong_ke_ong_nuoc_1.jpg

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


<<

Filename: 207741_tko.lsp
Tác giả: dothanhdatvtchd
Bài viết gốc: 215611
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))

Rất cảm ơn bác. Chưa test nhưng em cảm ơn vì muộn rồi mà bác còn nhiệt tình vậy :D Cảm ơn bác


<<

Filename: 215611_ha.lsp
Tác giả: daotukl
Bài viết gốc: 39880
Tên lệnh: cbl1
insert block theo khoảng cách cho trước và nằm giữa hai điểm
Lệnh là CBL1 dưới đây giống CBL ngoại trừ trường hợp khi khoảng cách giữa 2 điểm không chẵn với khoảng cách giữa hai block thì chương trình sẽ trừ khoảng...
>>
Lệnh là CBL1 dưới đây giống CBL ngoại trừ trường hợp khi khoảng cách giữa 2 điểm không chẵn với khoảng cách giữa hai block thì chương trình sẽ trừ khoảng trống hai bên bằng nhau:

(defun c:cbl1 (/ tmp ok p1 p2 kc cur l)
 (princ "\nCBL - free lisp from CADViet.com")
 (if (not bln)
   (setq bln "*")
 )
 (while (not ok)
   (setq tmp (getstring t
		 (strcat "\nTen block, nhap dau * de pick block: <"
			 (if bln
			   bln
			   ""
			 )
			 ">: "
		 )
      )
  tmp (if (or (not tmp) (= tmp ""))
	bln
	tmp
      )
  ok  (or (tblsearch "block" tmp) (= tmp "*"))
   )
   (if	(not ok)
     (alert (strcat "Khong co block "
	     (if tmp
	       tmp
	       ""
	     )
     )
     )
   )
 )

 (if (= tmp "*")
   (setq
     tmp (cdr
    (assoc 2 (entget (car (entsel "\nHay pick vao block: "))))
  )
   )
 )

 (setq	p1 (getpoint "\nHay vao diem thu nhat: ")
p2 (trans (getpoint p1 "\nHay vao diem thu hai: ") 1 0)
kc (getdist p1 "\nHay vao khoang cach: ")
p1 (trans p1 1 0)
 )

 (setq	bln tmp	
a   (angle p1 p2)
l   (distance p1 p2)
cur (/ (- l (* kc (float (fix (/ l kc))))) 2.0)
 )
 (if (< kc 0)
   (setq kc (/ l kc -1.0))
 )
 (while (> l (- cur 0.001))
   (entmake (list (cons 0 "insert")
	   (cons 10 (polar p1 a cur))
	   (cons 2 bln)
     )
   )
   (setq cur (+ cur kc))
 )  
 (princ)
)

THANKS bác nhiều


<<

Filename: 39880_cbl1.lsp
Tác giả: ainhandilac
Bài viết gốc: 5693
Tên lệnh: co
Lisp tăng số trong text nhưng chỉ được tối đa 100

Mình đã chỉnh lại, copy đến 999..

(defun ketthuc ()
(setvar	"cmdecho"	luuecho)
(setq...
>>
Mình đã chỉnh lại, copy đến 999..

(defun ketthuc ()
(setvar	"cmdecho"	luuecho)
(setq *error*	luu
	luu		nil	
	luuecho	nil
);setq
(princ)
)		
;*********************************************************************
(defun modau ()
(setq 	luu *error
	luuecho	(getvar	"cmdecho")
	*error	(ketthuc)
)
)
;*********************************************************************
(defun xulytext (text / kytu ma sokt luusokt lui )
(setq 	kytu	(substr text (strlen text))
	ma	(ascii kytu)
	sokt	(read kytu) 
	lui	1
)
(if (numberp sokt)
	(progn
		(setq luusokt	(1+ sokt))
		(if (and 	(numberp sokt) 
				(> (strlen text) 1)
		    )	
		   (progn
			(setq 	kytu	(substr text (1- (strlen text)))
					sokt	(read kytu) 
									)
			(if 	(numberp sokt) 
				(setq luusokt (1+	sokt)
						lui 	2

					)
			)
		    );progn	
		)
		(if (= luusokt	100)	(setq 	luusokt	0))
		(setq 	kytu		(rtos luusokt 2 0)

				text	(strcat	(substr text 1 (- (strlen text) lui))  kytu)
		)
	);progn			 
	(if   (or 	(= kytu "z")
			(= kytu "Z")
		)
		(setq 	text		(strcat 	text	"0")
			textxl		"0"
		)
		(setq		ma	(1+	ma)
				text	(strcat	(substr text 1 (1- (strlen text)))  (chr ma))
		)
	);if
);if
)
;*********************************************************************
(defun doitext(tendoituong / chuoi doituong thoat tam dsach kieu text vitri10 vitri11 dem canle)
;Neu doi tuong la text thi tiep tuc
(setq 	doituong 	(entget  tendoituong)
kieu		(cdr (assoc 	0	doituong))
canle		(cdr (assoc 	72	doituong))
)	
(if (or (= kieu		"TEXT")
(= kieu 	"MTEXT")	
   ) 	
(progn
	(setq	textxl	(xulytext textxl)
		text	(cons 1 textxl)
		vitri10 	(cdr (assoc 10 doituong))
		vitri10 	(list (+ (car vitri10) (car vitrilech)) (+ (nth 1 vitri10) (nth 1 vitrilech)))
		vitri10		(cons 10 vitri10)
		vitri11 	(cdr (assoc 11 doituong))
		vitri11 	(list (+ (car vitri11) (car vitrilech)) (+ (nth 1 vitri11) (nth 1 vitrilech)))
		vitri11		(cons 11 vitri11)
		dem	0
		dsach	nil
	)
	(foreach tam 	doituong
		(cond
			((= (car tam)	1)	(setq dsach 	(append dsach (list text))))
			((= (car tam)	10)	(setq dsach 	(append dsach (list vitri10))))
			((= (car tam)	11)	(setq dsach 	(append dsach (list vitri11))))
			((setq dsach 	(append dsach (list tam))))
		)
	)
	(entmake dsach)
);progn
);if
);
;*********************************************************************
;sao doi tuong cu sang vi tri moi

(defun copy_dt (tendoituong )
(command "copy" tendoituong "" goc toi )
);defun

;*********************************************************************
(defun c:co ( / cumdt dodai thoat dem ten doituong textxl dem goc toi)
; Khoi dau cua chuong trinh
(princ "\nCopy Inteligent...\n")
(setq 	luuecho	(getvar	"cmdecho")
luu	*error*
*error*	ketthuc
cumdt 	(ssget)
dodai 	(sslength cumdt)
goc		(getpoint "\nSelect base point:")
thoat		nil
dem		0
textxl		nil
);
(setvar "cmdecho" 0)
; Loc ra duoc ong text de xu ly
(while	(and 	(= thoat	nil)
	(< dem	dodai)
)
(setq 	ten	(ssname cumdt dem)
	dem	(1+ 	dem)
	doituong (entget ten)
	kieu	 (cdr (assoc 	0	doituong))			
)

(if (or (= kieu		"TEXT")
	(= kieu 	"MTEXT")	
   	    )
	(setq 	thoat	T
		textxl 	(cdr (assoc 1 doituong)) 	
	)
)
);
(while T 
(setq	toi		(getpoint "\nSelect next point: " goc)
vitrilech 	(list 	(- (car toi) (car goc)) (- (nth 1 toi) (nth 1 goc)))
dem		0
)
(while	(< dem dodai)
(setq 	ten	(ssname cumdt dem)
	dem	(1+ 	dem)
	doituong (entget ten)
	kieu	 (cdr (assoc 	0	doituong))			
)

(if (or (= kieu		"TEXT")
	(= kieu 	"MTEXT")	
   	    )
	(doitext	ten)
	(copy_dt	ten)

);if
)
);while
(ketthuc)
);defun
(princ "Type \"DG\" to start")
;Note: bien toan cuc: textxl vitrilech

vẫn chưa đưoc pac thanhlamct oi, pac xem lại cho em cái


<<

Filename: 5693_co.lsp
Tác giả: quocmanh04tt
Bài viết gốc: 430480
Tên lệnh: tt+%C2%A0
Lỗi cho kết quả khác nhau khi dùng lệnh đo chiều dài Mline.
3 giờ trước, vantai3002 đã nói:

Chào mọi...

>>
3 giờ trước, vantai3002 đã nói:

Chào mọi người!

Mình dùng lệnh đo chiều dài đường Mline trong cad như file đính kèm nhưng cho kết quả khác nhau.

Mọi người tìm giúp mình nguyên do gì nó khác như vậy.

Cám ơn nhiều.

Drawing1.dwg

Tong kich thuoc ML - daimline.lsp

Cái thằng MLINE đó bất thường và lisp trên chưa xử lý trường hợp bất thường đó. Bạn dùng lisp này:

(defun c:tt  (/ massoc d e l s)
 (defun massoc  (k l / r)
  (if (and l (setq r (assoc k l)))
   (cons (cdr r) (massoc k (cdr (member r l))))))
 (cond ((not (and (setq s (ssget '((0 . "MLINE")))) (setq d 0))))
       ((while (setq e (ssname s 0))
         (setq l (massoc 11 (entget e))
               d (+ d (apply '+ (mapcar 'distance l (cdr l))))
               s (ssdel e s)))
        (princ "\nTong chieu dai cac MLine tren la: ")
        (princ d)))
 (princ))

 


<<

Filename: 430480_tt+%C2%A0.lsp
Tác giả: Ar_Chanwoo
Bài viết gốc: 15527
Tên lệnh: show
Giao diện hộp thoại trong AutoLisp
Kiểu này chuối lắm dùng file *.chm hoặc *.hlp hay hơn nhiều

code đây không biết có đúng ý bạn không?

Thuty.dcl:

(defun read-txt (filename /...
>>
Kiểu này chuối lắm dùng file *.chm hoặc *.hlp hay hơn nhiều

code đây không biết có đúng ý bạn không?

Thuty.dcl:

(defun read-txt (filename / open_f line_r list-out file_read)
(setq list-out nil)
(if (/= (findfile filename) nil)
 (progn  
 (setq file_read (open filename "r"))
 (while
 (/= nil
 (setq line_r (read-line file_read))
  )
 (setq list-out (append list-out (list line_r)))
  )
 (close file_read)
)
(princ)  
)
list-out
)
;;;;;;;;;;;;;;;
;==== Load and check dialog ===========
; dia_name : string
(defun loadcl ( dia_name)
 (if (= -1 (setq dcl_id (load_dialog (strcat dia_name ".dcl"))))
(progn
  (alert (strcat dia_name ".dcl" "not found")
  (setq dialogloaded nil)
)		 
);p
(setq dialogloaded 1)
);f
);defun
;;;;;;;;;;;=========================
(defun c:show (/ fname  l1  dcl_id dialogloaded)
 (setq fname (getfiled "chon file"  "c:\\"  "*" 16)); lựa chọn file
;(setq fname "c:\\abc\\abc.txt"); hoặc chỉ định file
 (if (and
(/= fname nil)
(> (loadcl "thuty") 0); load and check dialog 
  ) 
  (if (not (new_dialog "thuty" dcl_id))
 (exit); Error
 (progn;else
		(start_list "doctxt")	 
		(mapcar' add_list (read-txt fname))  
		(end_list)
		(start_dialog)						 
		(done_dialog)
	(unload_dialog dcl_id)
);p

  );if1 
  );if
 (princ)
);defun

Have fun

Anh có thể tạo giúp e trong list đó có các cột được không ! Ví dụ như là trong bảng layer thì có các cột là linetype, lineweight...e muốn trong bảng list box đó của e có các cột ma nội dung các cột chỉ là các text thôi!


<<

Filename: 15527_show.lsp
Tác giả: Bee
Bài viết gốc: 430560
Tên lệnh: cc
Lisp tính tổng độ dài
Vào lúc 20/10/2018 tại 09:40, Nguyễn Minh Chương đã nói:
>>
Vào lúc 20/10/2018 tại 09:40, Nguyễn Minh Chương đã nói:

Chào mọi người, mình không hiểu lắm về lisp cad nên nhờ mọi người giúp đỡ.

Mình có lisp tính tổng độ dài, hiện tại nó chỉ tính được đường Polyline và xuất kết quả ra 1 text đã có sẵn trên mặt bằng. Giờ mình muốn sửa lại lisp một tí là muốn nó tính được cả đường line và tự xuất ra text.

Mong mọi người giúp đỡ ạ. (file mình có đính kèm)

 

cc.lsp

Chỉnh lại lisp khác cho bạn dùng ^_^

(defun c:cc  (/ ss tl n ent itm obj l txt)
  (setq ss (ssget)
        tl 0
        n  (1- (sslength ss)))
  (while (>= n 0)
    (setq ent (entget (setq itm (ssname ss n)))
          obj (cdr (assoc 0 ent))
          l   (cond
                ((= obj "LINE")
                 (distance (cdr (assoc 10 ent)) (cdr (assoc 11 ent))))
                ((= obj "ARC")
                 (* (cdr (assoc 40 ent))
                    (if (minusp (setq l (- (cdr (assoc 51 ent))
                                           (cdr (assoc 50 ent)))))
                      (+ pi pi l)
                      l)))
                ((or (= obj "CIRCLE")
                     (= obj "SPLINE")
                     (= obj "POLYLINE")
                     (= obj "LWPOLYLINE")
                     (= obj "ELLIPSE"))
                 (command "_.area" "_o" itm)
                 (getvar "perimeter"))
                (t 0))
          tl  (+ tl l)
          n   (1- n)))
  
  (setq txt (car (entsel "Ch\U+1EC9 vào text c\U+1EA7n ghi: ")))
  
  (if (= (cdr (assoc 0 (entget txt))) "TEXT")
    (progn
      (setq txt (entmod (subst (cons 1 (strcat "L= " (rtos tl 2 0) " mm")) (assoc 1 (entget txt)) (entget txt))))

      (if (assoc 62 txt)
        (entmod (subst (cons 62 4) (assoc 62 txt) txt))
        (entmod (append txt (list (cons 62 4))))
        )
      )

    )
  (princ)
  )

 


<<

Filename: 430560_cc.lsp
Tác giả: Nguyen Hoanh
Bài viết gốc: 5463
Tên lệnh: stext
Lưu thông số giữa các lần dùng lệnh
đây là code:

đây là code:

http://www.cadviet.com/upfiles/lisp.rar

mình muốn như sau:

Bắu đầu lệnh: input name of this plate: (nhập) G1(giá trị này vòng lặp sau là G2)

input thick plate : 10 (giá trị này giữ lại cho vòng lặp sau)

 

Bạn xem đoạn code dưới đây, những phần tô màu đỏ là những đoạn mã lưu thông số giữa các lần sử dụng lệnh. Mỗi khi dùng lệnh, chương trình sẽ yêu cầu người sử dụng nhập vào giá trị của biến tyledong. Nếu nhấn enter, giá trị mặc định sẽ được chọn (giữ nguyên giá trị cũ). Bạn chạy thử chương trình rồi rút kinh nghiệm cho trường hợp cụ thể của mình. Cách sử dụng đoạn mã dưới đây bạn đọc thêm ở: http://www.cadviet.com/forum/index.php?sho...mp;st=260

 

(defun c:stext (/ sst lstent egoc pgoc xgoc yht zgoc linespc ee tt)
(if (not tyledong) (setq tyledong 1.5))
(princ "\nSap xep text © CADViet.com")
(setq sst (ssget '((0 . "TEXT")))
lstent (ss2ent sst)
tmp (getreal (strcat "\nVao ty le dong khoang cach dong : " ))
tyledong (cond (tmp tmp) (t tyledong))
lstent (vl-sort lstent
'(lambda (e1 e2)
(> (cadr (cdr (assoc 10 (entget e1))))
(cadr (cdr (assoc 10 (entget e2))))
)
)
)
egoc (car lstent)
lstent (cdr lstent)
pgoc (cdr (assoc 10 (entget egoc)))
xgoc (car pgoc)
yht (cadr pgoc)
zgoc (caddr pgoc)
hgoc (cdr (assoc 40 (entget egoc)))
linespc (* hgoc (+ 1.0 tyledong))

)
(foreach ee lstent
(setq tt (entget ee)
tt (subst (list 10
xgoc
(setq yht (- yht linespc))
zgoc
)
(assoc 10 tt)
tt
)
)
(entmod tt)
(entupd ee)
)
(princ)
)
(defun ss2ent (ss / sodt index lstent)
(setq
sodt (cond
(ss (sslength ss))
(t 0)
)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)
(princ
"\nSTEXT - Sap xep text - free lisp from www.cadviet.com"
)
(vl-load-com)


<<

Filename: 5463_stext.lsp
Tác giả: chuot8x_online
Bài viết gốc: 40298
Tên lệnh: vc
Bảng toạ độ các đỉnh thửa đất
Lisp có đủ 4 yêu cầu trên:

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;Chuong trinh danh so va lap bang toa do ho so thua dat dia...
>>
Lisp có đủ 4 yêu cầu trên:

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;Chuong trinh danh so va lap bang toa do ho so thua dat dia chinh
;;;Bang toa do tao thanh block, duoc dat ten theo so thu tu 1, 2, 3...
;;;Chap nhan cac doi tuong la Region, Polyline, Line va Arc khep kin
;;;Free utility - www.cadviet.com - September 2008 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;PUBLIC FUNCTIONS
;;;-------------------------------------------------------------------------------
(Defun DTR(x) (/ (* x pi) 180) ) ;;;change degree to radian, return REAL
;;;-------------------------------------------------------------------------------
(defun lineP (p0 a r / p1) ;;;Line polar: point, degree angle, radius
   (setq p1 (polar p0 (dtr a) r))
   (command "line" p0 p1 "")
)
;;;-------------------------------------------------------------------------------
(defun linePX (p0 x) (lineP p0 0 x)) ;;;Horizontal line: length x, from p0
;;;-------------------------------------------------------------------------------
(defun linePY (p0 y) (lineP p0 90 y)) ;;;Vertical line: length y, from p0
;;;-------------------------------------------------------------------------------
(defun getVert (e / i L) ;;;Return list of all vertex from pline e
(setq i 0 L nil)
(vl-load-com)
(repeat (fix (+ (vlax-curve-getEndParam e) 1))
   (setq L (append L (list (vlax-curve-getPointAtParam e i))))
   (setq i (1+ i))
)
L
)
;;;-------------------------------------------------------------------------------
(defun wtxtMC (txt p h) ;;;Write text Middle Center, specify text, point, height
(entmake (list (cons 0  "TEXT") (cons 7 (getvar "textstyle"))
   (cons 1 txt) (cons 10 p) (cons 11 p) (cons 40 h) (cons 72 1) (cons 73  2)))
)
;;;-------------------------------------------------------------------------------
(defun Collect(e / e2 SS) ;;;Selection set from e to entlast
(setq SS (ssadd))
(ssadd e SS)
(while (setq e2 (entnext e)) (ssadd e2 SS) (setq e e2))
SS
)
;;;-------------------------------------------------------------------------------
(defun Collect1(e / ss)
;;;Selection set after e to entlast. If e nil, select all from fist entity of drawing.
(if (= e nil) (setq ss (collect (entnext)))
(progn (setq ss (collect e)) (ssdel e ss))
)
)
;;;-------------------------------------------------------------------------------

;;;PRIVATE FUNCTIONS
;;;-------------------------------------------------------------------------------
(defun txt1(txtL / p1 p2 p3 p4 pL i) ;;;Write texts in 1 row
(setq
   p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))
   p2 (polar p1 0 (* 8 h))
   p3 (polar p2 0 (* 12 h))
   p4 (polar p3 0 (* 10 h))
   pL (list p1 p2 p3 p4)
   i 0
)
(repeat 4
   (wtxtMC (nth i txtL) (nth i pL) h)
   (setq i (1+ i))
)
)
;;;-------------------------------------------------------------------------------
(defun txt2(txtL / p1 p2 p3 p4 pL i) ;;;Write texts in 1 row
(setq
   p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))
   p2 (polar p1 0 (* 8 h))
   p3 (polar p2 0 (* 12 h))
   p4 (polar p3 0 (* 10 h))
p4 (polar p4 (* 0.5 pi) (* 1.5 h))
   pL (list p1 p2 p3 p4)
   i 0
)
(repeat 4
   (wtxtMC (nth i txtL) (nth i pL) h)
   (setq i (1+ i))
)
)
;;;-------------------------------------------------------------------------------
;;;MAIN PROGRAM
;;;-------------------------------------------------------------------------------
(defun C:VC( / h p et p0 p00 p01 p02 pt pvL n j pv num txtL ss bn)
;;;Vertex Co-ordinate

;;;GET TEXT HEIGHT
(if (not h0) (setq h0 1))
(setq h (getreal (strcat "\nChon chieu cao text <" (rtos h0) ">:")))
(if (not h) (setq h h0) (setq h0 h))

;;;PICK & BASE POINT
(setq p (getpoint "\nPick 1 diem giua mien kin:"))
(command "boundary" p "")
(setq et (entlast))
(redraw et 3)
(setq
   p00 (getpoint "\nDiem chuan bang toa do (phia tren ben trai):")
   p0 p00
p01 (polar p00 (* 1.5 pi) (* h 3))
   pvL (reverse (getvert et))
n (length pvL)
p02 (polar p01 (* 1.5 pi) (* n h 3))
   oldos (getvar "osmode")
)
(setvar "osmode" 0)

;;;HEADER
(linepx p0 (* 38 h))
(command "copy" "L" "" "m" p00 p01 p02 "")
(linepy p0 (* (+ n 1) -3 h))
(command "copy" "L" "" "m" p0 
   (list(+ (car p0) (* 4 h)) (cadr p0))
(list(+ (car p0) (* 16 h)) (cadr p0))
   (list(+ (car p0) (* 28 h)) (cadr p0))
   (list(+ (car p0) (* 38 h)) (cadr p0))
""
)

(txt1 (list "TT" "X (m)" "Y (m)" "S (m)"))
(setq p0 (polar p0 (* 1.5 pi) (* 3 h)))

;;;MAKE RECORDS
(setq j 0 pt nil)
(repeat n
   (setq
       pv (nth j pvL)
       num (itoa (1+ j))
)
(if pt (setq S (rtos (distance pt pv))) (setq S ""))
   (setq txtL (list num (rtos (cadr pv)) (rtos (car pv)) S))
   (txt2 txtL)
   (setq p0 (polar p0 (* 1.5 pi) (* 3 h)))
(setq pt pv)
   (setq j (1+ j))
(if (= j (- n 1)) (setq j 0))
)

;;;MAKE BLOCK
(setq ss (collect1 et))
(command "erase" et "")
(setq bn "1")
(while (tblsearch "block" bn) (setq bn (itoa (1+ (atoi bn)))))
(command "block" bn p00 ss "")
(command "insert" bn p00 "" "" "")

;;;WRITE POINT NAME
(setq j 0)
(repeat (1- n)
   (setq
       pv (nth j pvL)
       num (itoa (1+ j))
   )
   (wtxtMC num (polar pv 0 h) h)
   (setq j (1+ j))
)
;;;FINISH
(setvar "osmode" oldos)
(princ)
)
;;;-------------------------------------------------------------------------------

 

Góp ý:

Nếu có nhờ ai viết lisp, bạn nên nêu rõ và đủ các yêu cầu ngay từ đầu. Làm lần đầu không ngại nhưng sửa đi sửa lại... ngán lắm!

 

 

 

Rất cảm ơn bác SSG đã nhiệt tình giúp đỡ. Nhưng E có một yêu cầu nhỏ nữa được không ạ? trả là lisp của bác kết quả trả về tọa độ x,y là 4 số thập phân sau dấu phẩy, vậy muốn nó chỉ 1 hoặc 2 hoặc 3 số thập phân thôi thì phải làm thế nào ạ?


<<

Filename: 40298_vc.lsp
Tác giả: bktec84
Bài viết gốc: 110382
Tên lệnh: maaa
Lưu thông số giữa các lần dùng lệnh
Bạn xem đoạn code dưới đây, những phần tô màu đỏ là những đoạn mã lưu thông số giữa các lần sử dụng lệnh. Mỗi khi dùng lệnh, chương trình sẽ yêu cầu...
>>
Bạn xem đoạn code dưới đây, những phần tô màu đỏ là những đoạn mã lưu thông số giữa các lần sử dụng lệnh. Mỗi khi dùng lệnh, chương trình sẽ yêu cầu người sử dụng nhập vào giá trị của biến tyledong. Nếu nhấn enter, giá trị mặc định sẽ được chọn (giữ nguyên giá trị cũ). Bạn chạy thử chương trình rồi rút kinh nghiệm cho trường hợp cụ thể của mình. Cách sử dụng đoạn mã dưới đây bạn đọc thêm ở: http://www.cadviet.com/forum/index.php?sho...mp;st=260

Em không dành về lisp lắm lên ko hiểu và sửa được mong các bác sửa hộ em lisp sau với tỷ lệ nhập lưu lại từ lần nhập trước.

(defun c:maaa()
(setvar "cmdecho" 0)
(setq p1 nil p2 nil gmd nil)
(command "style" "Dientich" "Vntime.shx,vn1.shx" 0 "0.8" 0.0 "" "" "")
(command "layer" "make" "Text" "c" "3" "" "")
 (setq p1 (getpoint"\Diem dau cua mai doc: "))
 (setq p2 (getpoint"\Diem thu 2 cua mai doc: "))
(setvar "OSMODE" 0)
 (setq gmd (angle p1 p2))
 (setq sm (sin gmd))
 (setq cm (cos gmd))
 (setq hsm (abs (/ cm sm)))
(initget 1 "Yes No")
(if (= "Yes" (getkword "\nCo ghi mai doc khong? : "))
(progn
(setq tl (getreal"\nNhap ty le <1>: "))
(if tl null (setq tl 1))
(setq diem (list (- (car p1) (* 2 tl sm)) (+ (cadr p1) (* 2 tl cm))))
(setq ch (* 2 tl))
(setq nghieng (* gmd 57.29577951))
(cond 
((> hsm 1)
(setq inm (strcat "m=" (rtos hsm 2 2) ""))
(command "text" "j" "MC" diem ch nghieng inm "")  
)
((< hsm 1)
(setq inm (strcat "m=" (rtos hsm 2 2) ""))
(command "text" "j" "MC" diem ch nghieng inm "")
)
)
)
(progn
(cond 
((> hsm 1)
(setq inm (strcat "m=" (rtos hsm 2 4) ""))
(princ "\nHe so mai doc la: ")(princ inm)
)
((< hsm 1)
(setq inm (strcat "m=" (rtos hsm 2 4) ""))
(princ "\nHe so mai doc la: ")(princ inm)
)
)
)
)
(command "-osnap" "end,mid,nod,int,per,app,nea")
(command "ucs" "w" "")
(command "-layer" "s" "0" "")
)


<<

Filename: 110382_maaa.lsp
Tác giả: Bee
Bài viết gốc: 430606
Tên lệnh: cc
Lisp tính tổng độ dài
8 giờ trước, Nguyễn Minh Chương đã nói:

Xuất ra vị...

>>
8 giờ trước, Nguyễn Minh Chương đã nói:

Xuất ra vị trí tùy ý khi mình dùng chuột chọn vị trí đó, VD: khi mình chọn xong các đường để đo, space rồi nhập chuột trái 1 vị trí bất kỳ thì text tổng độ dài nó xuất hiện ở vị trí đó.

Còn to nhỏ thì không thành vấn đề, chỉ cần nhìn thấy là được rồi.

Cảm ơn bạn.

Ok đã chỉnh nhé. ^_^

(defun c:cc  (/ ss tl n ent itm obj l txt)
  (setq ss (ssget)
        tl 0
        n  (1- (sslength ss)))
  (while (>= n 0)
    (setq ent (entget (setq itm (ssname ss n)))
          obj (cdr (assoc 0 ent))
          l   (cond
                ((= obj "LINE")
                 (distance (cdr (assoc 10 ent)) (cdr (assoc 11 ent))))
                ((= obj "ARC")
                 (* (cdr (assoc 40 ent))
                    (if (minusp (setq l (- (cdr (assoc 51 ent))
                                           (cdr (assoc 50 ent)))))
                      (+ pi pi l)
                      l)))
                ((or (= obj "CIRCLE")
                     (= obj "SPLINE")
                     (= obj "POLYLINE")
                     (= obj "LWPOLYLINE")
                     (= obj "ELLIPSE"))
                 (command "_.area" "_o" itm)
                 (getvar "perimeter"))
                (t 0))
          tl  (+ tl l)
          n   (1- n)))

  (entmake
    (list
      (cons 0 "TEXT")
      (cons 100 "AcDbText")
      (cons 10 (trans (getpoint "\nCh\U+1ECDn v\U+1ECB trí \U+0111\U+1EB7t text: ") 1 0))
      (cons 40 (getvar 'TEXTSIZE))
      (cons 1 (strcat "L= " (rtos tl 2 0) " mm"))
      (cons 50 0.0)
      (cons 62 4)      
      )
    )
  (princ)
  )

 


<<

Filename: 430606_cc.lsp
Tác giả: thanhtam_1990
Bài viết gốc: 411784
Tên lệnh: v
Sửa Lại Mã List Vẽ Thanh

list này dùng để vẽ thanh thép góc của tháp thép, à khi dùng lệnhchế độ truy bắt điểm bị mất hết mỗi lần làm phải sét lại rất mệt, mong mấy bạn giúp sửa lỗi trong list này

(princ " DANH  V  DE VE THANH   ")
(defun C:V ()
	(setq osmd (getvar "osmode")) ; luu gia tri bien OSMODE hien hanh
	(setvar "osmode" 0)
	(setq tl (getvar "dimlfac"))
	(setq p1 (getpoint "diem dau:"))
	(setq p2 (getpoint "diem...
>>

list này dùng để vẽ thanh thép góc của tháp thép, à khi dùng lệnhchế độ truy bắt điểm bị mất hết mỗi lần làm phải sét lại rất mệt, mong mấy bạn giúp sửa lỗi trong list này

(princ " DANH  V  DE VE THANH   ")
(defun C:V ()
	(setq osmd (getvar "osmode")) ; luu gia tri bien OSMODE hien hanh
	(setvar "osmode" 0)
	(setq tl (getvar "dimlfac"))
	(setq p1 (getpoint "diem dau:"))
	(setq p2 (getpoint "diem cuoi:"))
	(setq a1 (getreal "BE RONG THEP GOC B=?  "))
	(setq d1 (getreal "CHIEU DAI DAU THANH ?"))
	(setq e1 (getreal "CHIEU DAY THANH:"))
	(setq a (/ (/ a1 tl) 2))
	(setq d (/ d1 tl))
	(setq c (sqrt(+ (* a a) (* d d))))
	(setq alpha (angle p1 p2))
	(setq gama (atan (/ a d)))
	(setq beta1 (- alpha gama))
	(setq beta2 (+ alpha gama))
	(setq p3 (polar p1 (+ pi beta2) c))
	(setq p4 (polar p2 beta1 c))
	(setq p5 (polar p2 beta2 c))
	(setq p6 (polar p1 (+ pi beta1) c))
	(command "Pline" p3 p4 p5 p6 "c")
	(setq e (/ (/ (- a1 (* 2 e1)) tl) 2))
	(setq f (sqrt(+ (* e e) (* d d))))
	(setq gama1 (atan (/ e d)))
	(setq beta3 (- alpha gama1))
	(setq beta4 (+ alpha gama1))
	(setq p7 (polar p1 (+ pi beta4) f))
	(setq p8 (polar p2 beta3 f))
	(command "pline" p7 p8)
	(command)
	(setvar "osmode" osmd) 
)




<<

Filename: 411784_v.lsp
Tác giả: duy782006
Bài viết gốc: 430685
Tên lệnh: ddd

-Lệnh là DDD. Cao text mặc định là 2. sau phẩy mặc định là 2.

-Lệnh ban đầu hoạt động như lệnh vẽ pline của cad (chấp nhận có cung tròn). sau khi enter sẽ xoá pline này đi và cho ra kết quả tại điểm pick.

(DEFUN c:DDD ( )

(command "pline")
(princ "\nSpecify start point:")
(while (< 0 (getvar "CMDACTIVE"))
(command pause)
(princ...
>>

-Lệnh là DDD. Cao text mặc định là 2. sau phẩy mặc định là 2.

-Lệnh ban đầu hoạt động như lệnh vẽ pline của cad (chấp nhận có cung tròn). sau khi enter sẽ xoá pline này đi và cho ra kết quả tại điểm pick.

(DEFUN c:DDD ( )

(command "pline")
(princ "\nSpecify start point:")
(while (< 0 (getvar "CMDACTIVE"))
(command pause)
(princ "\nSpecify next point or :")
) 

(command "area" "object" "last")
(setq dientichdo (getvar "area"))
(command "erase" "last" "") 

(setq diemviet (getpoint "\nDiem viet ket qua."))
(entmake (list (cons 0 "TEXT")(cons 10 diemviet)(cons 11 diemviet)(cons 40 2)(cons 50 0)(cons 72 0)(cons 1 (rtos dientichdo 2 2))(cons 7 (getvar "TEXTSTYLE"))(cons 8 (getvar "Clayer"))(cons 62 256))) 

(princ)
)

 


<<

Filename: 430685_ddd.lsp
Tác giả: gia_bach
Bài viết gốc: 430780
Tên lệnh: getpro
Hỏi về Lisp (thuật toán, ý tưởng, coding,...)
18 phút trước, duy782006 đã nói:

MÌnh có bolck động có thể kéo ra...

>>
18 phút trước, duy782006 đã nói:

MÌnh có bolck động có thể kéo ra kéo dô. Bác nào cho mình xin đoạn lisp đọc giá trị chiều dài của cái line và pline sau khi kéo giản với.

bld.dwg

Tham khảo

(defun GetDynamicProperty(Block Property / oVal)
  (if(= 'ENAME(type Block))
    (setq Block(vlax-ename->vla-object Block)) )
  (if(= :vlax-true(vla-get-IsDynamicBlock Block))
    (foreach p(vlax-safearray->list
		(vlax-variant-value
		  (vla-GetDynamicBlockProperties Block)))
      (if(=(strcase Property)(strcase(vla-get-PropertyName p)))
	(if(vl-catch-all-error-p
	     (setq oVal(vl-catch-all-apply 'vla-get-Value(list p))))
	  nil
	  (setq oVal(vlax-variant-value oVal)) )	)) )
  oVal )

(defun c:getpro(/ )
  (setq bl(car(entsel)))
  ;Get property "Distance":
  (setq dis (GetDynamicProperty bl "Distance"))
;;;  (setq dis1 (GetDynamicProperty bl "Distance1"))
;;;  (setq dis2 (GetDynamicProperty bl "Distance2"))
;;;  (setq dis3 (GetDynamicProperty bl "Distance3"))
  (princ)  )

<<

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

 

Code như vầy :

 

(defun c:dmau(/ mau)
  (setq mau (ACAD_COLORDLG 7))
  (command "._DIMOVERRIDE" "dimclrt" mau...
>>

 

Code như vầy :

 

(defun c:dmau(/ mau)
  (setq mau (ACAD_COLORDLG 7))
  (command "._DIMOVERRIDE" "dimclrt" mau "" )
 )

 

Lisp này đúng là rất nhanh, không bị lag máy nhưng bạn có thể ghép chung vào lisp của mình được không, khi đó nó đổi được cả cho đối tượng text sẽ hay hơn. Ngoài ra còn có cái này nhỏ thôi, ko quan trọng lắm, bạn sửa cũng được là đa phần các lisp đều chọn đối tượng trước rồi mới thực hiện lệnh, lisp của bạn lại ngược lại, hiện bảng màu trước rồi mới chọn đối tượng, do đó không quen cho lắm, nhưng cái này ko quan trọng, bạn gộp lại với lisp của mình là ngon rồi

Mình cám ơn nhiều


<<

Filename: 321936_dmau.lsp
Tác giả: ginger
Bài viết gốc: 410113
Tên lệnh: tt
Lisp Nhân Chia Dim!

Có đọc bên Page, giúp bạn 1 cái (4 trong 1):

(defun c:tt (/ tongdim gandim fun tt1 tt2 ttf)

(defun...

>>

Có đọc bên Page, giúp bạn 1 cái (4 trong 1):

(defun c:tt (/ tongdim gandim fun tt1 tt2 ttf)

(defun tongdim (msg / ss ttd)

(setq ttd 0)

(princ msg)

(if (setq ss (ssget '((0 . "DIMENSION"))))

(foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))

(setq ttd (+ ttd

(cond ((distof (cdr (assoc 1 (entget x)))))

((cdr (assoc 42 (entget x))))))))

(setq ttd nil))

ttd)

(defun gandim (val / ent obj pre)

(and (setq ent (car (entsel (strcat "\nPick Dim de gan <" (vl-princ-to-string val) ">: "))))

(eq (cdr (assoc 0 (entget ent))) "DIMENSION")

(setq pre (vla-get-PrimaryUnitsPrecision (setq obj (vlax-ename->vla-object ent))))

(vla-put-TextOverride obj (rtos val 2 pre))))

;; *** Main ***

(if (setq tt1 (tongdim "\nChon nhom thu Nhat !"))

(if (setq tt2 (tongdim "\nChon nhom thu Hai !"))

(progn (if (equal tt2 1e-13)

(progn (not (initget "+ - *")) (setq fun (getkword "\nPhep tinh ")))

(progn (not (initget "+ - * :")) (setq fun (getkword "\nPhep tinh "))))

(and (cond ((eq fun "+") (setq ttf (+ tt1 tt2)))

((eq fun "-") (setq ttf (- tt1 tt2)))

((eq fun "*") (setq ttf (* tt1 tt2)))

((eq fun ":") (and (not (zerop tt2)) (setq ttf (/ tt1 tt2)))))

(princ (strcat "\nKet qua: " (vl-princ-to-string ttf)))

(gandim ttf)))

(and (princ (strcat "\nKet qua tong dim chon lan 1: " (vl-princ-to-string tt1)))

(gandim tt1))))

(princ))

được rồi anh ạ ! em cảm ơn bác nhé


<<

Filename: 410113_tt.lsp

Trang 278/330

278