Em muốn hỏi về lisp vừa copy vừa quay đối tượng

Tháng 5 5, 2009

Có cái Lisp này rồi nhưng nó lại ko dùng để Copy Multiple được (lệnh CD ấy). Bác nào có thể sửa giúp em được ko ạ. Với cả, bỏ luôn giúp em mấy cái lệnh cắt Dim đi nhé, chỉ để lại lệnh để copy-xoay đối tượng, và phải Copy Multiple. Thanks các bác trước vậy :(

(DEFUN C:XX (/ CMD SS LTH DEM PT DS KDL N70 GOCX GOCY PT13 PT14 PTI PT13I PT14I
               PT13N PT14N O13 O14 N13 N14 OSM OLDERR PT10 PT11)
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ OSM (GETVAR "OSMODE"))
(SETQ OLDERR *error*
     *error* myerror)
(PRINC "Please select dimension object!")
(SETQ SS (SSGET))
(SETVAR "CMDECHO" 0)
(SETQ PT (GETPOINT "Point to trim or extend:"))
(SETQ PT (TRANS PT 1 0))
(COMMAND "UCS" "W")
(SETQ LTH (SSLENGTH SS))
(SETQ DEM 0)
(WHILE (< DEM LTH)
   (PROGN
(SETQ DS (ENTGET (SSNAME SS DEM)))
(SETQ KDL (CDR (ASSOC 0 DS)))
(IF (= "DIMENSION" KDL)
   (PROGN
	(SETQ PT10 (CDR (ASSOC 10 DS)))
	(SETQ PT11 (CDR (ASSOC 11 DS)))
	(SETQ PT13 (CDR (ASSOC 13 DS)))
	(SETQ PT14 (CDR (ASSOC 14 DS)))
	(SETQ N70 (CDR (ASSOC 70 DS)))
	(IF (OR (= N70 32) (= N70 33) (= N70 160) (= N70 161))
	   (PROGN
		(SETQ GOCY (ANGLE PT10 PT14))
		(SETQ GOCX (+ GOCY (/ PI 2)))
	   )
	)
	(SETVAR "OSMODE" 0)
	(SETQ PTI (POLAR PT GOCX 2))
	(SETQ PT13I (POLAR PT13 GOCY 2))
	(SETQ PT14I (POLAR PT14 GOCY 2))
	(SETQ PT13N (INTERS PT PTI PT13 PT13I NIL))
	(SETQ PT14N (INTERS PT PTI PT14 PT14I NIL))
	(SETQ O13 (ASSOC 13 DS))
	(SETQ O14 (ASSOC 14 DS))
	(SETQ N13 (CONS 13 PT13N))
	(SETQ N14 (CONS 14 PT14N))
	(SETQ DS (SUBST N13 O13 DS))
	(SETQ DS (SUBST N14 O14 DS))
	(ENTMOD DS)
   )
)
(SETQ DEM (+ DEM 1))
   )
)
(COMMAND "UCS" "P")
(SETVAR "CMDECHO" CMD)
(SETVAR "OSMODE" OSM)
(setq *error* OLDERR)               ; Restore old *error* handler
(PRINC)
)
;******************************************************************************

(DEFUN C:YY (/ CMD SS LTH DEM PT DS KDL N70 GOCX GOCY PT13 PT14 PTI
               PT10 PT10I PT10N O10 N10 PT11 PT11N O11 N11 KC OSM OLDERR)
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ OSM (GETVAR "OSMODE"))
(SETQ OLDERR *error*
     *error* myerror)
