Jump to content
InfoFile
Tác giả: anhGeodesy
Bài viết gốc: 432964
Tên lệnh: mtl
Lisp tạo viewport từ khung chọn bên model.

Vào lúc 26/2/2013 tại 11:09, KangKung đã nói:

 

Lisp...

>>
Vào lúc 26/2/2013 tại 11:09, KangKung đã nói:

 

Lisp mới tạo viewport cho tất cả hình chữ nhật có cạnh nằm ngang, đứng, ... ngồi biggrin.png hoặc nghiêng. Sơ qua về các đặc điểm của Lisp này:

1. Tạo viewport cho tất cả các khung hình chữ nhật

2. Thêm lựa chọn Xref khung tên bản vẽ

3. Các viewport được sắp xếp theo phương đứng thay vì phương ngang như các Lisp trước

Bác nào có nhu cầu thì down về rồi test thử và cho ý kiến nhé.

http://www.cadviet.com/upfiles/3/71162_mtl_rev5.lsp

P/S: Lisp này sẽ giảm rất nhiều thao tác và thời gian cho những ai biên tập bản đồ khu vực rộng đặc biệt là bản đồ dạng tuyến. 

@Nhoclangbat: Sẽ post Lisp theo yêu cầu của nhoc sau nhé.

;========LISP TAO VIEWPORT TREN LAYOUT BANG CACH CHON O MODEL========
;============================REV5====================================
;=========THEM LUA CHON XOAY HCN NGHIENG VA XREF KHUNG TEN===========
(defun C:mtl( / os lst khung pt0 pt1 pt2 pt3 Y index taphop xrefFile xref)
  (command "UNDO" "BE")
  (setq os(getvar "OSMODE"))
  (setvar "OSMODE" 0) 
  (setq taphop(ssget (LIST (CONS 0 "POLYLINE,LWPOLYLINE"))))
  (if (= Tyle nil)
    (setq Tyle1 1)
    (setq Tyle1 Tyle))
  (setq Tyle (getreal (strcat "\n Ty le: <" (rtos Tyle1 2 0) "> ")))
  (if (= Tyle nil)
    (setq Tyle Tyle1))
  (setq xref(getstring "\n Ban co muon chen file khung ten hay khong? <Y/N>:"))
  (if (= (strcase xref) "Y")
    (progn
      (if (not Path)
	(setq Path(getvar "dwgprefix")))
      (setq xrefFile(getfiled "Chon File khung ten" Path "dwg" 2))
      (setq Path xrefFile)))
  (setq soluong (sslength taphop))
  (setq index 0)
  (command "LAYOUT" "N" "Layout1")
  (command "LAYOUT" "S" "Layout1")
  (command "ERASE" "ALL" "")
  (command "ZOOM" "E")
  (command "MODEL")
  (setq Y 0)
  (command "ZOOM" "E")
  (while (< index soluong)
    (setq khung(ssname taphop index))
    (setq lst(acet-geom-vertex-list khung))
    (setq lst (vl-sort lst '(lambda (e1 e2) (if (/= (car e1) (car e2)) (< (car e1) (car e2)) (< (cadr e1) (cadr e2))))))
    (setq pt0(nth 0 lst) pt3(nth 3 lst))
    (if (> (cadr (nth 1 lst)) (cadr (nth 2 lst)))
      (setq pt1(nth 1 lst) pt2(nth 2 lst))
      (setq pt1(nth 2 lst) pt2(nth 1 lst))
      )
    (command "LAYOUT" "S" "Layout1")
    (if (> (distance pt2 pt0) (distance pt1 pt0))
      (command "RECTANG" (list 0 Y) (list (distance pt2 pt0) (+ Y (distance pt1 pt0))))
      (command "RECTANG" (list 0 Y) (list (distance pt1 pt0) (+ y (distance pt2 pt0))))
      )
    (command "SCALE" (entlast) "" (list 0 Y) (/ 1 tyle))
    (command "MVIEW" "O" (entlast))
    (if (= (strcase xref) "Y")
      (command "xref" "A" xrefFile (list 0 Y) "" "" ""))
    (command "MSPACE")
    (if (> (distance pt2 pt0) (distance pt1 pt0))
      (command "DVIEW" khung "" "TW" (- 90 (* (/ (angle pt0 pt1) pi) 180)) "")
      (command "DVIEW" khung "" "TW" (- 0 (* (/ (angle pt0 pt1) pi) 180)) "")
      )
    (command "ZOOM" "W" pt0 pt3)
    (command "PSPACE")
    (command "TEXT" "J" "MR" (list -50 (+ Y (/ (distance pt1 pt0) (* 2 tyle)))) (* 25 tyle) "0" (strcat "VP " (rtos (1+ index) 2 0)) "")
    (if (> (distance pt2 pt0) (distance pt1 pt0))
      (setq Y(- Y 50 (/ (distance pt1 pt0) tyle)))
      (setq Y(- Y 50 (/ (distance pt2 pt0) tyle)))
      )
    (command "ZOOM" "W" (list -100 (+ Y (distance pt3 pt0))) (list (distance pt3 pt0) (- Y 50 (distance pt3 pt0))))
    (setq index (+ index 1))
    )
  (command "ZOOM" "E")
  (command "MODEL")
  (command "UNDO" "END")
  (setvar "OSMODE" os)
  (princ)
  )
   

@kangkang Cho mình hỏi là Lisp này không chay đc trên Cad2019 là do đâu?  mong đc sự giải đáp. cảm ơn!


<<

Filename: 432964_mtl.lsp
Tác giả: trinhks
Bài viết gốc: 37110
Tên lệnh: co
Đánh số thứ tự tăng dần
Lệnh copy thông minh:

Command: co

mình dùng thấy thú vị hơn lệnh Tcount, tuy nhiên mỗi cái có điểm hay riêng.

;;;Edit by...
>>
Lệnh copy thông minh:

Command: co

mình dùng thấy thú vị hơn lệnh Tcount, tuy nhiên mỗi cái có điểm hay riêng.

;;;Edit by Interwar1283
;*********************************************************************
(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

Tại sao khi em sử dụng lisp này của bác lại ko đc,nó lại ra như trong anh nay vậy.bác sử gíp e đc ko? http://www.cadviet.com/upfiles/1_6.bmp


<<

Filename: 37110_co.lsp
Tác giả: taipham
Bài viết gốc: 387102
Tên lệnh: gnl
Nhờ Viết Lisp Lấy Nội Dung Linetype Gán Vào Block Att

 

code nhanh cho Bạn. Lệnh là GNL, chọn và update lien tục các tên của linetype vào block, khi muốn kết thúc thì enter

>>

 

code nhanh cho Bạn. Lệnh là GNL, chọn và update lien tục các tên của linetype vào block, khi muốn kết thúc thì enter

(defun c:GNL (/ e b lay nam);get name linetype
  
  (while (and
	   (princ "\nChon Line, PLINE")
	   (setq e (ssget '((0 . "*LINE"))))
	   (princ "\nChon block")
	   (setq b (ssget '((0 . "insert") (66 . 1))))
	 )

    (setq lay (cdr (assoc 8 (setq e (entget (ssname e 0))))))
    (if	(not (setq nam (cdr (assoc 6 e))))
      (setq nam (cdr (assoc 6 (tblsearch "LAYER" lay))))
    )
    (mapcar
      '(lambda (x)
	 (mapcar
	   '(lambda (Att)
	      (if
		(= (strcase (vla-get-TagString att)) "2T2K")
		 (vla-put-textstring att nam)
	      )
	    )
	   (vlax-invoke (vlax-ename->vla-object x) 'GetAttributes)

	 )
       )
      (vl-remove-if 'listp (mapcar 'cadr (ssnamex b)))
    )

  )
  (princ)
  )

Cảm ơn anh nhiều nhé!


<<

Filename: 387102_gnl.lsp
Tác giả: minhphuong_humg
Bài viết gốc: 276094
Tên lệnh: edt
Edit trực tiếp text Attribute trong block

 

Trong block có sử dụng nhiều text attribute thì việc gõ ed để sửa nội dung hơi vất vả một chút.

Đây là đoạn code...

>>

 

Trong block có sử dụng nhiều text attribute thì việc gõ ed để sửa nội dung hơi vất vả một chút.

Đây là đoạn code để edit trực tiếp vào các text attribute do ta chọn bằng cách pick chuột.

(defun c:edt () (while (setq att (car(nentsel "\nChon text Attribute :")))(if (= (dxf 0 att) "ATTRIB")(progn     (setq 	TagName (dxf 2 att)	TagVal (dxf 1 att)	BlName (dxf 330 att))     (if 	(setq NewVal (getstring 5 (strcat "\nNhap gia tri moi cho " TagName " <" TagVal "> : ")) )	(putAtt BlName TagName NewVal));if);progn);if);while(princ) );end;------------------------------------------------------------------------------------------(defun dxf(id ent) (cdr (assoc id (entget ent))));------------------------------------------------------------------------------------------(defun putAtt (BlName TagName NewVal / AttName EntDxf dk)(setq AttName (entnext BlName ) dk 1)  (while (and AttName dk)    (if (equal (assoc 0 (entget AttName )) '(0 . "SEQEND"))        (setq AttName nil )        (if (= (cdr (assoc 2 (entget AttName ))) TagName ) ; <-- Your Attribute name            (progn              (setq EntDxf (entget AttName ) dk nil)              (setq EntDxf (subst (cons 1 NewVal ) (assoc 1 (entget AttName )) EntDxf ) )              (entmod EntDxf )              (entupd BlName )              (setq AttName (entnext AttName ))            );progn        (setq AttName (entnext AttName ))        );if    );if          );while      );end
Tuy nhiên lisp này phải gõ nội dung cần thay đổi ở dòng command.

Giờ em muốn thực hiện việc này thông qua một hộp thoại. hộp thoại đó có 2 nút Cancel và OK.

Xin nhờ các huynh viết hộ cái này, em không có rành khoản này lắm.

Lisp sử dụng rất đơn giản và tiện. Nhưng có một điều là nếu như ta cùng sửa text ở >1 block khác nhau thì ta lại phải chọn từng cái một. Anh có thể sửa thêm chức năng nữa là cho chọn những text (định sửa có cùng giá trị) sau đó nhập vào không ạ? 


<<

Filename: 276094_edt.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 123874
Tên lệnh: erc
lisp xóa tất cả các đối tượng trong 1 vùng kín

Mình dùng lisp này bị lỗi như sau nhờ các bạn xem giúp :

 

;; free lisp from...
>>
Mình dùng lisp này bị lỗi như sau nhờ các bạn xem giúp :

 

;; free lisp from cadviet.com
;;;-------------------------------------------------------------
(defun c:erC (/ sc cur p0 P1 L1 d L n ssgDEL glength)
 (princ "\nFree lisp from www.cadviet.com")
 (command "undo" "be")
 (setvar "osmode" 0)
 (setq	sc	2009
cur	(car (entsel "\nchon duong: "))
glength	(lambda (e) (command ".lengthen" e "") (getvar "perimeter"))
d	(/ (glength cur) sc)
l1	0.0
p0	(vlax-curve-getStartPoint cur)
L	(list p0)
 )
 (redraw cur 4)
 (repeat sc
(setq
  l1 (+ l1 d)
  p1 (vlax-curve-getPointAtDist cur l1)

)
(setq L (append L (List p1)))
 )
 (setq ssgDEL (ssget "WP" L))
 (setq n 0)
 (repeat (sslength ssgDEL)
(entdel (ssname ssgDEL n))
(setq n (1+ n))
 )
 (command "undo" "end")
 (princ "\nChuc cac ban may man va thanh cong - Thiep 0918841230")
 (princ)
)
(vl-load-com)
)
(setq L (append L (List p1)))
 )
 (setq ssgDEL (ssget "WP" L))
 (setq n 0)
 (repeat (sslength ssgDEL)
(entdel (ssname ssgDEL n))
(setq n (1+ n))
 )
 (command "undo" "end")
 (princ "\nChuc cac ban may man va thanh cong - Thiep 0918841230")
 (princ)
)
(vl-load-com)

 

Đây là lỗi nó báo thế này :Command: erc

Free lisp from www.cadviet.com

chon duong:

Current length: 4441.7958error: bad argument type

(VLAX-CURVE-GETSTARTPOINT CUR)

mong các bạn sửa giup mình ..Rất cám ơn..

Hãy thử đưa hàm (vl-load-com) lên đầu coi sao???


<<

Filename: 123874_erc.lsp
Tác giả: txquychk51
Bài viết gốc: 408919
Tên lệnh: vl
Nhờ Viết Lisp Cộng Các Số Trong Text (Hoặc Mtext) Và Output Sang Một Mtext Khác

Quick code xem bạn dùng cái nào thì dùng ^^

Vanilla lisp

(defun c:al(/ s kq i)
(while (not (setq s (ssget...
>>

Quick code xem bạn dùng cái nào thì dùng ^^

Vanilla lisp

(defun c:al(/ s kq i)
(while (not (setq s (ssget (list (cons 0 "*TEXT"))))))
(setq kq 0 i -1)
(entmake 
	(list (cons 0 "MTEXT")
	(cons 100 "AcDbEntity")
	(cons 100 "AcDbMText")
	(assoc 8 (entget (ssname s 0)))
	(cons 1
		(rtos
		(repeat (sslength s)
			(setq kq (+ kq (cond ((distof (cdr (assoc 1 (entget (ssname s (setq i (1+ i))))))))(0))))	
		))
	)
	(cons 10 (getpoint "\nInsert point :"))
	)
)
(princ))
- Visual lisp :

 

(defun c:vl(/ d s l lr)(vl-load-com)		
	(while (not (ssget (list (cons 0 "*TEXT")))))
	(vlax-for x 
		(setq s (vla-get-activeselectionset (setq d  (vla-get-activedocument (vlax-get-acad-object)))))
		(setq l (cons (cond ((distof (vla-get-textstring x)))(0)) l))
		(or lr (setq lr (vla-get-layer x)))
	)
	(vla-put-layer
		(vla-addmtext 
			(vla-get-block (vla-get-activelayout d))
			(vlax-3d-point (getpoint "\nInsert point :"))
			(getvar 'textsize)
			(rtos (apply '+ l))
		)
		lr
	)
	(and s (not(vla-delete s))(vlax-release-object s))
	(princ)
)
- Hoặc kết hợp với acet

(defun c:acet(/ s)
(entmake 
	(list (cons 0 "MTEXT")
	(cons 100 "AcDbEntity")
	(cons 100 "AcDbMText")	
	(cons 1 (rtos
		(apply '+ (mapcar '(lambda(x)(cond ((distof (acet-dxf 1 (entget x))))(0))) (acet-ss-to-list (setq s (ssget (list (cons 0 "*TEXT"))))))))
	)
	(assoc 8 (entget (ssname s 0)))
	(cons 10 (getpoint "\nInsert point :"))
	)
)
(princ))
Lưu ý với bạn là các code trên (kể cả của bác Bee đều k tính đến trường hợp đối tượng chọn là các Mtext có kèm mã như mã xuống dòng, layẻ, màu sắc, chiều cao ....

 

bác bày cho e cách sửa lisp al từ mtext thành text được ko ạ? e sửa mtext thành text+ bỏ 2 dòng dưới mà nó ko ra kết quả ạ :)


<<

Filename: 408919_vl.lsp
Tác giả: cd2k44
Bài viết gốc: 157520
Tên lệnh: rdt dtd rt rtd
Lisp rải đối tượng theo đơờng dẩn.

Đã chỉnh lại lisp thêm chức năng rải text thay đổi giá trị.

-Tên lệnh: RT.

-Hỏi chọn đối tượng ko phải text thì hòi...

>>

Đã chỉnh lại lisp thêm chức năng rải text thay đổi giá trị.

-Tên lệnh: RT.

-Hỏi chọn đối tượng ko phải text thì hòi miết đến khi nào chọn đúng text thì hỏi tiếp điểm chuẩn, trong dòng hỏi điểm chuần có lồng giá trị thay đổi text mặc định là 1 (nghĩa là giá trị text thay đổi theo kiểu cộng 1 giá trị) nếu muốn thay đổi giá trị này thì đừng chọn điểm chuẩn vội mà gỏ d enter lisp hỏi giá trị cộng thêm bạn nhập vào (nhận cả giá trị âm nhé). Nhập xong lisp tiếp tục hỏi chọn điềm chuẩn.

-Hỏi chọn các đối tượng muốn rải theo các đối tượng này là bất cứ cái gì bạn muốn lisp sẽ rải nhóm đối tượng này và cái text bạn chọn ban đầu (giá trị cái text sẽ thay đổi còn các đối tượng chép theo giữ nguyên) nếu không chép theo cái gì thì enter.

-Các bước tiếp theo giống như cũ.

*Trong này có lệnh chính:

-RTD: rải từ điểm đã trình bày hôm trước.

-RDT: rải đồi tượng đã trình bày hôm trước.

-RT: rải text trình bày hôm nay.

*Và 1 lệnh khuyến mại:

-DTD: đo từ điểm, dùng đo độ dài đối tượng giữa 2 điểm trên đối tượng đó.

 

(Defun c:rdt (/ ss doituong dsl dc ddd chondd chieudaicuver diemdau diemcuoi krai chieudaidoan slc sl index d2 p2 d5 p5 d3 p3 dt l m)
(vl-load-com)
(command "undo" "be")
(command "ucs" "")
(chonnhomdoituong)
(choncuver)

(setq diemchuan (vlax-curve-getPointAtDist chondd 0))
(setq diemdinhhuong (vlax-curve-getPointAtDist chondd chieudaicuver))

(setq chieudaitinh chieudaicuver) 
(setq dautinh +) 

(setq thuchienrai raikieukhongtext)
(hoikieuraicd)
(command "ucs" "p")
(command "undo" "end")
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun c:dtd (/ ss doituong dsl dc ddd chondd chieudaicuver diemdau diemcuoi krai chieudaidoan slc sl index d2 p2 d5 p5 d3 p3 dt l m daidendiem)
(vl-load-com)
(command "undo" "be")
(command "ucs" "")
(choncuver)
(cdxuatphatdo)
(cdketthucdo)
(Cond
((< daidendiemdo daidenhuongdo) (setq chieudaidoan (- daidenhuongdo daidendiemdo))) 
((> daidendiemdo daidenhuongdo) (setq chieudaidoan (- daidendiemdo daidenhuongdo)))
) 
(command "undo" "end")
(princ (strcat "\nChieu dai doan do la: " (rtos chieudaidoan 2 4))) 
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun c:rt (/ ss doituong dsl dc ddd chondd chieudaicuver diemdau diemcuoi krai chieudaidoan slc sl index d2 p2 d5 p5 d3 p3 dt l m daidendiem)
(vl-load-com)
(command "undo" "be")
(command "ucs" "")
(chonnhomdoituongtext)

(princ "\nChon doi tuong rai kem theo text :")
(setq ss (ssget))
(cond 
((= ss nil) (setq thuchienrai raikieutextkokem))
((/= ss nil) (setq thuchienrai raikieutextcokem))) 

(choncuver)
(chondiemxuatphat)
;(setq thuchienrai raikieutext)
(hoikieuraicd)
(command "ucs" "p")
(command "undo" "end")
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun c:rtd (/ ss doituong dsl dc ddd chondd chieudaicuver diemdau diemcuoi krai chieudaidoan slc sl index d2 p2 d5 p5 d3 p3 dt l m daidendiem)
(vl-load-com)
(command "undo" "be")
(command "ucs" "")
(chonnhomdoituong)
(choncuver)
(chondiemxuatphat)
(setq thuchienrai raikieukhongtext)
(hoikieuraicd)
(command "ucs" "p")
(command "undo" "end")
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun chondiemchuandoituong ()
(setq dc (getpoint "\nChon diem goc: "))
(cond 
((= dc nil) (princ "\nChua chon duoc diem goc:") (chondiemchuandoituong))
((/= ss nil))) 
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun chonnhomdoituongtext ()
(if (null congthem)(setq congthem "1"))
(setq ddd (entsel "\nChon text mau"))
(while
(or
(null ddd)
(/= "TEXT" (cdr (assoc 0 (entget (car ddd)))))
)
(princ "\nDoi tuong khong phai la text! Chon lai")
(setq ddd (entsel "\nChon text mau"))
)
(setq sst (car ddd))
(setq DTTT (entget sst))
(setq NDTTT (cdr (assoc 1 DTTT)))
(Setq temp T)
(While temp
(setq dc (strcat "\nDon vi cong them la(" congthem "): ")) 
(Initget "D")
(setq str (getpoint dc))
(Cond
((= str "D") (setq congthem (getstring (strcat"\nDon vi cong them la <" congthem "> :"))))
(Progn
(Setq dc str)
(setq temp nil)
)
)
)
(princ)
)

;;;;;;;;;;;;;;;;;
(Defun dotructiep ()
(cdxuatphatdo)
(cdketthucdo)
(Cond
((< daidendiemdo daidenhuongdo) (setq chieudaidoan (- daidenhuongdo daidendiemdo))) 
((> daidendiemdo daidenhuongdo) (setq chieudaidoan (- daidendiemdo daidenhuongdo)))
) 
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun cdxuatphatdo ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 545)
(setq diemchuando (getpoint "\nTu diem :"))
(setvar "osmode" 0)
(setq daidendiemdo (vlax-curve-getDistAtPoint chondd diemchuando))
(setvar "osmode"luubatdiem)
(cond 
((= daidendiemdo nil) (princ "\nDiem vua chon khong nam tren duong dan, chon lai:") (cdxuatphatdo))
((/= daidendiemdo nil))) 
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun cdketthucdo ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 545)
(setq diemdinhhuongdo (getpoint diemchuando"\nDen diem :"))
(setvar "osmode" 0)
(setq daidenhuongdo (vlax-curve-getDistAtPoint chondd diemdinhhuongdo))
(setvar "osmode"luubatdiem)
(cond 
((= daidenhuongdo nil) (princ "\nDiem vua chon khong nam tren duong dan, chon lai:") (cdketthucdo))
((/= daidenhuongdo nil))) 
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun cdxuatphat ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 545)
(setq diemchuan (getpoint "\nDiem bat dau rai tren duong dan:"))
(setvar "osmode" 0)
(setq daidendiem (vlax-curve-getDistAtPoint chondd diemchuan))
(setvar "osmode"luubatdiem)
(cond 
((= daidendiem nil) (princ "\nDiem vua chon khong nam tren duong dan, chon lai:") (cdxuatphat))
((/= daidendiem nil))) 
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun cdketthuc ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 545)
(setq diemdinhhuong (getpoint diemchuan"\nDiem ket thuc rai tren duong dan:"))
(setvar "osmode" 0)
(setq daidenhuong (vlax-curve-getDistAtPoint chondd diemdinhhuong))
(setvar "osmode"luubatdiem)
(cond 
((= daidenhuong nil) (princ "\nDiem vua chon khong nam tren duong dan, chon lai:") (cdketthuc))
((/= daidenhuong nil))) 
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun thongbaoketqua ()
(princ (strcat "\nChieu dai doan la: " (rtos chieudaitinh 2 4) doanhienthinoidung)) 
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun chondiemxuatphat ()
(cdxuatphat)
(cdketthuc)
(Cond
((< daidendiem daidenhuong) (setq chieudaitinh (- daidenhuong daidendiem)) (setq dautinh +)) 
((> daidendiem daidenhuong) (setq chieudaitinh (- daidendiem daidenhuong)) (setq dautinh -))
) 
(setq doanxuatphat daidendiem)
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun hoikieuraicd ()
(setq kraicd (strcase (getstring "\nKieu rai theo: Tinh /So luong/")))

(Cond
((= kraicd "T") (raisoluongtinh))
((/= kraicd "T") 
(Cond
((= kraicd "S") (raisoluongcd))
((/= kraicd "S") (raikhoangcachcd))
) 
)
) 
(princ)
)
;;;;;;;;;;;;;;
(Defun raisoluongtinh ()
(setq slrai (getreal "\nRai them may lan khong tinh doi tuong tai diem bat dau rai:"))
(setq chieudaidoan (GETDIST "\nKhoang cach 1 lan rai: "))
(Cond
((= chieudaidoan 0) (dotructiep)))

(setq tongdoan (* slrai chieudaidoan))
(Cond
((> tongdoan chieudaitinh) 
(princ (strcat "\nChieu dai doan la: " (rtos chieudaitinh 2 4) ", Yeu cau la: " (rtos chieudaidoan 2 4) "x" (rtos slrai 2 0) "=" (rtos tongdoan 2 4))) 
(princ "\nVuot qua chieu dai cho phep, nhap lai:") 
(raisoluongtinh))
((< tongdoan chieudaitinh) 
(setq sl (fix (+ slrai 1)))
(setq sl (fix sl))
(setq doanhienthinoidung (strcat "\nDa thuc hien rai: " (rtos slrai 2 0) " lan voi khoang cach " (rtos chieudaidoan 2 4))) 
(thuchienrai)
)
) 
(princ)
)
;;;;;;;;;;;;;;
(Defun raikhoangcachcd ()
(setq chieudaidoan (GETDIST "\nKhoang cach 1 lan rai: "))
(Cond
((= chieudaidoan 0) (dotructiep)))
(Cond
((> chieudaidoan chieudaitinh) 
(princ (strcat "\nChieu dai doan la: " (rtos chieudaitinh 2 4) ", Yeu cau la: " (rtos chieudaidoan 2 4))) 
(princ "\nVuot qua chieu dai cho phep, nhap lai:") 
(raikhoangcachcd))
((< chieudaidoan chieudaitinh) 
(setq sol (+ (/ chieudaitinh chieudaidoan) 1))
(setq sl (fix sol))
(setq sl (fix sl))
(setq doanhienthinoidung (strcat "\nDa thuc hien rai: " (rtos sol 2 0) " lan voi khoang cach " (rtos chieudaidoan 2 4))) 
(thuchienrai)
)
) 
(princ)
)
;;;;;;;;;;;;;;
(Defun raisoluongcd ()
(setq slc (getreal "\nChia duong dan thanh may lan:"))
(setq chieudaidoan (/ chieudaitinh slc))
(setq sl (fix (+ 1 slc)))
(setq doanhienthinoidung (strcat "\nDa thuc hien rai: " (rtos slc 2 0) " lan voi khoang cach " (rtos chieudaidoan 2 4))) 
(thuchienrai)
(princ)
)
;;;;;;;;;;;;;;
(Defun chonnhomdoituong ()
(princ "\nChon doi tuong rai:")
(setq ss (ssget))

(cond 
((= ss nil) (princ "\nChua chon duoc doi tuong nao:") (chonnhomdoituong))
((/= ss nil) 
(setq dsl (sslength ss))
(cond 
((= dsl 1) 
(setq doituong (ssname SS 0))
(setq doituong (entget doituong))
(setq KIEUDOITUONG (cdr (assoc 0 doituong)))
(cond 
((= KIEUDOITUONG "INSERT") (setq dc (cdr (assoc 10 doituong))))
((/= KIEUDOITUONG "INSERT") (chondiemchuandoituong))
);ketthuccondxemblock
);kethucdsl1
((/= dsl 1) (chondiemchuandoituong))
);ketthuccondnho

);ketthucsetqdsl
);ketthuccondtong 
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun chondiemchuandoituong ()
(setq dc (getpoint "\nChon diem goc: "))
(cond 
((= dc nil) (princ "\nChua chon duoc diem goc:") (chondiemchuandoituong))
((/= ss nil))) 
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun choncuver ()

(setq ddd (entsel "\nChon duong dan:"))
(while
(or
(null ddd)
(or (= "TEXT" (cdr (assoc 0 (entget (car ddd))))) (= "MTEXT" (cdr (assoc 0 (entget (car ddd))))) (= "HATCH" (cdr (assoc 0 (entget (car ddd))))) (= "INSERT" (cdr (assoc 0 (entget (car ddd))))) (= "REGION" (cdr (assoc 0 (entget (car ddd))))) (= "DIMENSION" (cdr (assoc 0 (entget (car ddd)))))
)
)
(setq ddd (entsel "\nDoi tuong khong the lam duong dan! Chon lai"))
)

(setq chondd (car ddd))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq chieudaicuver (vlax-curve-getDistAtParam chondd (vlax-curve-getEndParam chondd)))
(setq doanxuatphat 0)
(setvar "osmode"luubatdiem)
(princ)
)
;;;;;;;;;;;;;;
(Defun raikieukhongtext (/ quaykhong)

(setq quaykhong (strcase (getstring "\nCo quay doi tuong vuong goc voi duong dan khong: Khong/")))
(Cond
((= quaykhong "K") (setq copygiua copykoquay))
((/= quaykhong "K")(setq copygiua copyquay))
) 

(setq index -1)

(repeat sl
(setq index (1+ index))
(setq d2 (dautinh doanxuatphat (* chieudaidoan index)))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq p2 (vlax-curve-getPointAtDist chondd d2))
(setvar "osmode"luubatdiem)
(copygiua)
)
(thongbaoketqua)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun copycuoiquay()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq d5 (- (dautinh doanxuatphat (* chieudaidoan index)) 0.01))
(setq p5 (vlax-curve-getPointAtDist chondd d5))
(setq L 0)
(setq M (sslength ss))
(while (< L M)
(setq DT (ssname ss L))
(command ".copy" DT "" dc p2)
(command ".rotate" "last" "" p2 p5)
(command ".rotate" "last" "" p2 180)
(setq L (1+ L))
)
(setvar "osmode"luubatdiem)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun COPYQUAY(/ p3)
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq d3 (+ (dautinh doanxuatphat (* chieudaidoan index)) 0.001))
(setq p3 (vlax-curve-getPointAtDist chondd d3))
(setvar "osmode"luubatdiem)
(Cond
((= p3 nil) (copycuoiquay))
((/= p3 nil) 
(setq L 0)
(setq M (sslength ss))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(while (< L M)
(setq DT (ssname ss L))
(command ".copy" DT "" dc p2)
(command ".rotate" "last" "" p2 p3)
(setq L (1+ L))
)
(setvar "osmode"luubatdiem)
)
) 


(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;
(Defun raikieutextcokem (/ quaykhong)

(setq quaykhong (strcase (getstring "\nCo quay doi tuong vuong goc voi duong dan khong: Khong/")))
(Cond
((= quaykhong "K") (setq copygiuatext copykoquaytext) (setq copygiua copykoquay))
((/= quaykhong "K")(setq copygiuatext copyquaytext) (setq copygiua copyquay))
) 

(setq index -1)

(repeat sl
(setq index (1+ index))
(setq d2 (dautinh doanxuatphat (* chieudaidoan index)))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq p2 (vlax-curve-getPointAtDist chondd d2))
(setvar "osmode"luubatdiem)
(copygiuatext)
(copygiua)
)
(thongbaoketqua)
(princ)
)
;;;;;;;;;;;;;;
(Defun raikieutextkokem (/ quaykhong)

(setq quaykhong (strcase (getstring "\nCo quay doi tuong vuong goc voi duong dan khong: Khong/")))
(Cond
((= quaykhong "K") (setq copygiuatext copykoquaytext))
((/= quaykhong "K")(setq copygiuatext copyquaytext))
) 

(setq index -1)

(repeat sl
(setq index (1+ index))
(setq d2 (dautinh doanxuatphat (* chieudaidoan index)))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq p2 (vlax-curve-getPointAtDist chondd d2))
(setvar "osmode"luubatdiem)
(copygiuatext)
)
(thongbaoketqua)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun copycuoiquaytext ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq d5 (- (dautinh doanxuatphat (* chieudaidoan index)) 0.01))
(setq p5 (vlax-curve-getPointAtDist chondd d5))
(command ".copy" sst "" dc p2)
(command ".rotate" "last" "" p2 p5)
(command ".rotate" "last" "" p2 180)
(setq congthems (atoi congthem)) 
(setq DTDM (entlast))

(if (and (>= (ascii NDTTT) 48) (<= (ascii NDTTT) 57))
(setq NDTTT (itoa (+ (atoi NDTTT) congthems)))
(setq NDTTT (chr (+ (ascii NDTTT) congthems)))
)

(setq Elist (entget DTDM)) 
(setq Oldlist (assoc 1 Elist)) 
(setq Oldtext (cdr Oldlist))
(setq Oldtext (strcase Oldtext nil))
(setq Newlist (cons '1 NDTTT))
(setq Elist (subst Newlist Oldlist Elist))
(entmod Elist)
(setvar "osmode"luubatdiem)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun COPYQUAYtext (/ p3)
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq d3 (+ (dautinh doanxuatphat (* chieudaidoan index)) 0.001))
(setq p3 (vlax-curve-getPointAtDist chondd d3))
(setvar "osmode"luubatdiem)
(Cond
((= p3 nil) (copycuoiquaytext))
((/= p3 nil) 
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(command ".copy" sst "" dc p2)
(command ".rotate" "last" "" p2 p3)


(setq congthems (atoi congthem)) 
(setq DTDM (entlast))

(if (and (>= (ascii NDTTT) 48) (<= (ascii NDTTT) 57))
(setq NDTTT (itoa (+ (atoi NDTTT) congthems)))
(setq NDTTT (chr (+ (ascii NDTTT) congthems)))
)

(setq Elist (entget DTDM)) 
(setq Oldlist (assoc 1 Elist)) 
(setq Oldtext (cdr Oldlist))
(setq Oldtext (strcase Oldtext nil))
(setq Newlist (cons '1 NDTTT))
(setq Elist (subst Newlist Oldlist Elist))
(entmod Elist)
(setvar "osmode"luubatdiem)
)
) 


(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun COPYKOQUAYtext ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(command ".copy" sst "" dc p2 "")
(setq congthems (atoi congthem)) 
(setq DTDM (entlast))

(if (and (>= (ascii NDTTT) 48) (<= (ascii NDTTT) 57))
(setq NDTTT (itoa (+ (atoi NDTTT) congthems)))
(setq NDTTT (chr (+ (ascii NDTTT) congthems)))
)

(setq Elist (entget DTDM)) 
(setq Oldlist (assoc 1 Elist)) 
(setq Oldtext (cdr Oldlist))
(setq Oldtext (strcase Oldtext nil))
(setq Newlist (cons '1 NDTTT))
(setq Elist (subst Newlist Oldlist Elist))
(entmod Elist)
(setvar "osmode"luubatdiem)
(princ)
)
;;;;;;;;;;;;;;

Cảm ơn anh Duy đã quan tâm.Lisp đã đáp ứng được yêu cầu của em rồi.Tks anh nhiều


<<

Filename: 157520_rdt_dtd_rt_rtd.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 427150
Tên lệnh: ha
Lisp rải đối tượng theo đơờng dẩn.

Câu hỏi này thiếu, nên cứ lấy cái này xài tạm.


(defun C:HA()
 (command "undo" "begin")
 (acet-sysvar-set (list "osmode" 0 "cmdecho" 0))
 (princ "\nChon cac doi duong de Copy...")
 (setq ss (ssget))
 (setq pt (getpoint "\nChon diem chuan: "))
 (setq lst (acet-geom-vertex-list (car (entsel "\nChon LWPolylne: "))))
 (setq x 0)
 (repeat (length lst)
  (command "copy" ss "" pt (nth x lst))
  (setq x (1+...
>>

Câu hỏi này thiếu, nên cứ lấy cái này xài tạm.


(defun C:HA()
 (command "undo" "begin")
 (acet-sysvar-set (list "osmode" 0 "cmdecho" 0))
 (princ "\nChon cac doi duong de Copy...")
 (setq ss (ssget))
 (setq pt (getpoint "\nChon diem chuan: "))
 (setq lst (acet-geom-vertex-list (car (entsel "\nChon LWPolylne: "))))
 (setq x 0)
 (repeat (length lst)
  (command "copy" ss "" pt (nth x lst))
  (setq x (1+ x)))
 (acet-sysvar-restore)
 (command "undo" "end")
 (princ))


<<

Filename: 427150_ha.lsp
Tác giả: huunhantvxdts
Bài viết gốc: 434740
Tên lệnh: ttc
Lisp thống kê đoạn thẳng
2 giờ trước, nhunhapro123 đã nói:

Nhờ các bác chỉnh sửa giúp...

>>
2 giờ trước, nhunhapro123 đã nói:

Nhờ các bác chỉnh sửa giúp em code này ạ. Lỗi không lặp lại được đối tượng chọn.

TTC.lsp

sửa lại cho bạn có vòng lặp và chạy được còn kết quả theo của bạn

(defun C:TTC ();(D H1 H2 WF TL1 K P1 P2 P3 P4 P5 P6 P7 P8 PT PT1 P9 P10 P11 P12 P13 TTL L)
(SETVAR "cmdecho" 0)
(command "undo" "begin")
(setq LADIN (GETVAR "dimzin"))
(setq LAOS (GETVAR "osmode"))
(setq STY (GETVAR "textstyle"))
(setq D (TBLSEARCH "style" STY))
(setq H1 (CDR (ASSOC 40 D)))
(setq H2 (CDR (ASSOC 42 D)))
(setq WF (CDR (ASSOC 41 D)))
(setq H H2)
;(setq L 0)
(setq TL 1)
(setq TL1 (GETREAL (STRCAT (RTOS TL 2 0) " >: 1/")))
(setq TL TL1)
(setq K 0)
(setq TTL 0)
(SETVAR "dimzin" 0)
(SETVAR "OSMODE" 0)
(setq PT (GETPOINT "\nChon diem xuat bang thong ke: "))
(setq P1 (LIST (+ (CAR PT) (* 6 H)) (CADR PT)))
(setq P2 (LIST (+ (CAR PT) (* 22 H)) (CADR PT)))
(setq P3 (LIST (CAR PT) (- (CADR PT) (* 3 H))))
(setq P4 (LIST (CAR P1) (CADR P3)))
(setq P5 (LIST (CAR P2) (CADR P3)))
(setq P6 (LIST (+ (CAR PT) (* 11 H)) (+ (CADR PT) (* 2 H))))
(setq P7 (LIST (+ (CAR PT) (* 3 H)) (- (CADR PT) (* 1.5 H))))
(setq P8 (LIST (+ (CAR PT) (* 14 H)) (- (CADR PT) (* 1.5 H))))
(command "pline" PT P2 P5 P3 "C")
(command "pline" P1 P4 "")
(command "TEXT" "M" P6 "" "" "BANG THONG KE CHIEU DAI" "")
(command "TEXT" "M" P7 "" "" "STT" "")
(command "TEXT" "M" P8 "" "" "CHIEU DAI" "")
(while (setq E (CAR (ENTSEL "\n Chon doi tuong tinh chieu dai : ")))
(setq K (1+ K))
(setq PT (LIST (CAR P3) (CADR P3)))
(setq P1 (LIST (+ (CAR PT) (* 6 H)) (CADR PT)))
(setq P2 (LIST (+ (CAR PT) (* 22 H)) (CADR PT)))
(setq P3 (LIST (CAR PT) (- (CADR PT) (* 3 H))))
(setq P4 (LIST (CAR P1) (CADR P3)))
(setq P5 (LIST (CAR P2) (CADR P3)))
(setq P7 (LIST (+ (CAR PT) (* 3 H)) (- (CADR PT) (* 1.5 H))))
(setq P8 (LIST (+ (CAR PT) (* 14 H)) (- (CADR PT) (* 1.5 H))))
(setq P9 (LIST (CAR PT) (- (CADR P3) (* 3 H))))
(setq P10 (LIST (CAR P1) (CADR P9)))
(setq P11 (LIST (CAR P2) (CADR P9)))
(setq P12 (LIST (CAR P7) (- (CADR P3) (* 1.5 H))))
(setq P13 (LIST (CAR P8) (CADR P12)))
(setq L (* (LEN E) TL))
(setq TTL (+ L TTL))
(command "pline" PT P2 P5 P3 "C")
(command "pline" P1 P4 "")
(command "TEXT" "M" P7 "" "" (RTOS K 2 0) "")
(command "TEXT" "M" P8 "" "" (RTOS L 2 2) "")
;(setq E (CAR (ENTSEL (STRCAT "\nTong chieu dai = " (RTOS TTL 2 3) ". Chon doi tuong tiep theo..."))))
)
(SETVAR "DIMZIN" LADIN)
(command "pline" P3 P9 P11 P5 "C")
(command "pline" P10 P4 "")
(command "TEXT" "M" P12 "" "" "TONG" "")
(command "TEXT" "M" P13 "" "" (RTOS TTL 2 2) "")
(SETVAR "OSMODE" LAOS)
(command "undo" "end")
  )
;(defun LEN (E))
(defun LEN(E) (vlax-curve-getDistAtParam E (vlax-curve-getEndParam E)))
;(defun WTXT_M (TXT  P / STY D H1 H2 WF H)
;(setq STY (GETVAR "textstyle"))
;(setq D (TBLSEARCH "style" STY))
;(setq H1 (CDR (ASSOC 40 D)))
;(setq H2 (CDR (ASSOC 42 D)))
;(setq WF (CDR (ASSOC 41 D)))
;(setq H H1)
;)

 


<<

Filename: 434740_ttc.lsp
Tác giả: mr_nguyennghia
Bài viết gốc: 326183
Tên lệnh: fp
Plot nhiều file bản vẽ cùng một lúc

 

Nhu cầu in hàng loạt bản vẽ hầu như ai cũng có. Tuy nhiên, cách tổ chức bản vẽ mỗi người mỗi khác nên có lẽ cách làm cũng khác...

>>

 

Nhu cầu in hàng loạt bản vẽ hầu như ai cũng có. Tuy nhiên, cách tổ chức bản vẽ mỗi người mỗi khác nên có lẽ cách làm cũng khác nhau. Ssg xin nêu lên 1 cách bản thân thường làm:

Tất cả các hồ sơ thiết kế liên quan đến 1 công trình (từ *.dwg, *.xls, *.jpg... đến *.*) đều được lưu trong 1 folder. Mỗi bản vẽ (hiểu theo nghĩa bản cần in ra giấy), nằm riêng 1 file *.dwg. Chỉ trường hợp đặc biệt, 1 file mới chứa 2 hoặc nhiều bản vẽ. Tất cả các bản vẽ, ngoài tên ra, luôn luôn có 1 mã số được quy ước thống nhất trong hồ sơ thiết kế, chẳng hạn ABC-2105, ABC-2106... Các mã số này là thông tin quan trọng để quản lý bản vẽ, từ thiết kế, chuẩn bị sản xuất, triển khai sản xuất, hiệu đính, bổ sung... Tên file luôn luôn đặt trùng với mã số bản vẽ.

Khi hoàn thành 1 bản vẽ, hầu như bao giờ cũng có động tác in ra ngay để xem. Khi in, đương nhiên phải kèm theo các thiết lập về khổ giấy, tỷ lệ, màu sắc, đường nét..., sau đó là Full Preview để bảo đảm rằng bản in đúng ý mình. Trước khi OK, bấm chọn vào ô "Save changes to Layout" -> các lần in sau, nếu không có gì thay đổi, chỉ cần bấm Ctrl+P và OK một cách vô tư.

Nhu cầu in hàng loạt chỉ xuất hiện khi đã hoàn thành hồ sơ thiết kế, cần in để trình duyệt hoặc triển khai sản xuất. Các việc cần làm khi đó là:

1) Open hàng loạt file bản vẽ cần in

2) Dùng lệnh FP của lisp sau (luôn luôn cho autoload):

 

(defun C:FP( / Dwn)
;;;Fast Print multi-drawings
(setq Dwn (getvar "DWGNAME"))
(command "plot" "" "" "" "" "" "" "" "")
(command "qsave")
(command "close" "Dwn")
)
Khi nhận lệnh FP, thông tin của bản vẽ hiện hành sẽ chuyển sang máy in và được lưu ở bộ nhớ đệm của máy in. Thông tin chuyển xong, file bản vẽ hiện hành sẽ tự động save và close, bản vẽ kế tiếp sẽ hiện ra, tiếp tục nhập lệnh FP...

Nói thì dài dòng, nhưng tóm gọn lại như sau:

- Lệnh Open, select hàng loạt file bản vẽ và chỉ bấm 1 phát nút "Open"

- Gõ liên tục 2 phím FP cho đến khi... không còn cái gì để gõ và chờ lấy bản vẽ

Nói chung, cách làm này còn hơi có vẻ thủ công, nhưng mình rất yên tâm vì trước khi gõ FP, mình có thể xem lại nội dung bản vẽ đang hiển thị trên màn hình và chắc chắn rằng không có sự nhầm lẫn nào.

Mong được các bạn góp ý thêm.

Bác có cách nào hay hơn việc gõ FP ko. Việc lưu trữ thì tôi đang làm giống hệt bác


<<

Filename: 326183_fp.lsp
Tác giả: gia_bach
Bài viết gốc: 201904
Tên lệnh: test
LISP tạo đường viền cho text

Ở đây mình có lisp tạo đường viền cho text ( không biết tác giả)

ở Lsp này khi đánh lệnh nó chỉ chọn được một...

>>

Ở đây mình có lisp tạo đường viền cho text ( không biết tác giả)

ở Lsp này khi đánh lệnh nó chỉ chọn được một text

Mọi người chỉnh giúp mình là chọn được nhiều đối tượng text một lúc không ah.

Đây là lisp đó:

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=63121&pid=195690&st=0entry195690
;----- Example Calling Function: This example will create an LWPolyline describing the bounding box of the selected object.
(defun c:test ( / e ) (vl-load-com)
 (if (setq e (car (entsel)))
(entmakex
  (append
(list
  	(cons 0 "LWPOLYLINE")
  	(cons 100 "AcDbEntity")
  	(cons 100 "AcDbPolyline")
  	(cons 90 4)
  	(cons 70 1))
(mapcar '(lambda ( p ) (cons 10 p)) (LM:BoundingBox (vlax-ename->vla-object e))))))
 (princ))
(defun LM:BoundingBox ( object / lowerleft upperright )
 (if (vlax-method-applicable-p object 'GetBoundingBox)
((lambda ( boundingbox )
(mapcar
  	(function
	(lambda ( _functionlist )
  		(mapcar
			(function
  			(lambda ( _function ) ((eval _function) boundingbox)))
			_functionlist)))
  '((caar   cadar) (caadr  cadar)
	(caadr cadadr) (caar  cadadr))))
  (mapcar 'vlax-safearray->list
(progn
  	(vla-getBoundingBox object 'lowerleft 'upperright) (list lowerleft upperright))))))

 

Thanks!

Lisp này chỉ dùng cho các Text nằm ngang hoặc thẳng đứng, với các Text nằm xiên đuờng viền không xiên theo phuơng của Text. (nhưng có lẽ đã đáp ứng đuợc yêu cầu của chủ topic).

 

gợi ý : nếu dùng hàm textbox thì đuờng viền sẽ theo phuơng của Text.


<<

Filename: 201904_test.lsp
Tác giả: anhGeodesy
Bài viết gốc: 434834
Tên lệnh: 00

Nhờ các cao thủ chỉnh sửa giùm em đoạn code thống kê này cho ra 1 list như trong file cad dưới đây. cảm ơn các bác. em viết mà gặp cái Dynamic có tới 3 dữ liệu em chưa biết cách duyệt lây nó ra như thế nào. xin nhờ các bác chỉ giáo.

Block Feild TKT DAM New_hoi...

Nhờ các cao thủ chỉnh sửa giùm em đoạn code thống kê này cho ra 1 list như trong file cad dưới đây. cảm ơn các bác. em viết mà gặp cái Dynamic có tới 3 dữ liệu em chưa biết cách duyệt lây nó ra như thế nào. xin nhờ các bác chỉ giáo.

Block Feild TKT DAM New_hoi CV.dwg

 

(defun c:00 (/ Bang_Thong_ke doc)
  (vl-load-com)
  (Setvar "CMDECHO" 0)
  ;(command "TEXTSCR" "")
 (princ "\nChon Block can tong hop\n :")
  (if (setq ss (ssget (list (cons 0 "INSERT") (cons 66 1))))
    (ATTB_ThepDam ss) 
  )
  ;(AT:Table_Thongkethep Bang_Thong_ke 220 100 "")
  (SETVAR "OSMODE" 16383)
  (princ))

(defun GetTagVal (obj tagName);By Gia_Bach
  (foreach att (vlax-invoke obj 'GetAttributes)
    (if (= tagName (vla-get-tagstring att))
      (setq str (vla-get-TextString att) ) ) )
  str)

(defun ChangeTagVal (obj tagName val)
  (foreach att (vlax-invoke obj 'GetAttributes)
    (if (= tagName (vla-get-tagstring att))
      (progn
    (vla-put-textstring att val)
    (vla-update att)  ) ) ) )

(defun ATTB_ThepDam (ss / SH DK SC TCD Khoiluong Bang_Thong_ke) 
  (vl-load-com)
  (defun *error* (msg)
    (if    Olmode
      (setvar 'osmode Olmode)
    )
    (if    (not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )
  (setq Olmode (getvar "OSMODE"))
  (setvar "CMDECHO" 0)
  (setvar "OSMODE" 0)
  (setq Bang_Thong_ke (list))
  (setq i 0)
  
  (while (< i (sslength ss))
      (setq ent (ssname ss i))
      (setq obj    (vlax-ename->vla-object ent)
      )   
(if (AND (GetTagVal obj "DK")(GetTagVal obj "DK1")(GetTagVal obj "DK2"))
    (Progn
      (Setq SH (GetTagVal obj "SH"))
      (Setq DK (atoi(GetTagVal obj "DK")))
      (Setq DK (atoi(GetTagVal obj "DK1")))
      (Setq DK (atoi(GetTagVal obj "DK2")))
      (Setq SC (atoi(GetTagVal obj "SC")))
      (Setq SC (atoi(GetTagVal obj "SC1")))
      (Setq SC (atoi(GetTagVal obj "SC2")))
      (Setq TCD (atof(GetTagVal obj "TCD")))
      (Setq TCD (atof(GetTagVal obj "TCD1")))
      (Setq TCD (atof(GetTagVal obj "TCD2")))
         (setq
         Khoiluong
          (* (* (* (* pi (expt (/ (* DK 0.001) 2) 2))
               (* TCD 0.001)
            )
            7850
         )
         SC
          )
       )

      (setq Bang_Thong_ke
         (append
           Bang_Thong_ke
           (list (cons SH
               (list DK
                 SC
                 TCD
                 Khoiluong
               )
             )
           )
         )
      )
      (setq i (1+ i))
    );end Progn
    (Alert (strcat "\nKhong tim thay du lieu")) 
       )
    
  )
          Bang_Thong_ke
      (Princ Bang_Thong_ke)
  )

 


<<

Filename: 434834_00.lsp
Tác giả: Biet ve CAD
Bài viết gốc: 434874
Tên lệnh: 00
1 giờ} trướ}c, anhGeodesy đã nói:
1 giờ} trướ}c, anhGeodesy đã nói:

image.thumb.png.b4be645b120faeb33f35610af78300e0.png@image.thumb.png.b4be645b120faeb33f35610af78300e0.png

 

@Biet ve CAD Mình muốn lấy thông tin của 3 đoạn này trong 1 Block. bạn bắt đúng sóng rồi đó. nhờ bạn hướng dẫn mình thêm nhé, cảm ơn nhiều

Cũng đoán mò ý đồ của tác giả vì ko biết cái thống kê ấy ra cái gì nữa ^^

Bạn xem đúng ý chưa nhé, chọn được cả 3 loại block trong bản vẽ và princ ra 1 list theo yêu cầu

(defun c:00 ( )
  (vl-load-com)
  (Setvar "CMDECHO" 0)
  ;(command "TEXTSCR" "")
 (princ "\nChon Block can tong hop\n :")
  (if (setq ss (ssget (list (cons 0 "INSERT") (cons 66 1))))
    (princ(ATTB_ThepDam ss)) 
  )
  ;(AT:Table_Thongkethep Bang_Thong_ke 220 100 "")
  (SETVAR "OSMODE" 16383)
  (princ))

(defun btk_lst( SH* DK* SC* TCD* / Khoiluong*)
  (setq Khoiluong*
          (* (* (* (* pi (expt (/ (* DK* 0.001) 2) 2))
               (* TCD* 0.001)
            )
            7850
         )
         SC*
          )
       )
  (setq Bang_Thong_ke
         (append
           Bang_Thong_ke
           (list (cons SH*
               (list DK*
                 SC*
                 TCD*
                 Khoiluong*
               )
             )
           )
         )
      )
  )

(defun GetTagVal (obj tagName / str);By Gia_Bach
  (foreach att (vlax-invoke obj 'GetAttributes)
    (if (= tagName (vla-get-tagstring att))
      (setq str (vla-get-TextString att) ) ) )
  str)

(defun ChangeTagVal (obj tagName val)
  (foreach att (vlax-invoke obj 'GetAttributes)
    (if (= tagName (vla-get-tagstring att))
      (progn
    (vla-put-textstring att val)
    (vla-update att)  ) ) ) )

(defun ATTB_ThepDam (ss / SH DK SC TCD Khoiluong Bang_Thong_ke) 
  (vl-load-com)
  (defun *error* (msg)
    (if    Olmode
      (setvar 'osmode Olmode)
    )
    (if    (not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )
  (setq Olmode (getvar "OSMODE"))
  (setvar "CMDECHO" 0)
  (setvar "OSMODE" 0)
  (setq Bang_Thong_ke (list))
  (setq i 0)
  
  (while (< i (sslength ss))
      (setq ent (ssname ss i))
      (setq obj (vlax-ename->vla-object ent))   
(if (AND (GetTagVal obj "DKN")(GetTagVal obj "DK1")(GetTagVal obj "DK2"))
    (Progn
      (Setq SH (GetTagVal obj "SH"))
      (Setq DK (atoi(GetTagVal obj "DKN")))
      (Setq SC (atoi(GetTagVal obj "SCN")))
      (Setq TCD (atof(GetTagVal obj "TCDN")))
      (btk_lst SH DK SC TCD)
      (Setq DK (atoi(GetTagVal obj "DK1")))
      (Setq SC (atoi(GetTagVal obj "SC1")))
      (Setq TCD (atof(GetTagVal obj "TCD1")))
      (btk_lst SH DK SC TCD)
      (Setq DK (atoi(GetTagVal obj "DK2")))
      (Setq SC (atoi(GetTagVal obj "SC2")))
      (Setq TCD (atof(GetTagVal obj "TCD2")))
      (btk_lst SH DK SC TCD)
    );end Progn
  (if (AND (GetTagVal obj "DK")(GetTagVal obj "SC")(GetTagVal obj "TCD"))
    (Progn
      (Setq SH (GetTagVal obj "SH"))
      (Setq DK (atoi(GetTagVal obj "DK")))
      (Setq SC (atoi(GetTagVal obj "SC")))
      (Setq TCD (atof(GetTagVal obj "TCD")))
      (btk_lst SH DK SC TCD)
    );end Progn
  (princ (strcat "\nKhong tim thay du lieu")) 
  )
  )
   (setq i (1+ i)) 
  )
  Bang_Thong_ke
  )

PS: ko biết cho vào thẻ lisp, bạn nào biết chỉ giùm


<<

Filename: 434874_00.lsp
Tác giả: anhGeodesy
Bài viết gốc: 434883
Tên lệnh: 22
1 giờ} trướ}c, Biet ve CAD đã nói:

Cũng đoán mò ý đồ của...

>>
1 giờ} trướ}c, Biet ve CAD đã nói:

Cũng đoán mò ý đồ của tác giả vì ko biết cái thống kê ấy ra cái gì nữa ^^

Bạn xem đúng ý chưa nhé, chọn được cả 3 loại block trong bản vẽ và princ ra 1 list theo yêu cầu

  • 00.lsp
    lisp help
  •  

(defun c:00 ( )
  (vl-load-com)
  (Setvar "CMDECHO" 0)
  ;(command "TEXTSCR" "")
 (princ "\nChon Block can tong hop\n :")
  (if (setq ss (ssget (list (cons 0 "INSERT") (cons 66 1))))
    (princ(ATTB_ThepDam ss)) 
  )
  ;(AT:Table_Thongkethep Bang_Thong_ke 220 100 "")
  (SETVAR "OSMODE" 16383)
  (princ))

(defun btk_lst( SH* DK* SC* TCD* / Khoiluong*)
  (setq Khoiluong*
          (* (* (* (* pi (expt (/ (* DK* 0.001) 2) 2))
               (* TCD* 0.001)
            )
            7850
         )
         SC*
          )
       )
  (setq Bang_Thong_ke
         (append
           Bang_Thong_ke
           (list (cons SH*
               (list DK*
                 SC*
                 TCD*
                 Khoiluong*
               )
             )
           )
         )
      )
  )

(defun GetTagVal (obj tagName / str);By Gia_Bach
  (foreach att (vlax-invoke obj 'GetAttributes)
    (if (= tagName (vla-get-tagstring att))
      (setq str (vla-get-TextString att) ) ) )
  str)

(defun ChangeTagVal (obj tagName val)
  (foreach att (vlax-invoke obj 'GetAttributes)
    (if (= tagName (vla-get-tagstring att))
      (progn
    (vla-put-textstring att val)
    (vla-update att)  ) ) ) )

(defun ATTB_ThepDam (ss / SH DK SC TCD Khoiluong Bang_Thong_ke) 
  (vl-load-com)
  (defun *error* (msg)
    (if    Olmode
      (setvar 'osmode Olmode)
    )
    (if    (not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )
  (setq Olmode (getvar "OSMODE"))
  (setvar "CMDECHO" 0)
  (setvar "OSMODE" 0)
  (setq Bang_Thong_ke (list))
  (setq i 0)
  
  (while (< i (sslength ss))
      (setq ent (ssname ss i))
      (setq obj (vlax-ename->vla-object ent))   
(if (AND (GetTagVal obj "DKN")(GetTagVal obj "DK1")(GetTagVal obj "DK2"))
    (Progn
      (Setq SH (GetTagVal obj "SH"))
      (Setq DK (atoi(GetTagVal obj "DKN")))
      (Setq SC (atoi(GetTagVal obj "SCN")))
      (Setq TCD (atof(GetTagVal obj "TCDN")))
      (btk_lst SH DK SC TCD)
      (Setq DK (atoi(GetTagVal obj "DK1")))
      (Setq SC (atoi(GetTagVal obj "SC1")))
      (Setq TCD (atof(GetTagVal obj "TCD1")))
      (btk_lst SH DK SC TCD)
      (Setq DK (atoi(GetTagVal obj "DK2")))
      (Setq SC (atoi(GetTagVal obj "SC2")))
      (Setq TCD (atof(GetTagVal obj "TCD2")))
      (btk_lst SH DK SC TCD)
    );end Progn
  (if (AND (GetTagVal obj "DK")(GetTagVal obj "SC")(GetTagVal obj "TCD"))
    (Progn
      (Setq SH (GetTagVal obj "SH"))
      (Setq DK (atoi(GetTagVal obj "DK")))
      (Setq SC (atoi(GetTagVal obj "SC")))
      (Setq TCD (atof(GetTagVal obj "TCD")))
      (btk_lst SH DK SC TCD)
    );end Progn
  (princ (strcat "\nKhong tim thay du lieu")) 
  )
  )
   (setq i (1+ i)) 
  )
  Bang_Thong_ke
  )

PS: ko biết cho vào thẻ lisp, bạn nào biết chỉ giùm

Trước tiên xin chân thành cảm ơn bạn @Biet ve CAD đã nhiệt tình giúp đỡ.

1)  Đoạn code bạn sửa đọc 1 Block cho ra 2 phần tử trùng nhau :     ((B2 20 4 4650.0 45.8704))((B2 20 4 4650.0 45.8704))

2) để gắn thẻ ai đó bấm @ trước nickname.

Mình đã làm được rồi.

(defun c:22 (/ Bang_Thong_ke doc)
  (vl-load-com)
  (Setvar "CMDECHO" 0)
  ;(command "TEXTSCR" "")
 (princ "\nChon Block can tong hop\n :")
  (if (setq ss (ssget (list (cons 0 "INSERT") (cons 66 1))))
 (setq Bang_Thong_ke (ATTB_ThepDam ss))
  )
  ;(AT:Table_Thongkethep Bang_Thong_ke 220 100 "")
  (SETVAR "OSMODE" 16383)
  (princ))

(defun GetTagVal (obj tagName / str);By Gia_Bach
  (foreach att (vlax-invoke obj 'GetAttributes)
    (if (= tagName (vla-get-tagstring att))
      (setq str (vla-get-TextString att) ) ) )
  str)

(defun ChangeTagVal (obj tagName val)
  (foreach att (vlax-invoke obj 'GetAttributes)
    (if (= tagName (vla-get-tagstring att))
      (progn
    (vla-put-textstring att val)
    (vla-update att)  ) ) ) )

(defun ATTB_ThepDam (ss / SH DK SC TCD Khoiluong Bang_Thong_ke) 
  (vl-load-com)
  (defun *error* (msg)
    (if    Olmode
      (setvar 'osmode Olmode)
    )
    (if    (not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )
  (setq Olmode (getvar "OSMODE"))
  (setvar "CMDECHO" 0)
  (setvar "OSMODE" 0)
  (setq Bang_Thong_ke (list))
  (setq i 0)
  
  (while (< i (sslength ss))
      (setq ent (ssname ss i))
      (setq obj    (vlax-ename->vla-object ent)
      )
;===========================================================================================================
;TK THEP CHU DAM
(if (and (GetTagVal obj "DK") (GetTagVal obj "SC") (GetTagVal obj "TCD") (NOT(GetTagVal obj "A")))
    (Progn
      (Setq SH (GetTagVal obj "SH"))
      (Setq DK (atoi (GetTagVal obj "DK")))
      (Setq SC (atoi (GetTagVal obj "SC")))
      (Setq TCD (atof (GetTagVal obj "TCD")))
      (setq
         Khoiluong
          (*(* (* (* pi (expt (/ (* DK 0.001) 2) 2))
            (* TCD 0.001)
         )
         7850
          )SC)
       )
      (setq Bang_Thong_ke
         (append
           Bang_Thong_ke
           (list (cons SH
               (list (atoi (rtos DK 2 0))
                 (atoi (rtos SC 2 0))
                 (atoi (rtos TCD 2 0))
                 Khoiluong
               )
             )
           )
         )
      )     
    )
  )
;===========================================================================================================
;DAI DAM 1 DOAN    
(if (and (GetTagVal obj "SH")(GetTagVal obj "SC")(GetTagVal obj "DK") (GetTagVal obj "A")(GetTagVal obj "TCD"))
    (Progn
      (Setq SH (GetTagVal obj "SH"))
      (Setq DK (atoi (GetTagVal obj "DK")))
      (Setq SC (atoi (GetTagVal obj "SC")))
      (Setq TCD (atof (GetTagVal obj "TCD")))
      (Setq A (atof (GetTagVal obj "A")))
      (Setq B (atof (GetTagVal obj "B")))
      (Setq H (atof (GetTagVal obj "H")))
      ;'''''''''''''''''''''''''''''''''''
      (setq L_1dai (+(+(- B 80)(- H 80))100))
      (setq
         Khoiluong
          (*(* (* (* pi (expt (/ (* DK 0.001) 2) 2))
            (* L_1dai 0.001)
         )
         7850
          )SC)
       )
      ;'''''''''''''''''''''''''''''''''''
      (setq Bang_Thong_ke
         (append
           Bang_Thong_ke
           (list (cons SH
               (list (atoi (rtos DK 2 0))
                 (atoi (rtos SC 2 0))
                 (atoi (rtos(* L_1dai SC) 2 0))
                 Khoiluong
               )
             )
           )
         )
      )
    )
  )
;===========================================================================================================
;DAI DAM 3 DOAN
;===========================================================================================================
    (if (GetTagVal obj "AN")
    (Progn
      (Setq SH (GetTagVal obj "SH"))
      (Setq DK (atoi (GetTagVal obj "DKN")))
      (Setq SC (atoi (GetTagVal obj "SCN")))
      (Setq TCD (atof (GetTagVal obj "TCDN")))
      (Setq AN (atof (GetTagVal obj "AN")))
      (Setq B (atof (GetTagVal obj "B")))
      (Setq H (atof (GetTagVal obj "H")))
            ;'''''''''''''''''''''''''''''''''''
      (setq L_1dai (+(+(- B 80)(- H 80))100))
      (setq
         Khoiluong
          (*(* (* (* pi (expt (/ (* DK 0.001) 2) 2))
            (* L_1dai 0.001)
         )
         7850
          )SC)
       )
      ;'''''''''''''''''''''''''''''''''''
      (setq Bang_Thong_ke
         (append
           Bang_Thong_ke
           (list (cons SH
               (list (atoi (rtos DK 2 0))
                 (atoi (rtos SC 2 0))
                 (atoi (rtos(* L_1dai SC) 2 0))
                 Khoiluong
               )
             )
           )
         )
      )
      )
    )
    
    (if (GetTagVal obj "A1")
    (Progn
      (Setq SH (GetTagVal obj "SH"))
      (Setq DK (atoi (GetTagVal obj "DK1")))
      (Setq SC (atoi (GetTagVal obj "SC1")))
      (Setq TCD (atof (GetTagVal obj "TCD1")))
      (Setq A1 (atof (GetTagVal obj "A1")))
      (Setq B (atof (GetTagVal obj "B")))
      (Setq H (atof (GetTagVal obj "H")))
      ;'''''''''''''''''''''''''''''''''''
      (setq L_1dai (+(+(- B 80)(- H 80))100))
      (setq
         Khoiluong
          (*(* (* (* pi (expt (/ (* DK 0.001) 2) 2))
            (* L_1dai 0.001)
         )
         7850
          )SC)
       )
      ;'''''''''''''''''''''''''''''''''''
      (setq Bang_Thong_ke
         (append
           Bang_Thong_ke
           (list (cons SH
               (list (atoi (rtos DK 2 0))
                 (atoi (rtos SC 2 0))
                 (atoi (rtos(* L_1dai SC) 2 0))
                 Khoiluong
               )
             )
           )
         )
      )
    )
      )
    
    (if (GetTagVal obj "A2")
    (Progn
      (Setq SH (GetTagVal obj "SH"))
      (Setq DK (atoi (GetTagVal obj "DK2")))
      (Setq SC (atoi (GetTagVal obj "SC2")))
      (Setq TCD (atof (GetTagVal obj "TCD2")))
      (Setq A1 (atof (GetTagVal obj "A2")))
      ;'''''''''''''''''''''''''''''''''''
      (setq L_1dai (+(+(- B 80)(- H 80))100))
      (setq
         Khoiluong
          (*(* (* (* pi (expt (/ (* DK 0.001) 2) 2))
            (* L_1dai 0.001)
         )
         7850
          )SC)
       )
      ;'''''''''''''''''''''''''''''''''''
      (setq Bang_Thong_ke
         (append
           Bang_Thong_ke
           (list (cons SH
               (list (atoi (rtos DK 2 0))
                 (atoi (rtos SC 2 0))
                 (atoi (rtos(* L_1dai SC) 2 0))
                 Khoiluong
               )
             )
           )
         )
      )
    )
      )
;===========================================================================================================
      (setq i (1+ i))
    
  )
          Bang_Thong_ke
      (Princ Bang_Thong_ke)
  )

 


<<

Filename: 434883_22.lsp
Tác giả: Ar_Chanwoo
Bài viết gốc: 14261
Tên lệnh: test reset
code giới hạn thời gian sử dụng File lisp
Với file lisp thì rất khó để làm được điều này. Bởi người biết sử dụng lisp sẽ vô hiệu hoá ngay nếu như đọc được mã lisp. Tuy nhiên, có thể làm được...
>>
Với file lisp thì rất khó để làm được điều này. Bởi người biết sử dụng lisp sẽ vô hiệu hoá ngay nếu như đọc được mã lisp. Tuy nhiên, có thể làm được điều này với 1 file VLX đã được mã hoá. Cách làm thông thường như sau: Ghi thông tin các lần sử dụng lệnh vào 1 vị trí trên registry, hoặc vào file config của AutoCAD. Sau đó, đọc các thông tin này để có hành động phù hợp.

 

Sau đây là 1 ví dụ đơn giản:

(defun c:TEST()
 ;;; Doc gia tri
 (setq tmp (getcfg "AppData/CADViet/Count")
sl (cond
     ((or (not tmp) (= tmp "")) "5")
     (t tmp)
   )
 )

 ;;; Kiem tra va thong bao
 (if (/= sl "0")
   (progn
     ;;; Thuc thi ma lenh
     (princ (strcat "\nBan con " sl " lan su dung nua"))      
     ;;; Luu gia tri
     (setcfg "AppData/CADViet/Count" (itoa (1- (atoi sl))))
   )
   (princ "\nBan da het han su dung!")
 )  

 (princ)
)

(defun c:RESET()
 ;;; Reset lai gia tri
 (setcfg "AppData/CADViet/Count" "")
 (princ)
)

 

Lệnh TEST để xác định số lần thực thi. Chỉ thực thi lệnh được 5 lần. Không quan trọng ngày tháng, không quan trọng số lần sử dụng ACAD, cứ dùng lệnh TEST quá 5 lần là hết hạn.

Lệnh RESET để khởi tạo lại giá trị.

 

Tất nhiên, ví dụ trên là 1 cái khoá đơn giản chỉ khoá được người ngay chứ không khoá được kẻ gian.

 

 

Anh Hoành giải thích rõ hơn hộ e đc ko? Ví dụ e có 1 lisp tên là Cuaso.lsp, có đường dẫn là c:\cadviet\lisp và có lệnh là CUA thì phải sửa lại lisp trên như thế nào!


<<

Filename: 14261_test_reset.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 191850
Tên lệnh: ktd
Hỏi về Lisp (thuật toán, ý tưởng, coding,...)

Cũng hơi khó trả lời câu của bạn. Vì mình không biết Command của bạn báo gì???

Bạn đọc và thử code nhé:

>>

Cũng hơi khó trả lời câu của bạn. Vì mình không biết Command của bạn báo gì???

Bạn đọc và thử code nhé:

(defun c:ktd()
(if (tblsearch "STYLE" "dimstyle")
   (setvar "DIMTXSTY" "dimstyle")
   (Progn
     (command "style" "dimstyle" "VHELVCN.TTF" "0" "1" "0" "n" "n")
     (setvar "DIMTXSTY" "dimstyle")
   )
)
)

Nó lỗi, dù cad đã có font file VHELVCN.TTF

Trích dẫn:

Command: ktd

style Enter name of text style or <Standard>: dimstyle

New style.

Specify full font name or font filename (TTF or SHX) <txt>: VHELVCN.TTF

Font file doesn't exist.

Command: 0 Unknown command "0". Press F1 for help.

Command: 1 Unknown command "1". Press F1 for help.

Command: 0 Unknown command "0". Press F1 for help.

Command: n Unknown command "N". Press F1 for help.

Command: n Unknown command "N". Press F1 for help.

Command: ; error: AutoCAD variable setting rejected: "DIMTXSTY" "dimstyle"


<<

Filename: 191850_ktd.lsp
Tác giả: nguoi_tho_mo
Bài viết gốc: 120444
Tên lệnh: ft
Xin mẹo Scale chữ số
Bạn thử cái này nhé. Mình để chiều cao Dim mặc định là bằng 1/150 chiều rộng (ngắn) của blok khung tên. Chiều cao Text cao hơn Dim là 1,2 lần

 

>>
Bạn thử cái này nhé. Mình để chiều cao Dim mặc định là bằng 1/150 chiều rộng (ngắn) của blok khung tên. Chiều cao Text cao hơn Dim là 1,2 lần

 

(defun BatDau() (setq OldOs (getvar "osmode")) (setvar "osmode" 0))
(defun KetThuc() (setvar "osmode" OldOs)(princ))
(defun moddxf (dxf chdxf ss) (entmod (subst (cons dxf chdxf) (assoc dxf (entget ss)) (entget ss))))
;=========== FIX DIM TEXT ===========;
;Chinh chieu cao cua dim & text theo ;
;chieu rong(ngan) cua block khung ten;
;Mac dinh la = 1/150 chieu rong k/ten;
;====================================;
(defun c:ft (/ Rec pt1 pt2 rpt1 rpt2 rpt3 rpt4 dis12 dis14 dis toadodinh 
caodim tilechu textgap dimxtend i el1 el ssd en OldOs OldEcho )
(vl-load-com)
(setq OldEcho (getvar "cmdecho")) 
(setvar "cmdecho" 0)
(command "undo" "be")
(princ "\n      From nguyentuyen6 @CadViet ")
(princ "\n Cai Express-Tools truoc khi su dung!!!")
(setq Rec (acet-ent-geomextents (car (entsel "\nChon block khung ten:")))
	  pt1 (nth 0 Rec);lay dinh               *-----pt2
	  pt2 (nth 1 Rec);lay dinh               | khung |
	  i 0);setq                              pt1-----*	
;-----acet-ent-geomextents:diem thap nhat trai va cao nhat phai, ve hcn
(BatDau)
(command "RECTANG" pt1 pt2)
(KetThuc)	
(setq el1 (entlast));el1
;-----lay tile, mac dinh la :1
(setq
 tileft (cond (tileft) (1))
 tileftold tileft
 tileft   (getreal (strcat "\nChon ty le <"(rtos tileftold 2 2)">: "))
)
(if (= tileft nil) (setq tileft tileftold))
;-----lay dinh HCN = acet-geom-vertex-list
(setq toadodinh (acet-geom-vertex-list el1);    	  rpt4----rpt3
	  rpt1 (nth 0 toadodinh);lay dinh                  |  el1 |
	  rpt2 (nth 1 toadodinh);lay dinh                 rpt1----rpt2
	  rpt3 (nth 2 toadodinh);lay dinh 
	  rpt4 (nth 3 toadodinh);lay dinh
	  dis12 (distance rpt1 rpt2)
	  dis14 (distance rpt1 rpt4));setq
;----- Chia truong hop khung ngang va khung doc
(if (> dis12 dis14)		  
	  (setq caodim (* tileft (/ dis14 150)));T
	  (setq caodim (* tileft (/ dis12 150)));F
) ;if
(setq textgap (/ caodim 2); k/c tu Text den duong Dim
  dimxtend (/ caodim 2);k/c dau dim 
  tilechu (* caodim 1.2); cao Text so voi cao Dim(text)
  ) 
;-----	
(command "ERASE" el1 "");xoa hcn		 
(princ (strcat "\nDim:<" (rtos caodim 2 0) ">. Text:<" (rtos tilechu 2 0) ">. Chon Dim & Text can Fix:"))
;======================= M A I N =============================
(setq ssd (ssget '((0 . "DIMENSION,TEXT")))); loc dim text
(while (< i (sslength ssd))
(setq en (ssname ssd i))
;---- Text -----
(if (= (cdr (assoc 0 (entget en))) "TEXT")
	(moddxf 40 tilechu en)
);if
;-- DIMENSION -----
(if (= (cdr (assoc 0 (entget en))) "DIMENSION")
	(progn 
		(setq el (vlax-ename->vla-object en))
		(vlax-put-property el 'ScaleFactor 1); chinh Scalefactor
		(vlax-put-property el 'textheight caodim); chieu cao text trong dim
		(vlax-put-property el 'textgap textgap); k/c tu Text den duong Dim
		(vlax-put-property el 'ArrowheadSize dimxtend); do lon mui ten
		(vlax-put-property el 'DimensionLineExtend dimxtend);k/c 2 ben duong dim
		(vlax-put-property el 'ExtensionLineExtend dimxtend);k/c duong giong dim -> duong dim
		(vlax-put-property el 'Arrowhead1Block "ArchTick"); loai mui ten
		(vlax-put-property el 'Arrowhead2Block "ArchTick"); loai mui ten			
	);progn						  
);if					  
(setq i (1+ i))	 
);while
;---------------
(command "undo" "e")
(KetThuc)
(setvar "cmdecho" OldEcho)
(princ "\n...Done...")
(princ)
);defun

Rất hiệu quả.

Xin cảm ơn bác.

Chúc bác nghiên cứu thêm nhiều ứng dụng hơn nữa


<<

Filename: 120444_ft.lsp
Tác giả: Doan Nguyen Van
Bài viết gốc: 434953
Tên lệnh: vd
LISP SO SÁNH
2 giờ trước, Han Tinh đã nói:

Mình gởi hình minh họa cho mọi...

>>
2 giờ trước, Han Tinh đã nói:

Mình gởi hình minh họa cho mọi người dễ hình dung nha!

Ví dụ: lisp có lệnh tắt là SZ

Gõ lệnh SZ, sau đó chọn tất cả các đối tượng thì nó sẽ ra như hình bên dưới.

 

HINH MINH HOA.png

(defun c:vd (/ ss fixc ss2 x i ent txtm ent2 ss2 txt2 str)
  (vl-load-com)
  (prompt "\nL\U+1EF1a ch\U+1ECDn c\U+00E1c Text m\U+1EABu \U+0111\U+1EC3 so s\U+00E1nh!")
  (setq ss (acet-ss-to-list (ssget (list (cons 0 "TEXT")))))
  (if (setq fixc (car
(entsel "\nPick Text c\U+00F3 n\U+1ED9i dung kh\U+00F4ng \U+0111\U+1ED5i, ho\U+1EB7c pick kho\U+1EA3ng tr\U+1EAFng \U+0111\U+1EC3 t\U+1EF1 nh\U+1EADp!")))
    (setq fixc (cdr (assoc 1 (entget fixc))))
    (setq fixc (getstring T "\nNh\U+1EADp n\U+1ED9i dung kh\U+00F4ng \U+0111\U+1ED5i!")))
  (prompt "\nQu\U+00E9t ch\U+1ECDn t\U+1EA5t c\U+1EA3 c\U+00E1c TEXT!")
  (setq ss2 (acet-ss-to-list(ssget (list (cons 0 "TEXT") (cons 1 (strcat fixc "*"))))))
  (mapcar '(lambda (x) (vla-put-color (vlax-ename->vla-object x) 1)) ss2)
  (setq i 2)
  (setq str "")
  (foreach ent ss
    (setq txtm (cdr (assoc 1 (entget ent))))
    (setq j 0)
    (setq test "false")
    (foreach ent2 ss2
      (setq txt2 (cdr (assoc 1 (entget ent2)))
	    txt2 (substr txt2 (+ (strlen fixc) 1)))
      (if (= txtm txt2) (progn 
	(vla-put-color (vlax-ename->vla-object ent2) i)
	(vla-put-color (vlax-ename->vla-object ent) i)
	(setq j (1+ j))
	(setq test "true")
	))
      )
    (if (= test "false") (vla-put-color (vlax-ename->vla-object ent) 1) (setq i (1+ i)))
    (setq str (strcat str "Text so s\U+00E1nh: " txtm " - " fixc txtm " c\U+00F3 s\U+1ED1 l\U+01B0\U+1EE3ng : " (itoa j)    "\n"))
    )
  (prompt str)
  (alert str)
  )

Thao tác: 1- Lựa chọn dãy text 2

                  2- Pick hoặc nhập nội dung string trước dãy text 2 (fix)

3- quét chọn toàn bộ text để so sánh và đếm số lượng.

Hạn chế: Chỉ áp dụng đối tượng là TEXT.


<<

Filename: 434953_vd.lsp
Tác giả: minhah8767
Bài viết gốc: 419433
Tên lệnh: cld
Lisp Tự Động Revcloud Các Đối Tượng Cùng 1 Layer

 

Có thể viết được chọn theo layer, nhưng tốt hơn bạn nên quét chọn các pl để cloud. Thao tác là bạn chọn block revision,...

>>

 

Có thể viết được chọn theo layer, nhưng tốt hơn bạn nên quét chọn các pl để cloud. Thao tác là bạn chọn block revision, tiếp theo chọn các pl.

Còn về arc và kiểu cloud bạn có thể chọn bằng cách dùng lệnh revclound bên ngoài để trong lisp tự động theo

(defun c:cld (/ dt bl sdt id en)
  (command "Undo" "be")
  (setq osm (getvar "osmode")
	bl (cdr (assoc 2 (entget(car (entsel "\nSelect Revision block:")))))
	dt (ssget '((-4 . "<OR")
		(0 . "LWPOLYLINE")		    
		(-4 . "OR>")	
		))
	sdt (sslength dt)
	id 0
	)
  (setvar "osmode" 0)
  (repeat sdt
    (while
      (setq en (ssname dt id)
	    id (1+ id)
	    )
      (cloud en)
      )
    )
  (setvar "osmode" osm)
  (command "undo" "end")
  (princ)
  )
    
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;	
(defun cloud (en / p0 p1 pm)
  (setq p0 (vlax-curve-getPointAtParam en 0)
	p1 (vlax-curve-getPointAtParam en 1)
	pm (list (/(+(car p0)(car p1))2) (+(/(+(cadr p0)(cadr p1 ))2)8))
	)
  (command "revcloud" "o" en "")
  (entmake (list  (cons 0 "insert")  (cons 2 bl) (cons 10 pm)))
  ) 

 

Lời đầu tiên cho mình cám ơn bạn . Mình đã test thử lisp bạn gửi lên , có 1 số điểm như sau

 

1) Lisp mỗi lần chỉ chạy được mỗi hình . Mình chọn 3 hình ( 2 rec + 1 pl ) , nó chỉ revcloud được 1 hình duy nhất , thử nhiều trường hợp khác cũng như thế . Block revision ở đây là cái gì nhỉ ( mình ko hiểu cho lắm )

2) Mình muốn khi chọn layer xong >>> quét nguyên 1 bản vẽ , những hình nào do mình vẽ bằng layer mình đặt ra để cloud thì nó sẽ tự cloud . Vì mình đặt riêng 1 layer cho cái mình cần cloud. 

 

Hình của mình có rất nhiều hình khối nên thiết nghĩ quét = layer thì hay hơn lại nhanh hơn :D

 

Bạn xem xét giùm mình , nếu được mình cám ơn nhiều....


<<

Filename: 419433_cld.lsp
Tác giả: quocmanh04tt
Bài viết gốc: 435020
Tên lệnh: tt+%C2%A0
LISP SO SÁNH

Bạn thử lại cái này xem sao:

(defun c:tt  (/ e l m s _n)
  (setq _n (lambda (txt / str)
             (setq str (cdr (assoc 1 (entget txt))))
             (substr str (1+ (strlen (vl-string-right-trim "0123456789" str))))))
  (if (setq s (ssget '((0 . "TEXT"))))
    ((lambda (n)
       (while (and (setq e (ssname s 0)) (ssdel e s)) (setq l (cons e l)))
       (while (>...
>>

Bạn thử lại cái này xem sao:

(defun c:tt  (/ e l m s _n)
  (setq _n (lambda (txt / str)
             (setq str (cdr (assoc 1 (entget txt))))
             (substr str (1+ (strlen (vl-string-right-trim "0123456789" str))))))
  (if (setq s (ssget '((0 . "TEXT"))))
    ((lambda (n)
       (while (and (setq e (ssname s 0)) (ssdel e s)) (setq l (cons e l)))
       (while (> (length l) 1)
         (setq m 0)
         (if (> (strlen (_n (car l))) 0)
           (foreach x  (cdr l)
             (if (eq (_n x) (_n (car l)))
               (progn (entmod (append (entget x) (list (cons 62 n))))
                      (setq l (vl-remove x l))
                      (setq m (1+ m))))))
         (if (> m 0)
           (progn (entmod (append (entget (car l)) (list (cons 62 n))))
                  (setq n (cond ((< n 254) (1+ n))
                                (2)))))
         (setq l (cdr l))))
      2))
  (princ))

 


<<

Filename: 435020_tt+%C2%A0.lsp

Trang 288/304

288