(PRINC "Please select dimension object!")
(SETQ SS (SSGET))
(SETVAR "CMDECHO" 0)
(SETQ PT (GETPOINT "Point to trim or extend:"))
(SETQ PT (TRANS PT 1 0))
(COMMAND "UCS" "W")
(SETQ LTH (SSLENGTH SS))
(SETQ DEM 0)
(WHILE (< DEM LTH)
   (PROGN
(SETQ DS (ENTGET (SSNAME SS DEM)))
(SETQ KDL (CDR (ASSOC 0 DS)))
(IF (= "DIMENSION" KDL)
   (PROGN
	(SETQ PT13 (CDR (ASSOC 13 DS)))
	(SETQ PT14 (CDR (ASSOC 14 DS)))
	(SETQ PT10 (CDR (ASSOC 10 DS)))
	(SETQ PT11 (CDR (ASSOC 11 DS)))
	(SETQ N70 (CDR (ASSOC 70 DS)))
	(IF (OR (= N70 32) (= N70 33) (= N70 160) (= N70 161))
	   (PROGN
		(SETQ GOCY (ANGLE PT10 PT14))
		(SETQ GOCX (+ GOCY (/ PI 2)))
	   )
	)
	(SETVAR "OSMODE" 0)
	(SETQ PTI (POLAR PT GOCX 2))
	(SETQ PT10I (POLAR PT10 GOCY 2))
	(SETQ PT10N (INTERS PT PTI PT10 PT10I NIL))
	(SETQ KC (DISTANCE PT10 PT10N))
	(SETQ O10 (ASSOC 10 DS))
	(SETQ N10 (CONS 10 PT10N))
	(SETQ DS (SUBST N10 O10 DS))
	(SETQ PT11N (POLAR PT11 (ANGLE PT10 PT10N) KC))
	(SETQ O11 (ASSOC 11 DS))
	(SETQ N11 (CONS 11 PT11N))
	(SETQ DS (SUBST N11 O11 DS))
	(ENTMOD DS)
   )
)
(SETQ DEM (+ DEM 1))
   )
)
(COMMAND "UCS" "P")
(SETVAR "CMDECHO" CMD)
(SETVAR "OSMODE" OSM)
(setq *error* OLDERR)
(PRINC)
)

;-----------------------
(defun c:cd (/ A B C D)
 (setvar "CMDECHO" 0)
 (prompt "\nFor rotated copy")
 (ssget)
 (setq A (getpoint "\nBase point: "))
 (command "ID" A)
 (setq B (getpoint "\nNew point  if same as Base point> "))
 (if (= B nil) (setq B A))
;  (setq D (/ (* (getangle B "\nRotation angle <0>: ") 180.0) pi))
 (command "COPY" "P" "" A A)
 (command "MOVE" "P" "" A :(
 (command "ROTATE" "P" "" B pause)
 (setvar "CMDECHO" 1)
)
;COP THONG MINH
(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

;COPY THONG MINH
(defun c:CV ( / 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 "TRAN LE PHUONG KSXD")
;Note: bien toan cuc: textxl vitrilech

Tháng 5 7, 2009

Ặc, ko bác nào giúp em à, sao mà chán vậy :(

Tháng 5 7, 2009

Có cái Lisp này rồi nhưng nó lại ko dùng để Copy Multiple được (lệnh CD ấy). Bác nào có thể sửa giúp em được ko ạ. Với cả, bỏ luôn giúp em mấy cái lệnh cắt Dim đi nhé, chỉ để lại lệnh để copy-xoay đối tượng, và phải Copy Multiple. Thanks các bác trước vậy :(

Dùng lệnh MOCORO đi bạn. Lệnh MOCORO là một trong những lệnh phụ trợ của Express. Có thể MOve, COpy, ROtate; Scale đối tượng trong cùng 1 lệnh

Tháng 5 10, 2009

Thanks bác, nhưng em cảm giác dùng lệnh này ko nhanh bằng Lisp :-?

Tháng 5 10, 2009

Thanks bác, nhưng em cảm giác dùng lệnh này ko nhanh bằng Lisp :-?

Theo em trên CAD có gì mình hãy dùng hết đi khai thác hết tiềm năng của CAD sau đó mới tính thêm chứ dùng lisp cũng được cơ mà anh phải chèn thêm 1 cái lisp vào CAD mà cái lisp này chắc gì anh đã dùng thường ngày??? có phải tốn ổ ko ??? khi có thêm lisp anh lại phải nhớ lệnh của nó có phải là hao tổn nơron thần kinh ko ???

Có những cái nào dùng lisp tiện lợi hơn hãy dùng thời gian nhanh chóng vài giây chả giải quyết vấn đề dì!

Anh có thấy vô lý ko??? khi nước ta có trên 3000 Km chiều dài bờ biển mà người ta vẫn phải nhập khẩu muối????

Ông Lê Nguyên Chương, Phó tổng giám đốc Tổng công ty Muối Việt Nam nói về lý do Việt Nam phải nhập khẩu muối.

http://vneconomy.vn/58562P0C10/nghich-ly-nhap-khau-muoi.htm

Đăng nhập

Em muốn hỏi về lisp vừa copy vừa quay đối tượng

Các bài được khuyến nghị

hai_1401 30

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

hai_1401 30

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Tue_NV 3915

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

hai_1401 30

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

haanh 1590

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Tạo tài khoản

Đăng nhập

Diễn đàn

Download

Đào tạo CADViet

Browse