Đến nội dung


Hình ảnh
- - - - -

Lisp các phép tính đại số tự động cập nhật khi giá trị nguồn thay đổi


  • Please log in to reply
50 replies to this topic

#41 hoangmx0126

hoangmx0126

    biết pan

  • Members
  • Pip
  • 5 Bài viết
Điểm đánh giá: -1 (bình thường)

Đã gửi 16 August 2013 - 09:12 AM

Cám ơn bác đã nhiệt tình!!! :)


  • -1

#42 bach1212

bach1212

    biết lệnh trim

  • Members
  • PipPipPip
  • 190 Bài viết
Điểm đánh giá: 5 (bình thường)

Đã gửi 16 August 2013 - 09:59 AM

Lấy ý tưởng từ bài viết ánh xạ text của bác NguyenHoanh và lisp ánh xạ text của anh Giabach. Mình vận dụng để viết một lisp để có thể tính toán trên các ánh xạ text này. Hy vọng nó sẽ giúp cho các bạn trong công việc:

;;;============================================================================================;;;-------------------LINK GIA TRI CUA DOI TUONG NAY DEN DOI TUONG TEXT KHAC (>=cad2006)-------------------;;;============================================================================================(vl-load-com);;;----------------------------------------;;;LINK CHIEU DAI(defun C:LL (/ obn Tkq)	(START_PG)	(setq obn (vlax-ename->vla-object (car (entsel "\nChon doi tuong nguon")))		obd	(vlax-ename->vla-object (car (nentsel "\nChon text ghi chieu dai")))		ltr	(I_INT0 "\n Nhap chu so lam tron" ltr)		hso	(I_REAL "\n Nhap he so nhan" hso)		Tkq	(strcat "%<\\AcObjProp Object(%<\\_ObjId "				(rtos (vla-get-objectid obn) 2 0)">%).Length \\f \"%lu2"				"%pr" (rtos ltr 2 0) "%ct8[" (rtos hso 2 0) "]" "\">%"			)	;ida	(strcat "%<\\AcObjProp.16.2 Object(%<\\_ObjId "                            ;(rtos (vla-get-objectid obn) 2 0) ">%).Length \\f \"%lu2%pr2%ct8[1]\">%")	;ew	(vlax-vla-object->ename (vla-objectidtoobject (vla-get-activedocument (vlax-get-acad-object))                            ;(vla-get-ownerid obd)))	)	(vla-put-textstring obd Tkq)	;(redraw ew 3)	;(entupd ew)	;(vla-update obw)	(vl-cmdf "regen")	(END_PG)	(princ));;;----------------------------------------;;;LINK GIA TRI(defun C:LGT (/ obn Tkq)	(START_PG)	(setq obn (vlax-ename->vla-object (car (nentsel "\nChon doi tuong nguon")))				obd	(vlax-ename->vla-object (car (nentsel "\nChon text dich")))				Tkq	(strcat "%<\\AcObjProp Object(%<\\_ObjId "										(rtos (vla-get-objectid obn) 2 0)										">%).TextString>%"						)	)	(vla-put-textstring obd Tkq)	(vla-update obd)	(vl-cmdf "regen")	(END_PG)	(princ));;;----------------------------------------;;;LINK TONG(defun C:LC (/ obn Lob Tgt)	(START_PG) 	(setq	ltr (I_INT0 "\n Nhap chu so lam tron" ltr)		Tgt "%<\\AcExpr (0")	(foreach obn	(setq Lob (ES_ENT_LMP "\nChon cac Gia tri can tinh tong/ENTER de ket thuc chon..."))		(setq Tgt	(strcat Tgt "+"                                           "%<\\AcObjProp Object(%<\\_ObjId "					(rtos (vla-get-objectid (vlax-ename->vla-object obn)) 2 0)					">%).TextString>%"				)		)	) 	(setq Tgt	(strcat Tgt ") \\f \"%lu2%pr" (itoa ltr) "\">%"))	(EX_VALUE_T_P_L Tgt (car Lob))	(vl-cmdf "regen")	(END_PG)	(princ));;;----------------------------------------;;;LINK TICH(defun C:LN (/ Tgt obn Lob)	(START_PG)	(setq	ltr (I_INT0 "\n Nhap chu so lam tron" ltr)				Tgt 	"%<\\AcExpr (1")	(foreach obn	(setq Lob (ES_ENT_LMP "\nChon cac Gia tri can tinh tich/ENTER de ket thuc chon..."))		(setq Tgt	(strcat Tgt "*"						"%<\\AcObjProp Object(%<\\_ObjId "						(rtos (vla-get-objectid (vlax-ename->vla-object obn)) 2 0)						">%).TextString>%"				)		)	) 	(setq Tgt	(strcat Tgt ") \\f \"%lu2%pr" (itoa ltr) "\">%"))	(EX_VALUE_T_P_L Tgt (car Lob))	(vl-cmdf "regen")	(END_PG)	(princ));;;----------------------------------------;;;LINK HIEU(defun C:LH (/ Tgt ent1 ent2)	(START_PG)	(setq ltr	(I_INT0 "\n Nhap chu so lam tron" ltr))	(while (null	(setq	ss1	 (ES_TM&D "\n Chon so bi tru..."))))	(while (null	(setq	ss2	 (ES_TM&D "\n Chon so tru..."))))	(setq ent1 (car (C_S2L ss1))				ent2 (car (C_S2L ss2))	)	(setq Tgt	(strcat "%<\\AcExpr (" 				"%<\\AcObjProp Object(%<\\_ObjId "				(rtos (vla-get-objectid (vlax-ename->vla-object ent1)) 2 0)				">%).TextString>%"				"-" "%<\\AcObjProp Object(%<\\_ObjId "				(rtos (vla-get-objectid (vlax-ename->vla-object ent2)) 2 0)				">%).TextString>%" ") \\f \"%lu2%pr" (itoa ltr) "\"" ">%"			)	)	(EX_VALUE_T_P_L Tgt ent1)	(vl-cmdf "regen")	(END_PG)	(princ));;;----------------------------------------;;;LINK CHIA(defun C:L/ (/ Tgt ent1 ent2)	(START_PG)	(setq ltr		(I_INT0 "\n Nhap chu so lam tron" ltr))	(while (null	(setq	ss1	 (ES_TM&D "\n Chon so BI CHIA..."))))	(while (null	(setq	ss2	 (ES_TM&D "\n Chon so CHIA.."))))	(setq ent1 	(car (C_S2L ss1))				ent2 	(car (C_S2L ss2))	)	(setq Tgt	(strcat "%<\\AcExpr (" 				"%<\\AcObjProp Object(%<\\_ObjId "				(rtos (vla-get-objectid (vlax-ename->vla-object ent1)) 2 0)				">%).TextString>%" "/"				"%<\\AcObjProp Object(%<\\_ObjId "				(rtos (vla-get-objectid (vlax-ename->vla-object ent2)) 2 0)				">%).TextString>%" ") \\f \"%lu2%pr" (itoa ltr) "\"" ">%"			)	)	(EX_VALUE_T_P_L Tgt ent1)	(vl-cmdf "regen")	(END_PG)	(princ));;;----------------------------------------;;;LINK TONG(defun C:LMH (/ Lst1 Lst2 Lst3 Tgt dem pt1 ob Tj) ;;;Link Multi Hang	(START_PG) 	(setq	42pan (I_KEY "\n Tinh Cong/Nhan/CHia <C/N/CH>" "C N CH" 42pan)		ltr	(I_INT0 "\n Nhap chu so lam tron" ltr)		hso	(I_REAL "\n Nhap he so nhan" hso)		Lst1	(OD_SSY_DES_L (C_S2L (ES_TM "\nChon cot thu nhat...")))		Lst2	(OD_SSY_DES_L (C_S2L (ES_TM "\nChon cot thu hai...")))		Lst3	(OD_SSY_DES_L (C_S2L (S_TM "\nChon cot ket qua/ENTER de xuat ke qua...")))		Tgt 	"%<\\AcExpr (0"		dem		0	)	(if (null Lst3)		(while (null (setq pt1 (getpoint "\n X dat cot: "))))	)	(if (/= (length Lst1) (length Lst2))		(progn			(alert "So hang cua 2 cot khong bang nhau. Chon lai")			(exit)		)	)	(repeat (length Lst1)		(setq ent1 (nth dem Lst1)					ent2 (nth dem Lst2)		)		(if Lst3			(setq ent3 (nth dem Lst3))			(setq ent3 nil)		)		(setq dem (1+ dem))		(cond	(	(= 42pan "C")						(setq Tgt	(CALC_LINK ent1 ent2 "+" ltr hso))					)					(	(= 42pan "N")						(setq Tgt	(CALC_LINK ent1 ent2 "*" ltr hso))					)					(	(= 42pan "CH")						(setq Tgt	(CALC_LINK ent1 ent2 "/" ltr hso))					)		)		(if	(/= ent3 nil)			(progn				(setq ob (entget ent3))				(entmod (subst (cons 1 Tgt) (assoc 1 ob) ob))			)			(progn				(if	(and (= (cadr (assoc 11 (entget ent1))) 0.0)								 (= (caddr (assoc 11 (entget ent1))) 0.0)						)					(setq Tj 10)					(setq Tj 11)				)				(setq	ent1	(entget ent1)							pt1		(list (car pt1) (caddr (assoc Tj ent1)))			 	)				(entmakex (list	'(0 . "TEXT")												'(100 . "AcDbEntity")												(assoc 8 ent1)												'(100 . "AcDbText")												(cons Tj pt1)												(assoc 40 ent1)												(cons 1 Tgt)												(assoc 50 ent1)												(assoc 41 ent1)												(assoc 51 ent1)												(assoc 7 ent1)												(assoc 71 ent1)												(assoc 72 ent1)												'(100 . "AcDbText")												(assoc 73 ent1)									)				)			)		)	)	(vl-cmdf "regen")	(END_PG)	(princ));;;============================================================================================;;;---------------------------------PHEP TINH TOAN VOI LINK------------------------------------;;;============================================================================================(defun CALC_LINK (ent1 ent2 ptinh ltr hso)	(strcat "%<\\AcExpr (" 		"%<\\AcObjProp Object(%<\\_ObjId "		(rtos (vla-get-objectid (vlax-ename->vla-object ent1)) 2 0)		">%).TextString>%"		ptinh		"%<\\AcObjProp Object(%<\\_ObjId "		(rtos (vla-get-objectid (vlax-ename->vla-object ent2)) 2 0)		">%).TextString>%" ") \\f \"%lu2" "%pr" (itoa ltr)		"%ct8[" (rtos hso 2 5) "]\"" ">%"	))(defun OWNER_ENAME (obn)	(vlax-vla-object->ename		(vla-objectidtoobject			(vla-get-activedocument (vlax-get-acad-object))			(vla-get-ownerid				(vlax-ename->vla-object obn)			)		)	));;;HAM BAY LOI(defun INIT	()	(setq	OLD_ERROR	*error*				*error*	MYERROR	)	(command "Undo" "begin"))(defun MYERROR (errmsg)	(cond		((= errmsg "quit / exit abort")		 (princ)		)		((/= errmsg "Function cancelled")		 (princ (strcat "\n Co loi: " errmsg))		)	)	(setvar "osmode" OLD_OSMODE)	(setvar "AUTOSNAP" OLD_AUTOSNAP)	(setvar "ORTHOMODE" OLD_ORTHOMODE)	(setvar "DIMZIN" OLD_DIMZIN)	(setvar "clayer" OLD_CLAYER)	(setvar "CECOLOR" OLD_CECOLOR)	(setvar "cmdecho" 1)	(command "Undo" "end")	(DONE)	(prompt "\n Da Reset lai thiet lap ban dau"))(defun DONE	()	(if	OLD_ERROR		(setq *error* OLD_ERROR)	));;;----------------------------------------------------------;;;HAM LUU BAT DAU VA KET THUC CHUONG TRINH(C:EXPRESSTOOLS)(defun START_PG	(/ ss)	(setq ss (ssget "I"))	(INIT)	(sssetfirst nil ss))(defun END_PG	()	(DONE)	(RESTORE));;;----------------------------------------------------------;;;HAM LUU VA TRA LAI CAC THONG SO BAN DAU(defun SAVE_MODE ()	(setvar "cmdecho" 0)	(command "Undo" "begin")	(command "UCS" "W")	(setq	OLD_OSMODE		(getvar "OSMODE")				OLD_CECOLOR		(getvar "CECOLOR")				OLD_AUTOSNAP	(getvar "AUTOSNAP")				OLD_ORTHOMODE	(getvar "ORTHOMODE")				OLD_CLAYER		(getvar "clayer")				OLD_DIMZIN		(getvar "DIMZIN")	)	(setvar "DIMZIN" 0))(defun RESTORE ()	(setvar "osmode" OLD_OSMODE)	(setvar "AUTOSNAP" OLD_AUTOSNAP)	(setvar "ORTHOMODE" OLD_ORTHOMODE)	(setvar "DIMZIN" OLD_DIMZIN)	(setvar "clayer" OLD_CLAYER)	(setvar "CECOLOR" OLD_CECOLOR)	(command "Undo" "end")	(setvar "cmdecho" 1)	(Grtext -1 "Copyright by Nataca - 0983.715.333"));;;------------------------------------------;;;NHAP GIA TRI LA SO NGUYEN ( BAO GOM CA SO 0)(defun I_INT0	(dongnhac Tso)	(if	(null Tso)		(progn			(initget (+ 1 4))			(getint (strcat dongnhac " <?>:"))		)		(progn			(cond				((progn					 (initget 4)					 (getint (strcat dongnhac " < " (itoa Tso) " >:"))				 )				)				(T Tso)			)		)	));;;NHAP GIA TRI LA SO THUC(defun I_REAL	(dongnhac Tso / Tso1)	(if	(null Tso)		(progn			(initget (+ 1 2))			(setq Tso (getdist (strcat dongnhac " <?>:")))			(princ (strcat "\nGia tri vua nhap la: " (rtos Tso 2 5)))			Tso		)		(progn			(cond				((progn					 (initget (+ 2))					 (setq Tso1 (getdist (strcat dongnhac " < " (rtos Tso 2 5) " >:")))					 (if Tso1						 (progn							 (princ (strcat "\nGia tri vua nhap la: " (rtos Tso1 2 5)))							 (setq Tso Tso1)						 )					 )				 )				)				(T Tso)			)		)	));;;------------------------------------------;;;CHON LIEN TIEP NHIEU DOI TUONG THEO PHUONG PHAP PICK KEM DONG NHAC (BAT BUOC CHON)(defun ES_ENT_LMP	(dongnhac / Lsel sel mouse ew)   ;;;LMP = List Multi Pick	(prompt dongnhac)	(while (/= (car mouse) 2)		(setq mouse (grread 0 15 2))		(if	(= (car mouse) 3)	 		(if (setq sel (car (nentselp (cadr mouse))))				(progn				(setq Lsel (append Lsel (list sel)))				(princ (strcat "\n" (itoa (length Lsel))                                                    " doi tuong duoc pick chon/ENTER ke ket thuc chon"))				)				(princ "\nChon chua dung!")			)		)	)	Lsel);;;------------------------------------------;;;XUAT/EDIT KET QUA VOI TEXT MAU BANG CACH PICK DIEM (EDIT CA ATTRIBUTE, DUNG CHO LINK GIA TRI)(defun EX_VALUE_T_P_L	(Tkq Tmau / mouse sel pt1 ob kq1 Elst Tj caoText oldTsize oldTstyle);;;Real+interge	(prompt "\n Chon text chua kq / An enter de viet text kq...")	(while (and (/= (car mouse) 2) (null sel))		(setq mouse (grread 0 15 2))		(if	(= (car mouse) 3)			(if (null (setq sel (car (nentselp (cadr mouse)))))					(princ "\nChon chua dung! Chon lai...")			)		)	)	(if	(/= sel nil)		(progn			(setq ob (entget sel))			(entmod (subst (cons 1 Tkq) (assoc 1 ob) ob))		)		(progn			(while (null (setq pt1 (getpoint "\n Diem dat text: "))))			(if	Tmau				(progn					(if (and (= (cadr (assoc 11 (entget Tmau))) 0.0)						    (= (caddr (assoc 11 (entget Tmau))) 0.0)					     )						(setq Tj 10)						(setq Tj 11)					)					(setq	Tmau	(entget Tmau))					(entmakex (list	'(0 . "TEXT")								'(100 . "AcDbEntity")								(assoc 8 Tmau)								'(100 . "AcDbText")								(cons Tj pt1)								(assoc 40 Tmau)								(cons 1 Tkq)								(assoc 50 Tmau)								(assoc 41 Tmau)								(assoc 51 Tmau)								(assoc 7 Tmau)								(assoc 71 Tmau)								(assoc 72 Tmau)								'(100 . "AcDbText")								(assoc 73 Tmau)							)					)				)			)		)	));;;------------------------------------------;;;CHON TEXT VA DIMENSION KEM DONG NHAC (BAT BUOC CHON)(defun ES_TM&D (dongnhac / ss)	(while (and(not (prompt dongnhac))			(not (or (setq ss (ssget "I" '((0 . "*TEXT,DIMENSION"))))				    (setq ss (ssget '((0 . "*TEXT,DIMENSION"))))				 )			)		 )	)	ss);;;CHUYEN BIEU DIEN TAP HOP DOI TUONG DUOI DANG LIST CHUA ENAME CUA CAC DOI TUONG(defun C_S2L (ss)	(if	ss		(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))		nil	));;;------------------------------------------;;;NHAP KEY VAO(defun I_KEY (dongnhac key Text)	(if	(null Text)		(progn			(initget 1 key)			(getkword (strcat dongnhac " :"))		)		(progn			(cond				((progn					 (initget key)					 (getkword (strcat dongnhac " < " Text " >:"))				 )				)				(T Text)			)		)	))(defun OD_SSY_DES_L	(Lst)	(setq	lst	(vl-sort lst '(lambda	(e1 e2)			(>			(caddr (assoc			(if (and	(= (cadr (assoc 11 (entget e1))) 0.0)			(= (caddr (assoc 11 (entget e1))) 0.0)			)			 10			 11			 )			(entget e1)			)			)			(caddr (assoc			(if (and	(= (cadr (assoc 11 (entget e2))) 0.0)			(= (caddr (assoc 11 (entget e2))) 0.0)			 )			 10			 11			 )			(entget e2)			 )			)			)			)			)	));;;------------------------------------------;;;CHON TEXT, MTEXT KEM DONG NHAC (BAT BUOC CHON)(defun ES_TM (dongnhac / ss)	(while (and (not (prompt dongnhac))				(not (or (setq ss (ssget "I" '((0 . "*TEXT"))))					    (setq ss (ssget '((0 . "*TEXT"))))					)				)		)	)	ss);;;CHON TEXT, MTEXT KEM DONG NHAC(defun S_TM	(dongnhac / ss)	(prompt dongnhac)	(if	(null (setq ss (ssget "I" '((0 . "*TEXT")))))		(setq ss (ssget '((0 . "*TEXT"))))	)	ss)
-Lệnh LL (link length): để link giá trị chiều dài của 1 đối tượng vào text (khi chiều dài đối tượng thay đổi thì giá trị text thay đổi theo)
-Lệnh LGT (link giá trị): để link giá trị của 1 text này cho text khác (khi giá trị text nguồn thay đổi thì giá trị text đích tự cập nhật theo)
-Lệnh LC (link cộng): Pick chọn các số lần lượt sau đó chọn text kết quả thì sẽ tính tổng các giá trị đó (một trong các giá trị nguồn thay đổi thì giá trị tổng thay đổi theo)
-Lệnh LN (link nhân ): Pick chọn các số lần lượt sau đó chọn text kết quả thì sẽ tính tích các giá trị đó (một trong các giá trị nguồn thay đổi thì giá trị tích thay đổi theo)
-Lệnh LH (link hiệu): Quét chọn text số bị trừ, quét chọn số trừ, chọn text giá trị hiệu (một trong các giá trị nguồn thay đổi thì giá trị hiệu thay đổi theo)
-Lệnh L/ (link chia): Quét chọn text số bị chia, quét chọn số chia, chọn text giá trị thương (một trong các giá trị nguồn thay đổi thì giá trị thương thay đổi theo)
-Lệnh LMH (link multi hàng): Tính toán cho nhiều hàng text. Chọn phép tính, chọn cột 1, cột 2...sau đó chọn cột giá trị (trong này có hệ số nhân để tiện khi đổi đơn vị trong lập bảng thống kê)


Đây là file lisp: lisp tính toán với link
Đây là file .vlx đã được biên dịch: tính toán với link


Xin phép bác Nacata sắp xếp lại code để việc hiển thị trang viết được thuận tiện hơn cho người đọc.

 

Lấy ý tưởng từ bài viết ánh xạ text của bác NguyenHoanh và lisp ánh xạ text của anh Giabach. Mình vận dụng để viết một lisp để có thể tính toán trên các ánh xạ text này. Hy vọng nó sẽ giúp cho các bạn trong công việc:

;;;============================================================================================;;;-------------------LINK GIA TRI CUA DOI TUONG NAY DEN DOI TUONG TEXT KHAC (>=cad2006)-------------------;;;============================================================================================(vl-load-com);;;----------------------------------------;;;LINK CHIEU DAI(defun C:LL (/ obn Tkq)	(START_PG)	(setq obn (vlax-ename->vla-object (car (entsel "\nChon doi tuong nguon")))		obd	(vlax-ename->vla-object (car (nentsel "\nChon text ghi chieu dai")))		ltr	(I_INT0 "\n Nhap chu so lam tron" ltr)		hso	(I_REAL "\n Nhap he so nhan" hso)		Tkq	(strcat "%<\\AcObjProp Object(%<\\_ObjId "				(rtos (vla-get-objectid obn) 2 0)">%).Length \\f \"%lu2"				"%pr" (rtos ltr 2 0) "%ct8[" (rtos hso 2 0) "]" "\">%"			)	;ida	(strcat "%<\\AcObjProp.16.2 Object(%<\\_ObjId "                            ;(rtos (vla-get-objectid obn) 2 0) ">%).Length \\f \"%lu2%pr2%ct8[1]\">%")	;ew	(vlax-vla-object->ename (vla-objectidtoobject (vla-get-activedocument (vlax-get-acad-object))                            ;(vla-get-ownerid obd)))	)	(vla-put-textstring obd Tkq)	;(redraw ew 3)	;(entupd ew)	;(vla-update obw)	(vl-cmdf "regen")	(END_PG)	(princ));;;----------------------------------------;;;LINK GIA TRI(defun C:LGT (/ obn Tkq)	(START_PG)	(setq obn (vlax-ename->vla-object (car (nentsel "\nChon doi tuong nguon")))				obd	(vlax-ename->vla-object (car (nentsel "\nChon text dich")))				Tkq	(strcat "%<\\AcObjProp Object(%<\\_ObjId "										(rtos (vla-get-objectid obn) 2 0)										">%).TextString>%"						)	)	(vla-put-textstring obd Tkq)	(vla-update obd)	(vl-cmdf "regen")	(END_PG)	(princ));;;----------------------------------------;;;LINK TONG(defun C:LC (/ obn Lob Tgt)	(START_PG) 	(setq	ltr (I_INT0 "\n Nhap chu so lam tron" ltr)		Tgt "%<\\AcExpr (0")	(foreach obn	(setq Lob (ES_ENT_LMP "\nChon cac Gia tri can tinh tong/ENTER de ket thuc chon..."))		(setq Tgt	(strcat Tgt "+"                                           "%<\\AcObjProp Object(%<\\_ObjId "					(rtos (vla-get-objectid (vlax-ename->vla-object obn)) 2 0)					">%).TextString>%"				)		)	) 	(setq Tgt	(strcat Tgt ") \\f \"%lu2%pr" (itoa ltr) "\">%"))	(EX_VALUE_T_P_L Tgt (car Lob))	(vl-cmdf "regen")	(END_PG)	(princ));;;----------------------------------------;;;LINK TICH(defun C:LN (/ Tgt obn Lob)	(START_PG)	(setq	ltr (I_INT0 "\n Nhap chu so lam tron" ltr)				Tgt 	"%<\\AcExpr (1")	(foreach obn	(setq Lob (ES_ENT_LMP "\nChon cac Gia tri can tinh tich/ENTER de ket thuc chon..."))		(setq Tgt	(strcat Tgt "*"						"%<\\AcObjProp Object(%<\\_ObjId "						(rtos (vla-get-objectid (vlax-ename->vla-object obn)) 2 0)						">%).TextString>%"				)		)	) 	(setq Tgt	(strcat Tgt ") \\f \"%lu2%pr" (itoa ltr) "\">%"))	(EX_VALUE_T_P_L Tgt (car Lob))	(vl-cmdf "regen")	(END_PG)	(princ));;;----------------------------------------;;;LINK HIEU(defun C:LH (/ Tgt ent1 ent2)	(START_PG)	(setq ltr	(I_INT0 "\n Nhap chu so lam tron" ltr))	(while (null	(setq	ss1	 (ES_TM&D "\n Chon so bi tru..."))))	(while (null	(setq	ss2	 (ES_TM&D "\n Chon so tru..."))))	(setq ent1 (car (C_S2L ss1))				ent2 (car (C_S2L ss2))	)	(setq Tgt	(strcat "%<\\AcExpr (" 				"%<\\AcObjProp Object(%<\\_ObjId "				(rtos (vla-get-objectid (vlax-ename->vla-object ent1)) 2 0)				">%).TextString>%"				"-" "%<\\AcObjProp Object(%<\\_ObjId "				(rtos (vla-get-objectid (vlax-ename->vla-object ent2)) 2 0)				">%).TextString>%" ") \\f \"%lu2%pr" (itoa ltr) "\"" ">%"			)	)	(EX_VALUE_T_P_L Tgt ent1)	(vl-cmdf "regen")	(END_PG)	(princ));;;----------------------------------------;;;LINK CHIA(defun C:L/ (/ Tgt ent1 ent2)	(START_PG)	(setq ltr		(I_INT0 "\n Nhap chu so lam tron" ltr))	(while (null	(setq	ss1	 (ES_TM&D "\n Chon so BI CHIA..."))))	(while (null	(setq	ss2	 (ES_TM&D "\n Chon so CHIA.."))))	(setq ent1 	(car (C_S2L ss1))				ent2 	(car (C_S2L ss2))	)	(setq Tgt	(strcat "%<\\AcExpr (" 				"%<\\AcObjProp Object(%<\\_ObjId "				(rtos (vla-get-objectid (vlax-ename->vla-object ent1)) 2 0)				">%).TextString>%" "/"				"%<\\AcObjProp Object(%<\\_ObjId "				(rtos (vla-get-objectid (vlax-ename->vla-object ent2)) 2 0)				">%).TextString>%" ") \\f \"%lu2%pr" (itoa ltr) "\"" ">%"			)	)	(EX_VALUE_T_P_L Tgt ent1)	(vl-cmdf "regen")	(END_PG)	(princ));;;----------------------------------------;;;LINK TONG(defun C:LMH (/ Lst1 Lst2 Lst3 Tgt dem pt1 ob Tj) ;;;Link Multi Hang	(START_PG) 	(setq	42pan (I_KEY "\n Tinh Cong/Nhan/CHia <C/N/CH>" "C N CH" 42pan)		ltr	(I_INT0 "\n Nhap chu so lam tron" ltr)		hso	(I_REAL "\n Nhap he so nhan" hso)		Lst1	(OD_SSY_DES_L (C_S2L (ES_TM "\nChon cot thu nhat...")))		Lst2	(OD_SSY_DES_L (C_S2L (ES_TM "\nChon cot thu hai...")))		Lst3	(OD_SSY_DES_L (C_S2L (S_TM "\nChon cot ket qua/ENTER de xuat ke qua...")))		Tgt 	"%<\\AcExpr (0"		dem		0	)	(if (null Lst3)		(while (null (setq pt1 (getpoint "\n X dat cot: "))))	)	(if (/= (length Lst1) (length Lst2))		(progn			(alert "So hang cua 2 cot khong bang nhau. Chon lai")			(exit)		)	)	(repeat (length Lst1)		(setq ent1 (nth dem Lst1)					ent2 (nth dem Lst2)		)		(if Lst3			(setq ent3 (nth dem Lst3))			(setq ent3 nil)		)		(setq dem (1+ dem))		(cond	(	(= 42pan "C")						(setq Tgt	(CALC_LINK ent1 ent2 "+" ltr hso))					)					(	(= 42pan "N")						(setq Tgt	(CALC_LINK ent1 ent2 "*" ltr hso))					)					(	(= 42pan "CH")						(setq Tgt	(CALC_LINK ent1 ent2 "/" ltr hso))					)		)		(if	(/= ent3 nil)			(progn				(setq ob (entget ent3))				(entmod (subst (cons 1 Tgt) (assoc 1 ob) ob))			)			(progn				(if	(and (= (cadr (assoc 11 (entget ent1))) 0.0)								 (= (caddr (assoc 11 (entget ent1))) 0.0)						)					(setq Tj 10)					(setq Tj 11)				)				(setq	ent1	(entget ent1)							pt1		(list (car pt1) (caddr (assoc Tj ent1)))			 	)				(entmakex (list	'(0 . "TEXT")												'(100 . "AcDbEntity")												(assoc 8 ent1)												'(100 . "AcDbText")												(cons Tj pt1)												(assoc 40 ent1)												(cons 1 Tgt)												(assoc 50 ent1)												(assoc 41 ent1)												(assoc 51 ent1)												(assoc 7 ent1)												(assoc 71 ent1)												(assoc 72 ent1)												'(100 . "AcDbText")												(assoc 73 ent1)									)				)			)		)	)	(vl-cmdf "regen")	(END_PG)	(princ));;;============================================================================================;;;---------------------------------PHEP TINH TOAN VOI LINK------------------------------------;;;============================================================================================(defun CALC_LINK (ent1 ent2 ptinh ltr hso)	(strcat "%<\\AcExpr (" 		"%<\\AcObjProp Object(%<\\_ObjId "		(rtos (vla-get-objectid (vlax-ename->vla-object ent1)) 2 0)		">%).TextString>%"		ptinh		"%<\\AcObjProp Object(%<\\_ObjId "		(rtos (vla-get-objectid (vlax-ename->vla-object ent2)) 2 0)		">%).TextString>%" ") \\f \"%lu2" "%pr" (itoa ltr)		"%ct8[" (rtos hso 2 5) "]\"" ">%"	))(defun OWNER_ENAME (obn)	(vlax-vla-object->ename		(vla-objectidtoobject			(vla-get-activedocument (vlax-get-acad-object))			(vla-get-ownerid				(vlax-ename->vla-object obn)			)		)	));;;HAM BAY LOI(defun INIT	()	(setq	OLD_ERROR	*error*				*error*	MYERROR	)	(command "Undo" "begin"))(defun MYERROR (errmsg)	(cond		((= errmsg "quit / exit abort")		 (princ)		)		((/= errmsg "Function cancelled")		 (princ (strcat "\n Co loi: " errmsg))		)	)	(setvar "osmode" OLD_OSMODE)	(setvar "AUTOSNAP" OLD_AUTOSNAP)	(setvar "ORTHOMODE" OLD_ORTHOMODE)	(setvar "DIMZIN" OLD_DIMZIN)	(setvar "clayer" OLD_CLAYER)	(setvar "CECOLOR" OLD_CECOLOR)	(setvar "cmdecho" 1)	(command "Undo" "end")	(DONE)	(prompt "\n Da Reset lai thiet lap ban dau"))(defun DONE	()	(if	OLD_ERROR		(setq *error* OLD_ERROR)	));;;----------------------------------------------------------;;;HAM LUU BAT DAU VA KET THUC CHUONG TRINH(C:EXPRESSTOOLS)(defun START_PG	(/ ss)	(setq ss (ssget "I"))	(INIT)	(sssetfirst nil ss))(defun END_PG	()	(DONE)	(RESTORE));;;----------------------------------------------------------;;;HAM LUU VA TRA LAI CAC THONG SO BAN DAU(defun SAVE_MODE ()	(setvar "cmdecho" 0)	(command "Undo" "begin")	(command "UCS" "W")	(setq	OLD_OSMODE		(getvar "OSMODE")				OLD_CECOLOR		(getvar "CECOLOR")				OLD_AUTOSNAP	(getvar "AUTOSNAP")				OLD_ORTHOMODE	(getvar "ORTHOMODE")				OLD_CLAYER		(getvar "clayer")				OLD_DIMZIN		(getvar "DIMZIN")	)	(setvar "DIMZIN" 0))(defun RESTORE ()	(setvar "osmode" OLD_OSMODE)	(setvar "AUTOSNAP" OLD_AUTOSNAP)	(setvar "ORTHOMODE" OLD_ORTHOMODE)	(setvar "DIMZIN" OLD_DIMZIN)	(setvar "clayer" OLD_CLAYER)	(setvar "CECOLOR" OLD_CECOLOR)	(command "Undo" "end")	(setvar "cmdecho" 1)	(Grtext -1 "Copyright by Nataca - 0983.715.333"));;;------------------------------------------;;;NHAP GIA TRI LA SO NGUYEN ( BAO GOM CA SO 0)(defun I_INT0	(dongnhac Tso)	(if	(null Tso)		(progn			(initget (+ 1 4))			(getint (strcat dongnhac " <?>:"))		)		(progn			(cond				((progn					 (initget 4)					 (getint (strcat dongnhac " < " (itoa Tso) " >:"))				 )				)				(T Tso)			)		)	));;;NHAP GIA TRI LA SO THUC(defun I_REAL	(dongnhac Tso / Tso1)	(if	(null Tso)		(progn			(initget (+ 1 2))			(setq Tso (getdist (strcat dongnhac " <?>:")))			(princ (strcat "\nGia tri vua nhap la: " (rtos Tso 2 5)))			Tso		)		(progn			(cond				((progn					 (initget (+ 2))					 (setq Tso1 (getdist (strcat dongnhac " < " (rtos Tso 2 5) " >:")))					 (if Tso1						 (progn							 (princ (strcat "\nGia tri vua nhap la: " (rtos Tso1 2 5)))							 (setq Tso Tso1)						 )					 )				 )				)				(T Tso)			)		)	));;;------------------------------------------;;;CHON LIEN TIEP NHIEU DOI TUONG THEO PHUONG PHAP PICK KEM DONG NHAC (BAT BUOC CHON)(defun ES_ENT_LMP	(dongnhac / Lsel sel mouse ew)   ;;;LMP = List Multi Pick	(prompt dongnhac)	(while (/= (car mouse) 2)		(setq mouse (grread 0 15 2))		(if	(= (car mouse) 3)	 		(if (setq sel (car (nentselp (cadr mouse))))				(progn				(setq Lsel (append Lsel (list sel)))				(princ (strcat "\n" (itoa (length Lsel))                                                    " doi tuong duoc pick chon/ENTER ke ket thuc chon"))				)				(princ "\nChon chua dung!")			)		)	)	Lsel);;;------------------------------------------;;;XUAT/EDIT KET QUA VOI TEXT MAU BANG CACH PICK DIEM (EDIT CA ATTRIBUTE, DUNG CHO LINK GIA TRI)(defun EX_VALUE_T_P_L	(Tkq Tmau / mouse sel pt1 ob kq1 Elst Tj caoText oldTsize oldTstyle);;;Real+interge	(prompt "\n Chon text chua kq / An enter de viet text kq...")	(while (and (/= (car mouse) 2) (null sel))		(setq mouse (grread 0 15 2))		(if	(= (car mouse) 3)			(if (null (setq sel (car (nentselp (cadr mouse)))))					(princ "\nChon chua dung! Chon lai...")			)		)	)	(if	(/= sel nil)		(progn			(setq ob (entget sel))			(entmod (subst (cons 1 Tkq) (assoc 1 ob) ob))		)		(progn			(while (null (setq pt1 (getpoint "\n Diem dat text: "))))			(if	Tmau				(progn					(if (and (= (cadr (assoc 11 (entget Tmau))) 0.0)						    (= (caddr (assoc 11 (entget Tmau))) 0.0)					     )						(setq Tj 10)						(setq Tj 11)					)					(setq	Tmau	(entget Tmau))					(entmakex (list	'(0 . "TEXT")								'(100 . "AcDbEntity")								(assoc 8 Tmau)								'(100 . "AcDbText")								(cons Tj pt1)								(assoc 40 Tmau)								(cons 1 Tkq)								(assoc 50 Tmau)								(assoc 41 Tmau)								(assoc 51 Tmau)								(assoc 7 Tmau)								(assoc 71 Tmau)								(assoc 72 Tmau)								'(100 . "AcDbText")								(assoc 73 Tmau)							)					)				)			)		)	));;;------------------------------------------;;;CHON TEXT VA DIMENSION KEM DONG NHAC (BAT BUOC CHON)(defun ES_TM&D (dongnhac / ss)	(while (and(not (prompt dongnhac))			(not (or (setq ss (ssget "I" '((0 . "*TEXT,DIMENSION"))))				    (setq ss (ssget '((0 . "*TEXT,DIMENSION"))))				 )			)		 )	)	ss);;;CHUYEN BIEU DIEN TAP HOP DOI TUONG DUOI DANG LIST CHUA ENAME CUA CAC DOI TUONG(defun C_S2L (ss)	(if	ss		(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))		nil	));;;------------------------------------------;;;NHAP KEY VAO(defun I_KEY (dongnhac key Text)	(if	(null Text)		(progn			(initget 1 key)			(getkword (strcat dongnhac " :"))		)		(progn			(cond				((progn					 (initget key)					 (getkword (strcat dongnhac " < " Text " >:"))				 )				)				(T Text)			)		)	))(defun OD_SSY_DES_L	(Lst)	(setq	lst	(vl-sort lst '(lambda	(e1 e2)			(>			(caddr (assoc			(if (and	(= (cadr (assoc 11 (entget e1))) 0.0)			(= (caddr (assoc 11 (entget e1))) 0.0)			)			 10			 11			 )			(entget e1)			)			)			(caddr (assoc			(if (and	(= (cadr (assoc 11 (entget e2))) 0.0)			(= (caddr (assoc 11 (entget e2))) 0.0)			 )			 10			 11			 )			(entget e2)			 )			)			)			)			)	));;;------------------------------------------;;;CHON TEXT, MTEXT KEM DONG NHAC (BAT BUOC CHON)(defun ES_TM (dongnhac / ss)	(while (and (not (prompt dongnhac))				(not (or (setq ss (ssget "I" '((0 . "*TEXT"))))					    (setq ss (ssget '((0 . "*TEXT"))))					)				)		)	)	ss);;;CHON TEXT, MTEXT KEM DONG NHAC(defun S_TM	(dongnhac / ss)	(prompt dongnhac)	(if	(null (setq ss (ssget "I" '((0 . "*TEXT")))))		(setq ss (ssget '((0 . "*TEXT"))))	)	ss)
-Lệnh LL (link length): để link giá trị chiều dài của 1 đối tượng vào text (khi chiều dài đối tượng thay đổi thì giá trị text thay đổi theo)
-Lệnh LGT (link giá trị): để link giá trị của 1 text này cho text khác (khi giá trị text nguồn thay đổi thì giá trị text đích tự cập nhật theo)
-Lệnh LC (link cộng): Pick chọn các số lần lượt sau đó chọn text kết quả thì sẽ tính tổng các giá trị đó (một trong các giá trị nguồn thay đổi thì giá trị tổng thay đổi theo)
-Lệnh LN (link nhân ): Pick chọn các số lần lượt sau đó chọn text kết quả thì sẽ tính tích các giá trị đó (một trong các giá trị nguồn thay đổi thì giá trị tích thay đổi theo)
-Lệnh LH (link hiệu): Quét chọn text số bị trừ, quét chọn số trừ, chọn text giá trị hiệu (một trong các giá trị nguồn thay đổi thì giá trị hiệu thay đổi theo)
-Lệnh L/ (link chia): Quét chọn text số bị chia, quét chọn số chia, chọn text giá trị thương (một trong các giá trị nguồn thay đổi thì giá trị thương thay đổi theo)
-Lệnh LMH (link multi hàng): Tính toán cho nhiều hàng text. Chọn phép tính, chọn cột 1, cột 2...sau đó chọn cột giá trị (trong này có hệ số nhân để tiện khi đổi đơn vị trong lập bảng thống kê)


Đây là file lisp: lisp tính toán với link
Đây là file .vlx đã được biên dịch: tính toán với link


Xin phép bác Nacata sắp xếp lại code để việc hiển thị trang viết được thuận tiện hơn cho người đọc.

Lisp rất hay. Nhưng e thấy tồn tại vấn đề như thế này:
Khi chọn text trong tất cả các lệnh: các đối tượng text ko quét được mà phải chọn từng text một rất mất thời gian
Lệnh LH: ko trừ được cho nhìu số trừ.
Mong bác chỉnh sửa bổ sung thêm cho lisp hoàn thiện ah.
Thanks
 


  • 0

Một môn tập luyện mang lại vô vàn lợi ích sức khỏe cho mọi người, nhiều bệnh tật nan y đều được chữa khỏi, hoàn toàn miễn phí. Hiệu quả chữa khỏi bệnh tật của nó lên đến hơn 90%.
Tài liệu tại đây: http://phapluan.org/

Rất vui được làm quen với mọi người trên facebook:
https://www.facebook...67946371&type=1

 

 


#43 vankiemquytong

vankiemquytong

    biết zoom

  • Members
  • Pip
  • 18 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 29 April 2014 - 01:19 PM

Cảm ơn tác giả. Lisp rất hữu ích đối với tôi, tuy nhiên khi link một đối tượng vẽ bằng lệnh rectang thì lisp lại hiểu là chu vi của hình vẽ. Tác giả có thể sửa lại để người dùng có thể link được theo chiều dài và chiều rộng của hình vẽ, để khi mình stretch hinh theo chiều dọc hoặc chiều ngang thì kích thước chạy theo.
  • 0

#44 vankiemquytong

vankiemquytong

    biết zoom

  • Members
  • Pip
  • 18 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 30 April 2014 - 07:03 PM

Hic, không bác nào giúp em ah. :wacko:


  • 0

#45 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 01 May 2014 - 04:25 PM

Cái đó bạn phải nổ rectang ra rồi ghi chữ cho từng đoạn, nếu không nó hiểu là chiều dài của cả polyline.


  • 0

#46 ancontau

ancontau

    Chưa sử dụng CAD

  • Members
  • Pip
  • 3 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 30 June 2015 - 01:33 AM

Lấy ý tưởng từ bài viết ánh xạ text của bác NguyenHoanh và lisp ánh xạ text của anh Giabach. Mình vận dụng để viết một lisp để có thể tính toán trên các ánh xạ text này. Hy vọng nó sẽ giúp cho các bạn trong công việc:

;;;============================================================================================;;;-------------------LINK GIA TRI CUA DOI TUONG NAY DEN DOI TUONG TEXT KHAC (>=cad2006)-------------------;;;============================================================================================(vl-load-com);;;----------------------------------------;;;LINK CHIEU DAI(defun C:LL (/ obn Tkq)	(START_PG)	(setq obn (vlax-ename->vla-object (car (entsel "\nChon doi tuong nguon")))		obd	(vlax-ename->vla-object (car (nentsel "\nChon text ghi chieu dai")))		ltr	(I_INT0 "\n Nhap chu so lam tron" ltr)		hso	(I_REAL "\n Nhap he so nhan" hso)		Tkq	(strcat "%<\\AcObjProp Object(%<\\_ObjId "				(rtos (vla-get-objectid obn) 2 0)">%).Length \\f \"%lu2"				"%pr" (rtos ltr 2 0) "%ct8[" (rtos hso 2 0) "]" "\">%"			)	;ida	(strcat "%<\\AcObjProp.16.2 Object(%<\\_ObjId "                            ;(rtos (vla-get-objectid obn) 2 0) ">%).Length \\f \"%lu2%pr2%ct8[1]\">%")	;ew	(vlax-vla-object->ename (vla-objectidtoobject (vla-get-activedocument (vlax-get-acad-object))                            ;(vla-get-ownerid obd)))	)	(vla-put-textstring obd Tkq)	;(redraw ew 3)	;(entupd ew)	;(vla-update obw)	(vl-cmdf "regen")	(END_PG)	(princ));;;----------------------------------------;;;LINK GIA TRI(defun C:LGT (/ obn Tkq)	(START_PG)	(setq obn (vlax-ename->vla-object (car (nentsel "\nChon doi tuong nguon")))				obd	(vlax-ename->vla-object (car (nentsel "\nChon text dich")))				Tkq	(strcat "%<\\AcObjProp Object(%<\\_ObjId "										(rtos (vla-get-objectid obn) 2 0)										">%).TextString>%"						)	)	(vla-put-textstring obd Tkq)	(vla-update obd)	(vl-cmdf "regen")	(END_PG)	(princ));;;----------------------------------------;;;LINK TONG(defun C:LC (/ obn Lob Tgt)	(START_PG) 	(setq	ltr (I_INT0 "\n Nhap chu so lam tron" ltr)		Tgt "%<\\AcExpr (0")	(foreach obn	(setq Lob (ES_ENT_LMP "\nChon cac Gia tri can tinh tong/ENTER de ket thuc chon..."))		(setq Tgt	(strcat Tgt "+"                                           "%<\\AcObjProp Object(%<\\_ObjId "					(rtos (vla-get-objectid (vlax-ename->vla-object obn)) 2 0)					">%).TextString>%"				)		)	) 	(setq Tgt	(strcat Tgt ") \\f \"%lu2%pr" (itoa ltr) "\">%"))	(EX_VALUE_T_P_L Tgt (car Lob))	(vl-cmdf "regen")	(END_PG)	(princ));;;----------------------------------------;;;LINK TICH(defun C:LN (/ Tgt obn Lob)	(START_PG)	(setq	ltr (I_INT0 "\n Nhap chu so lam tron" ltr)				Tgt 	"%<\\AcExpr (1")	(foreach obn	(setq Lob (ES_ENT_LMP "\nChon cac Gia tri can tinh tich/ENTER de ket thuc chon..."))		(setq Tgt	(strcat Tgt "*"						"%<\\AcObjProp Object(%<\\_ObjId "						(rtos (vla-get-objectid (vlax-ename->vla-object obn)) 2 0)						">%).TextString>%"				)		)	) 	(setq Tgt	(strcat Tgt ") \\f \"%lu2%pr" (itoa ltr) "\">%"))	(EX_VALUE_T_P_L Tgt (car Lob))	(vl-cmdf "regen")	(END_PG)	(princ));;;----------------------------------------;;;LINK HIEU(defun C:LH (/ Tgt ent1 ent2)	(START_PG)	(setq ltr	(I_INT0 "\n Nhap chu so lam tron" ltr))	(while (null	(setq	ss1	 (ES_TM&D "\n Chon so bi tru..."))))	(while (null	(setq	ss2	 (ES_TM&D "\n Chon so tru..."))))	(setq ent1 (car (C_S2L ss1))				ent2 (car (C_S2L ss2))	)	(setq Tgt	(strcat "%<\\AcExpr (" 				"%<\\AcObjProp Object(%<\\_ObjId "				(rtos (vla-get-objectid (vlax-ename->vla-object ent1)) 2 0)				">%).TextString>%"				"-" "%<\\AcObjProp Object(%<\\_ObjId "				(rtos (vla-get-objectid (vlax-ename->vla-object ent2)) 2 0)				">%).TextString>%" ") \\f \"%lu2%pr" (itoa ltr) "\"" ">%"			)	)	(EX_VALUE_T_P_L Tgt ent1)	(vl-cmdf "regen")	(END_PG)	(princ));;;----------------------------------------;;;LINK CHIA(defun C:L/ (/ Tgt ent1 ent2)	(START_PG)	(setq ltr		(I_INT0 "\n Nhap chu so lam tron" ltr))	(while (null	(setq	ss1	 (ES_TM&D "\n Chon so BI CHIA..."))))	(while (null	(setq	ss2	 (ES_TM&D "\n Chon so CHIA.."))))	(setq ent1 	(car (C_S2L ss1))				ent2 	(car (C_S2L ss2))	)	(setq Tgt	(strcat "%<\\AcExpr (" 				"%<\\AcObjProp Object(%<\\_ObjId "				(rtos (vla-get-objectid (vlax-ename->vla-object ent1)) 2 0)				">%).TextString>%" "/"				"%<\\AcObjProp Object(%<\\_ObjId "				(rtos (vla-get-objectid (vlax-ename->vla-object ent2)) 2 0)				">%).TextString>%" ") \\f \"%lu2%pr" (itoa ltr) "\"" ">%"			)	)	(EX_VALUE_T_P_L Tgt ent1)	(vl-cmdf "regen")	(END_PG)	(princ));;;----------------------------------------;;;LINK TONG(defun C:LMH (/ Lst1 Lst2 Lst3 Tgt dem pt1 ob Tj) ;;;Link Multi Hang	(START_PG) 	(setq	42pan (I_KEY "\n Tinh Cong/Nhan/CHia <C/N/CH>" "C N CH" 42pan)		ltr	(I_INT0 "\n Nhap chu so lam tron" ltr)		hso	(I_REAL "\n Nhap he so nhan" hso)		Lst1	(OD_SSY_DES_L (C_S2L (ES_TM "\nChon cot thu nhat...")))		Lst2	(OD_SSY_DES_L (C_S2L (ES_TM "\nChon cot thu hai...")))		Lst3	(OD_SSY_DES_L (C_S2L (S_TM "\nChon cot ket qua/ENTER de xuat ke qua...")))		Tgt 	"%<\\AcExpr (0"		dem		0	)	(if (null Lst3)		(while (null (setq pt1 (getpoint "\n X dat cot: "))))	)	(if (/= (length Lst1) (length Lst2))		(progn			(alert "So hang cua 2 cot khong bang nhau. Chon lai")			(exit)		)	)	(repeat (length Lst1)		(setq ent1 (nth dem Lst1)					ent2 (nth dem Lst2)		)		(if Lst3			(setq ent3 (nth dem Lst3))			(setq ent3 nil)		)		(setq dem (1+ dem))		(cond	(	(= 42pan "C")						(setq Tgt	(CALC_LINK ent1 ent2 "+" ltr hso))					)					(	(= 42pan "N")						(setq Tgt	(CALC_LINK ent1 ent2 "*" ltr hso))					)					(	(= 42pan "CH")						(setq Tgt	(CALC_LINK ent1 ent2 "/" ltr hso))					)		)		(if	(/= ent3 nil)			(progn				(setq ob (entget ent3))				(entmod (subst (cons 1 Tgt) (assoc 1 ob) ob))			)			(progn				(if	(and (= (cadr (assoc 11 (entget ent1))) 0.0)								 (= (caddr (assoc 11 (entget ent1))) 0.0)						)					(setq Tj 10)					(setq Tj 11)				)				(setq	ent1	(entget ent1)							pt1		(list (car pt1) (caddr (assoc Tj ent1)))			 	)				(entmakex (list	'(0 . "TEXT")												'(100 . "AcDbEntity")												(assoc 8 ent1)												'(100 . "AcDbText")												(cons Tj pt1)												(assoc 40 ent1)												(cons 1 Tgt)												(assoc 50 ent1)												(assoc 41 ent1)												(assoc 51 ent1)												(assoc 7 ent1)												(assoc 71 ent1)												(assoc 72 ent1)												'(100 . "AcDbText")												(assoc 73 ent1)									)				)			)		)	)	(vl-cmdf "regen")	(END_PG)	(princ));;;============================================================================================;;;---------------------------------PHEP TINH TOAN VOI LINK------------------------------------;;;============================================================================================(defun CALC_LINK (ent1 ent2 ptinh ltr hso)	(strcat "%<\\AcExpr (" 		"%<\\AcObjProp Object(%<\\_ObjId "		(rtos (vla-get-objectid (vlax-ename->vla-object ent1)) 2 0)		">%).TextString>%"		ptinh		"%<\\AcObjProp Object(%<\\_ObjId "		(rtos (vla-get-objectid (vlax-ename->vla-object ent2)) 2 0)		">%).TextString>%" ") \\f \"%lu2" "%pr" (itoa ltr)		"%ct8[" (rtos hso 2 5) "]\"" ">%"	))(defun OWNER_ENAME (obn)	(vlax-vla-object->ename		(vla-objectidtoobject			(vla-get-activedocument (vlax-get-acad-object))			(vla-get-ownerid				(vlax-ename->vla-object obn)			)		)	));;;HAM BAY LOI(defun INIT	()	(setq	OLD_ERROR	*error*				*error*	MYERROR	)	(command "Undo" "begin"))(defun MYERROR (errmsg)	(cond		((= errmsg "quit / exit abort")		 (princ)		)		((/= errmsg "Function cancelled")		 (princ (strcat "\n Co loi: " errmsg))		)	)	(setvar "osmode" OLD_OSMODE)	(setvar "AUTOSNAP" OLD_AUTOSNAP)	(setvar "ORTHOMODE" OLD_ORTHOMODE)	(setvar "DIMZIN" OLD_DIMZIN)	(setvar "clayer" OLD_CLAYER)	(setvar "CECOLOR" OLD_CECOLOR)	(setvar "cmdecho" 1)	(command "Undo" "end")	(DONE)	(prompt "\n Da Reset lai thiet lap ban dau"))(defun DONE	()	(if	OLD_ERROR		(setq *error* OLD_ERROR)	));;;----------------------------------------------------------;;;HAM LUU BAT DAU VA KET THUC CHUONG TRINH(C:EXPRESSTOOLS)(defun START_PG	(/ ss)	(setq ss (ssget "I"))	(INIT)	(sssetfirst nil ss))(defun END_PG	()	(DONE)	(RESTORE));;;----------------------------------------------------------;;;HAM LUU VA TRA LAI CAC THONG SO BAN DAU(defun SAVE_MODE ()	(setvar "cmdecho" 0)	(command "Undo" "begin")	(command "UCS" "W")	(setq	OLD_OSMODE		(getvar "OSMODE")				OLD_CECOLOR		(getvar "CECOLOR")				OLD_AUTOSNAP	(getvar "AUTOSNAP")				OLD_ORTHOMODE	(getvar "ORTHOMODE")				OLD_CLAYER		(getvar "clayer")				OLD_DIMZIN		(getvar "DIMZIN")	)	(setvar "DIMZIN" 0))(defun RESTORE ()	(setvar "osmode" OLD_OSMODE)	(setvar "AUTOSNAP" OLD_AUTOSNAP)	(setvar "ORTHOMODE" OLD_ORTHOMODE)	(setvar "DIMZIN" OLD_DIMZIN)	(setvar "clayer" OLD_CLAYER)	(setvar "CECOLOR" OLD_CECOLOR)	(command "Undo" "end")	(setvar "cmdecho" 1)	(Grtext -1 "Copyright by Nataca - 0983.715.333"));;;------------------------------------------;;;NHAP GIA TRI LA SO NGUYEN ( BAO GOM CA SO 0)(defun I_INT0	(dongnhac Tso)	(if	(null Tso)		(progn			(initget (+ 1 4))			(getint (strcat dongnhac " <?>:"))		)		(progn			(cond				((progn					 (initget 4)					 (getint (strcat dongnhac " < " (itoa Tso) " >:"))				 )				)				(T Tso)			)		)	));;;NHAP GIA TRI LA SO THUC(defun I_REAL	(dongnhac Tso / Tso1)	(if	(null Tso)		(progn			(initget (+ 1 2))			(setq Tso (getdist (strcat dongnhac " <?>:")))			(princ (strcat "\nGia tri vua nhap la: " (rtos Tso 2 5)))			Tso		)		(progn			(cond				((progn					 (initget (+ 2))					 (setq Tso1 (getdist (strcat dongnhac " < " (rtos Tso 2 5) " >:")))					 (if Tso1						 (progn							 (princ (strcat "\nGia tri vua nhap la: " (rtos Tso1 2 5)))							 (setq Tso Tso1)						 )					 )				 )				)				(T Tso)			)		)	));;;------------------------------------------;;;CHON LIEN TIEP NHIEU DOI TUONG THEO PHUONG PHAP PICK KEM DONG NHAC (BAT BUOC CHON)(defun ES_ENT_LMP	(dongnhac / Lsel sel mouse ew)   ;;;LMP = List Multi Pick	(prompt dongnhac)	(while (/= (car mouse) 2)		(setq mouse (grread 0 15 2))		(if	(= (car mouse) 3)	 		(if (setq sel (car (nentselp (cadr mouse))))				(progn				(setq Lsel (append Lsel (list sel)))				(princ (strcat "\n" (itoa (length Lsel))                                                    " doi tuong duoc pick chon/ENTER ke ket thuc chon"))				)				(princ "\nChon chua dung!")			)		)	)	Lsel);;;------------------------------------------;;;XUAT/EDIT KET QUA VOI TEXT MAU BANG CACH PICK DIEM (EDIT CA ATTRIBUTE, DUNG CHO LINK GIA TRI)(defun EX_VALUE_T_P_L	(Tkq Tmau / mouse sel pt1 ob kq1 Elst Tj caoText oldTsize oldTstyle);;;Real+interge	(prompt "\n Chon text chua kq / An enter de viet text kq...")	(while (and (/= (car mouse) 2) (null sel))		(setq mouse (grread 0 15 2))		(if	(= (car mouse) 3)			(if (null (setq sel (car (nentselp (cadr mouse)))))					(princ "\nChon chua dung! Chon lai...")			)		)	)	(if	(/= sel nil)		(progn			(setq ob (entget sel))			(entmod (subst (cons 1 Tkq) (assoc 1 ob) ob))		)		(progn			(while (null (setq pt1 (getpoint "\n Diem dat text: "))))			(if	Tmau				(progn					(if (and (= (cadr (assoc 11 (entget Tmau))) 0.0)						    (= (caddr (assoc 11 (entget Tmau))) 0.0)					     )						(setq Tj 10)						(setq Tj 11)					)					(setq	Tmau	(entget Tmau))					(entmakex (list	'(0 . "TEXT")								'(100 . "AcDbEntity")								(assoc 8 Tmau)								'(100 . "AcDbText")								(cons Tj pt1)								(assoc 40 Tmau)								(cons 1 Tkq)								(assoc 50 Tmau)								(assoc 41 Tmau)								(assoc 51 Tmau)								(assoc 7 Tmau)								(assoc 71 Tmau)								(assoc 72 Tmau)								'(100 . "AcDbText")								(assoc 73 Tmau)							)					)				)			)		)	));;;------------------------------------------;;;CHON TEXT VA DIMENSION KEM DONG NHAC (BAT BUOC CHON)(defun ES_TM&D (dongnhac / ss)	(while (and(not (prompt dongnhac))			(not (or (setq ss (ssget "I" '((0 . "*TEXT,DIMENSION"))))				    (setq ss (ssget '((0 . "*TEXT,DIMENSION"))))				 )			)		 )	)	ss);;;CHUYEN BIEU DIEN TAP HOP DOI TUONG DUOI DANG LIST CHUA ENAME CUA CAC DOI TUONG(defun C_S2L (ss)	(if	ss		(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))		nil	));;;------------------------------------------;;;NHAP KEY VAO(defun I_KEY (dongnhac key Text)	(if	(null Text)		(progn			(initget 1 key)			(getkword (strcat dongnhac " :"))		)		(progn			(cond				((progn					 (initget key)					 (getkword (strcat dongnhac " < " Text " >:"))				 )				)				(T Text)			)		)	))(defun OD_SSY_DES_L	(Lst)	(setq	lst	(vl-sort lst '(lambda	(e1 e2)			(>			(caddr (assoc			(if (and	(= (cadr (assoc 11 (entget e1))) 0.0)			(= (caddr (assoc 11 (entget e1))) 0.0)			)			 10			 11			 )			(entget e1)			)			)			(caddr (assoc			(if (and	(= (cadr (assoc 11 (entget e2))) 0.0)			(= (caddr (assoc 11 (entget e2))) 0.0)			 )			 10			 11			 )			(entget e2)			 )			)			)			)			)	));;;------------------------------------------;;;CHON TEXT, MTEXT KEM DONG NHAC (BAT BUOC CHON)(defun ES_TM (dongnhac / ss)	(while (and (not (prompt dongnhac))				(not (or (setq ss (ssget "I" '((0 . "*TEXT"))))					    (setq ss (ssget '((0 . "*TEXT"))))					)				)		)	)	ss);;;CHON TEXT, MTEXT KEM DONG NHAC(defun S_TM	(dongnhac / ss)	(prompt dongnhac)	(if	(null (setq ss (ssget "I" '((0 . "*TEXT")))))		(setq ss (ssget '((0 . "*TEXT"))))	)	ss)
-Lệnh LL (link length): để link giá trị chiều dài của 1 đối tượng vào text (khi chiều dài đối tượng thay đổi thì giá trị text thay đổi theo)
-Lệnh LGT (link giá trị): để link giá trị của 1 text này cho text khác (khi giá trị text nguồn thay đổi thì giá trị text đích tự cập nhật theo)
-Lệnh LC (link cộng): Pick chọn các số lần lượt sau đó chọn text kết quả thì sẽ tính tổng các giá trị đó (một trong các giá trị nguồn thay đổi thì giá trị tổng thay đổi theo)
-Lệnh LN (link nhân ): Pick chọn các số lần lượt sau đó chọn text kết quả thì sẽ tính tích các giá trị đó (một trong các giá trị nguồn thay đổi thì giá trị tích thay đổi theo)
-Lệnh LH (link hiệu): Quét chọn text số bị trừ, quét chọn số trừ, chọn text giá trị hiệu (một trong các giá trị nguồn thay đổi thì giá trị hiệu thay đổi theo)
-Lệnh L/ (link chia): Quét chọn text số bị chia, quét chọn số chia, chọn text giá trị thương (một trong các giá trị nguồn thay đổi thì giá trị thương thay đổi theo)
-Lệnh LMH (link multi hàng): Tính toán cho nhiều hàng text. Chọn phép tính, chọn cột 1, cột 2...sau đó chọn cột giá trị (trong này có hệ số nhân để tiện khi đổi đơn vị trong lập bảng thống kê)


Đây là file lisp: lisp tính toán với link
Đây là file .vlx đã được biên dịch: tính toán với link


Xin phép bác Nacata sắp xếp lại code để việc hiển thị trang viết được thuận tiện hơn cho người đọc.

 

Lisp của anh nacata tuyệt quá nhưng lại k ổn với CAD 64x, a có thể bỏ tí thời gian sửa lại giúp e k? cảm ơn a nhiều!!!! 


  • 0

#47 enix

enix

    biết vẽ ellipse

  • Members
  • PipPip
  • 56 Bài viết
Điểm đánh giá: 3 (bình thường)

Đã gửi 04 November 2015 - 06:35 PM

Đá lên cho bác nào biết chuyển qua cho x64 xài được, chứ lisp hay mà ko xài được uổng quá, dùng để lập bảng thống kê trong CAD là đẹp luôn.


  • 0

#48 phongtran86

phongtran86

    biết lệnh offset

  • Members
  • PipPipPip
  • 177 Bài viết
Điểm đánh giá: 22 (tàm tạm)

Đã gửi 23 May 2016 - 10:47 AM

 

 
 

;;;============================================================================================
;;;-------------------LINK GIA TRI CUA DOI TUONG NAY DEN DOI TUONG TEXT KHAC (>=Cad2006)-------
;;;============================================================================================
(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)
(defun LM:ObjectID ( obj )
    (eval
        (list 'defun 'LM:ObjectID '( obj )
            (if
                (and
                    (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
                    (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
                )
                (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
               '(itoa (vla-get-objectid obj))
            )
        )
    )
    (LM:ObjectID obj)
)
;;;----------------------------------------
;;;LINK CHIEU DAI
(defun C:LL (/ obn Tkq)
	(START_PG)
	(setq obn (vlax-ename->vla-object (car (entsel "\nChon doi tuong nguon")))
				obd	(vlax-ename->vla-object (car (nentsel "\nChon text ghi chieu dai")))
				ltr	(I_INT0 "\n Nhap chu so lam tron" ltr)
				hso	(I_REAL "\n Nhap he so nhan" hso)
				Tkq	(strcat "%<\\AcObjProp Object(%<\\_ObjId "
										(LM:ObjectID obn)
										">%).Length \\f \"%lu2"
										"%pr" (rtos ltr 2 0)
										"%ct8[" (rtos hso 2 0) "]"
										"\">%"
						)

	)
	(vla-put-textstring obd Tkq)
	(vl-cmdf "regen")
	(END_PG)
	(princ)
)

;;;----------------------------------------
;;;LINK GIA TRI
(defun C:LGT (/ obn Tkq)
	(START_PG)
	(setq obn (vlax-ename->vla-object (car (nentsel "\nChon doi tuong nguon")))
				obd	(vlax-ename->vla-object (car (nentsel "\nChon text dich")))
				Tkq	(strcat "%<\\AcObjProp Object(%<\\_ObjId "
										(LM:ObjectID obn)
										">%).TextString>%"
						)
	)
	(vla-put-textstring obd Tkq)
	(vla-update obd)
	(vl-cmdf "regen")
	(END_PG)
	(princ)
)

;;;----------------------------------------
;;;LINK TONG
(defun C:LC (/ obn Lob Tgt)
	(START_PG) 
	(setq	ltr		(I_INT0 "\n Nhap chu so lam tron" ltr)
				Tgt "%<\\AcExpr (0")
	(foreach obn	(setq Lob (ES_ENT_LMP "\nChon cac Gia tri can tinh tong/ENTER de ket thuc chon..."))
		(setq Tgt	(strcat Tgt "+"
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object obn))
											">%).TextString>%"
							)
		)
	)
 	(setq Tgt	(strcat Tgt ") \\f \"%lu2%pr" (itoa ltr) "\">%"))
	(EX_VALUE_T_P_L Tgt (car Lob))
	(vl-cmdf "regen")
	(END_PG)
	(princ)
)

;;;----------------------------------------
;;;LINK TICH
(defun C:LN (/ Tgt obn Lob)
	(START_PG)
	(setq	ltr		(I_INT0 "\n Nhap chu so lam tron" ltr)
				Tgt 	"%<\\AcExpr (1"
	)
	(foreach obn	(setq Lob (ES_ENT_LMP "\nChon cac Gia tri can tinh tich/ENTER de ket thuc chon..."))
		(setq Tgt	(strcat Tgt "*"
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object obn))
											">%).TextString>%"
							)
		)
	)
 	(setq Tgt	(strcat Tgt ") \\f \"%lu2%pr" (itoa ltr) "\">%"))
	(EX_VALUE_T_P_L Tgt (car Lob))
	(vl-cmdf "regen")
	(END_PG)
	(princ)
)

;;;----------------------------------------
;;;LINK HIEU

(defun C:LH (/ Tgt ent1 ent2)
	(START_PG)
	(setq ltr		(I_INT0 "\n Nhap chu so lam tron" ltr))
	(while (null	(setq	ss1	 (ES_TM&D "\n Chon so bi tru..."))))
	(while (null	(setq	ss2	 (ES_TM&D "\n Chon so tru..."))))
	(setq ent1 (car (C_S2L ss1))
				ent2 (car (C_S2L ss2))
	)
	(setq Tgt	(strcat "%<\\AcExpr (" 
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object ent1))
											">%).TextString>%"
											"-"
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object ent2))
											">%).TextString>%"
											") \\f \"%lu2%pr" (itoa ltr) "\""
										">%"
						)
	)
	(EX_VALUE_T_P_L Tgt ent1)
	(vl-cmdf "regen")
	(END_PG)
	(princ)
)

;;;----------------------------------------
;;;LINK CHIA

(defun C:L/ (/ Tgt ent1 ent2)
	(START_PG)
	(setq ltr		(I_INT0 "\n Nhap chu so lam tron" ltr))
	(while (null	(setq	ss1	 (ES_TM&D "\n Chon so BI CHIA..."))))
	(while (null	(setq	ss2	 (ES_TM&D "\n Chon so CHIA.."))))
	(setq ent1 	(car (C_S2L ss1))
				ent2 	(car (C_S2L ss2))
	)
	(setq Tgt	(strcat "%<\\AcExpr (" 
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object ent1))
											">%).TextString>%"
											"/"
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object ent2))
											">%).TextString>%"
											") \\f \"%lu2%pr" (itoa ltr) "\""
										">%"
						)
	)
	(EX_VALUE_T_P_L Tgt ent1)
	(vl-cmdf "regen")
	(END_PG)
	(princ)
)

;;;----------------------------------------
;;;LINK TONG
(defun C:LMH (/ Lst1 Lst2 Lst3 Tgt dem pt1 ob Tj) ;;;Link Multi Hang
	(START_PG) 
	(setq	42pan	(I_KEY "\n Tinh Cong/Nhan/CHia <C/N/CH>" "C N CH" 42pan)
				ltr		(I_INT0 "\n Nhap chu so lam tron" ltr)
				hso		(I_REAL "\n Nhap he so nhan" hso)
				Lst1	(OD_SSY_DES_L (C_S2L (ES_TM "\nChon cot thu nhat...")))
				Lst2	(OD_SSY_DES_L (C_S2L (ES_TM "\nChon cot thu hai...")))
				Lst3	(OD_SSY_DES_L (C_S2L (S_TM "\nChon cot ket qua/ENTER de xuat ke qua...")))
				Tgt 	"%<\\AcExpr (0"
				dem		0
	)
	(if (null Lst3)
		(while (null (setq pt1 (getpoint "\n X dat cot: "))))
	)
	(if (/= (length Lst1) (length Lst2))
		(progn
			(alert "So hang cua 2 cot khong bang nhau. Chon lai")
			(exit)
		)
	)
	(repeat (length Lst1)
		(setq ent1 (nth dem Lst1)
					ent2 (nth dem Lst2)
		)
		(if Lst3
			(setq ent3 (nth dem Lst3))
			(setq ent3 nil)
		)
		(setq dem (1+ dem))
		(cond	(	(= 42pan "C")
						(setq Tgt	(CALC_LINK ent1 ent2 "+" ltr hso))
					)
					(	(= 42pan "N")
						(setq Tgt	(CALC_LINK ent1 ent2 "*" ltr hso))
					)
					(	(= 42pan "CH")
						(setq Tgt	(CALC_LINK ent1 ent2 "/" ltr hso))
					)
		)
		(if	(/= ent3 nil)
			(progn
				(setq ob (entget ent3))
				(entmod (subst (cons 1 Tgt) (assoc 1 ob) ob))
			)
			(progn
				(if	(and (= (cadr (assoc 11 (entget ent1))) 0.0)
								 (= (caddr (assoc 11 (entget ent1))) 0.0)
						)
					(setq Tj 10)
					(setq Tj 11)
				)
				(setq	ent1	(entget ent1)
							pt1		(list (car pt1) (caddr (assoc Tj ent1)))
			 	)
				(entmakex (list	'(0 . "TEXT")
												'(100 . "AcDbEntity")
												(assoc 8 ent1)
												'(100 . "AcDbText")
												(cons Tj pt1)
												(assoc 40 ent1)
												(cons 1 Tgt)
												(assoc 50 ent1)
												(assoc 41 ent1)
												(assoc 51 ent1)
												(assoc 7 ent1)
												(assoc 71 ent1)
												(assoc 72 ent1)
												'(100 . "AcDbText")
												(assoc 73 ent1)
									)
				)
			)
		)
	)
	(vl-cmdf "regen")
	(END_PG)
	(princ)
)
;;;============================================================================================
;;;---------------------------------PHEP TINH TOAN VOI LINK------------------------------------
;;;============================================================================================

(defun CALC_LINK (ent1 ent2 ptinh ltr hso)
	(strcat "%<\\AcExpr (" 
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object ent1))
											">%).TextString>%"
											ptinh
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object ent2))
											">%).TextString>%"
											") \\f \"%lu2"
															"%pr" (itoa ltr)
															"%ct8[" (rtos hso 2 5) "]\""
					">%"
	)
)


(defun OWNER_ENAME (obn)
	(vlax-vla-object->ename
		(vla-objectidtoobject
			(vla-get-activedocument (vlax-get-acad-object))
			(vla-get-ownerid
				(vlax-ename->vla-object obn)
			)
		)
	)
)

;;;----------------------------------------------------------
;;;HAM LUU BAT DAU VA KET THUC CHUONG TRINH
(C:EXPRESSTOOLS)
;;;===============================================================
;;;---------- CAC HAM THIET LAP BAY LOI, RESTORE------------------
;;;===============================================================

;;;HAM BAY LOI
(defun INIT	()
	(setq	OLD_ERROR	*error*
				*error*	MYERROR
	)
	(command "Undo" "begin")
)

(defun MYERROR (errmsg)

	(cond
		((= errmsg "quit / exit abort")
		 (princ)
		)
		((/= errmsg "Function cancelled")
		 (princ (strcat "\n Co loi: " errmsg))
		)
	)

	(setvar "osmode" OLD_OSMODE)
	(setvar "AUTOSNAP" OLD_AUTOSNAP)
	(setvar "ORTHOMODE" OLD_ORTHOMODE)
	(setvar "DIMZIN" OLD_DIMZIN)
	(setvar "clayer" OLD_CLAYER)
	(setvar "CECOLOR" OLD_CECOLOR)
	(setvar "cmdecho" 1)
	(command "Undo" "end")
	(DONE)
	(prompt "\n Da Reset lai thiet lap ban dau")


)

(defun DONE	()
	(if	OLD_ERROR
		(setq *error* OLD_ERROR)
	)
)
;;;----------------------------------------------------------
;;;HAM LUU VA TRA LAI CAC THONG SO BAN DAU
(defun SAVE_MODE ()

	(setvar "cmdecho" 0)
	(command "Undo" "begin")
	(command "UCS" "W")
	(setq	OLD_OSMODE		(getvar "OSMODE")
				OLD_CECOLOR		(getvar "CECOLOR")
				OLD_AUTOSNAP	(getvar "AUTOSNAP")
				OLD_ORTHOMODE	(getvar "ORTHOMODE")
				OLD_CLAYER		(getvar "clayer")
				OLD_DIMZIN		(getvar "DIMZIN")
	)
	(setvar "DIMZIN" 0)

)
(defun RESTORE ()

	(setvar "osmode" OLD_OSMODE)
	(setvar "AUTOSNAP" OLD_AUTOSNAP)
	(setvar "ORTHOMODE" OLD_ORTHOMODE)
	(setvar "DIMZIN" OLD_DIMZIN)
	(setvar "clayer" OLD_CLAYER)
	(setvar "CECOLOR" OLD_CECOLOR)
	(command "Undo" "end")
	(setvar "cmdecho" 1)
	(Grtext -1 "Copyright by Nataca - 0983.715.333")
)
(defun START_PG	(/ ss)
	(setq ss (ssget "I"))

	(INIT)
	(SAVE_MODE)
	(sssetfirst nil ss)
)

(defun END_PG	()
	(DONE)
	(RESTORE)
)
;;;------------------------------------------
;;;NHAP GIA TRI LA SO NGUYEN ( BAO GOM CA SO 0)
(defun I_INT0	(dongnhac Tso)
	(if	(null Tso)
		(progn
			(initget (+ 1 4))
			(getint (strcat dongnhac " <?>:"))
		)
		(progn
			(cond
				((progn
					 (initget 4)
					 (getint (strcat dongnhac " < " (itoa Tso) " >:"))
				 )
				)
				(T Tso)

			)
		)

	)
)
;;;NHAP GIA TRI LA SO THUC
(defun I_REAL	(dongnhac Tso / Tso1)
	(if	(null Tso)
		(progn
			(initget (+ 1 2))
			(setq Tso (getdist (strcat dongnhac " <?>:")))
			(princ (strcat "\nGia tri vua nhap la: " (rtos Tso 2 5)))
			Tso
		)
		(progn
			(cond
				((progn
					 (initget (+ 2))
					 (setq Tso1 (getdist (strcat dongnhac " < " (rtos Tso 2 5) " >:")))
					 (if Tso1
						 (progn
							 (princ (strcat "\nGia tri vua nhap la: " (rtos Tso1 2 5)))
							 (setq Tso Tso1)
						 )
					 )
				 )
				)
				(T Tso)

			)
		)

	)
)
;;;------------------------------------------
;;;CHON LIEN TIEP NHIEU DOI TUONG THEO PHUONG PHAP PICK KEM DONG NHAC (BAT BUOC CHON)
(defun ES_ENT_LMP	(dongnhac / Lsel sel mouse ew)   ;;;LMP = List Multi Pick
	(prompt dongnhac)
	(while (/= (car mouse) 2)
		(setq mouse (grread 0 15 2))
		(if	(= (car mouse) 3)
	 		(if (setq sel (car (nentselp (cadr mouse))))
				(progn
					(setq Lsel (append Lsel (list sel)))
					(princ (strcat "\n" (itoa (length Lsel)) " doi tuong duoc pick chon/ENTER ke ket thuc chon"))
				)
				(princ "\nChon chua dung!")
			)
		)
	)
	Lsel
)

;;;------------------------------------------
;;;XUAT/EDIT KET QUA VOI TEXT MAU BANG CACH PICK DIEM (EDIT CA ATTRIBUTE, DUNG CHO LINK GIA TRI)
(defun EX_VALUE_T_P_L	(Tkq Tmau / mouse sel pt1 ob kq1 Elst Tj caoText oldTsize oldTstyle)
;;;Real+interge
	(prompt "\n Chon text chua kq / An enter de viet text kq...")
	(while (and (/= (car mouse) 2) (null sel))
		(setq mouse (grread 0 15 2))
		(if	(= (car mouse) 3)
			(if (null (setq sel (car (nentselp (cadr mouse)))))
					(princ "\nChon chua dung! Chon lai...")
			)
		)
	)
	(if	(/= sel nil)
		(progn
			(setq ob (entget sel))
			(entmod (subst (cons 1 Tkq) (assoc 1 ob) ob))
		)
		(progn
			(while (null (setq pt1 (getpoint "\n Diem dat text: "))))
			(if	Tmau
				(progn
					(if	(and (= (cadr (assoc 11 (entget Tmau))) 0.0)
									 (= (caddr (assoc 11 (entget Tmau))) 0.0)
							)
						(setq Tj 10)
						(setq Tj 11)
					)
					(setq	Tmau	(entget Tmau))
					(entmakex (list	'(0 . "TEXT")
													'(100 . "AcDbEntity")
													(assoc 8 Tmau)
													'(100 . "AcDbText")
													(cons Tj pt1)
													(assoc 40 Tmau)
													(cons 1 Tkq)
													(assoc 50 Tmau)
													(assoc 41 Tmau)
													(assoc 51 Tmau)
													(assoc 7 Tmau)
													(assoc 71 Tmau)
													(assoc 72 Tmau)
													'(100 . "AcDbText")
													(assoc 73 Tmau)
										)
					)
				)
			)
		)
	)

)

;;;------------------------------------------
;;;CHON TEXT VA DIMENSION KEM DONG NHAC (BAT BUOC CHON)
(defun ES_TM&D (dongnhac / ss)
	(while (and	(not (prompt dongnhac))
							(not (or (setq ss (ssget "I" '((0 . "*TEXT,DIMENSION"))))
											 (setq ss (ssget '((0 . "*TEXT,DIMENSION"))))
									 )
							)
				 )
	)
	ss
)
;;;CHUYEN BIEU DIEN TAP HOP DOI TUONG DUOI DANG LIST CHUA ENAME CUA CAC DOI TUONG
(defun C_S2L (ss)
	(if	ss
		(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
		nil
	)
)

;;;------------------------------------------
;;;NHAP KEY VAO
(defun I_KEY (dongnhac key Text)

	(if	(null Text)
		(progn
			(initget 1 key)
			(getkword (strcat dongnhac " :"))
		)
		(progn
			(cond
				((progn
					 (initget key)
					 (getkword (strcat dongnhac " < " Text " >:"))
				 )
				)
				(T Text)

			)
		)

	)
)

(defun OD_SSY_DES_L	(Lst)
	(setq	lst	(vl-sort lst
										 '(lambda	(e1 e2)
												(>
													(caddr (assoc
																	 (if (and	(= (cadr (assoc 11 (entget e1))) 0.0)
																						(= (caddr (assoc 11 (entget e1))) 0.0)
																			 )
																		 10
																		 11
																	 )
																	 (entget e1)
																 )
													)
													(caddr (assoc
																	 (if (and	(= (cadr (assoc 11 (entget e2))) 0.0)
																						(= (caddr (assoc 11 (entget e2))) 0.0)
																			 )
																		 10
																		 11
																	 )
																	 (entget e2)
																 )
													)
												)
											)
						)
	)
)

;;;------------------------------------------
;;;CHON TEXT, MTEXT KEM DONG NHAC (BAT BUOC CHON)
(defun ES_TM (dongnhac / ss)
	(while (and	(not (prompt dongnhac))
							(not (or (setq ss (ssget "I" '((0 . "*TEXT"))))
											 (setq ss (ssget '((0 . "*TEXT"))))
									 )
							)
				 )
	)
	ss
)

;;;CHON TEXT, MTEXT KEM DONG NHAC
(defun S_TM	(dongnhac / ss)
	(prompt dongnhac)
	(if	(null (setq ss (ssget "I" '((0 . "*TEXT")))))
		(setq ss (ssget '((0 . "*TEXT"))))
	)
	ss
)

lisp sửa chạy dc trên cad 64 bit


  • 2

#49 lohado

lohado

    biết lệnh erase

  • Members
  • PipPipPip
  • 101 Bài viết
Điểm đánh giá: 3 (bình thường)

Đã gửi 23 May 2016 - 01:34 PM

;;;============================================================================================
;;;-------------------LINK GIA TRI CUA DOI TUONG NAY DEN DOI TUONG TEXT KHAC (>=Cad2006)-------
;;;============================================================================================
(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)
(defun LM:ObjectID ( obj )
    (eval
        (list 'defun 'LM:ObjectID '( obj )
            (if
                (and
                    (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
                    (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
                )
                (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
               '(itoa (vla-get-objectid obj))
            )
        )
    )
    (LM:ObjectID obj)
)
;;;----------------------------------------
;;;LINK CHIEU DAI
(defun C:LL (/ obn Tkq)
	(START_PG)
	(setq obn (vlax-ename->vla-object (car (entsel "\nChon doi tuong nguon")))
				obd	(vlax-ename->vla-object (car (nentsel "\nChon text ghi chieu dai")))
				ltr	(I_INT0 "\n Nhap chu so lam tron" ltr)
				hso	(I_REAL "\n Nhap he so nhan" hso)
				Tkq	(strcat "%<\\AcObjProp Object(%<\\_ObjId "
										(LM:ObjectID obn)
										">%).Length \\f \"%lu2"
										"%pr" (rtos ltr 2 0)
										"%ct8[" (rtos hso 2 0) "]"
										"\">%"
						)

	)
	(vla-put-textstring obd Tkq)
	(vl-cmdf "regen")
	(END_PG)
	(princ)
)

;;;----------------------------------------
;;;LINK GIA TRI
(defun C:LGT (/ obn Tkq)
	(START_PG)
	(setq obn (vlax-ename->vla-object (car (nentsel "\nChon doi tuong nguon")))
				obd	(vlax-ename->vla-object (car (nentsel "\nChon text dich")))
				Tkq	(strcat "%<\\AcObjProp Object(%<\\_ObjId "
										(LM:ObjectID obn)
										">%).TextString>%"
						)
	)
	(vla-put-textstring obd Tkq)
	(vla-update obd)
	(vl-cmdf "regen")
	(END_PG)
	(princ)
)

;;;----------------------------------------
;;;LINK TONG
(defun C:LC (/ obn Lob Tgt)
	(START_PG) 
	(setq	ltr		(I_INT0 "\n Nhap chu so lam tron" ltr)
				Tgt "%<\\AcExpr (0")
	(foreach obn	(setq Lob (ES_ENT_LMP "\nChon cac Gia tri can tinh tong/ENTER de ket thuc chon..."))
		(setq Tgt	(strcat Tgt "+"
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object obn))
											">%).TextString>%"
							)
		)
	)
 	(setq Tgt	(strcat Tgt ") \\f \"%lu2%pr" (itoa ltr) "\">%"))
	(EX_VALUE_T_P_L Tgt (car Lob))
	(vl-cmdf "regen")
	(END_PG)
	(princ)
)

;;;----------------------------------------
;;;LINK TICH
(defun C:LN (/ Tgt obn Lob)
	(START_PG)
	(setq	ltr		(I_INT0 "\n Nhap chu so lam tron" ltr)
				Tgt 	"%<\\AcExpr (1"
	)
	(foreach obn	(setq Lob (ES_ENT_LMP "\nChon cac Gia tri can tinh tich/ENTER de ket thuc chon..."))
		(setq Tgt	(strcat Tgt "*"
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object obn))
											">%).TextString>%"
							)
		)
	)
 	(setq Tgt	(strcat Tgt ") \\f \"%lu2%pr" (itoa ltr) "\">%"))
	(EX_VALUE_T_P_L Tgt (car Lob))
	(vl-cmdf "regen")
	(END_PG)
	(princ)
)

;;;----------------------------------------
;;;LINK HIEU

(defun C:LH (/ Tgt ent1 ent2)
	(START_PG)
	(setq ltr		(I_INT0 "\n Nhap chu so lam tron" ltr))
	(while (null	(setq	ss1	 (ES_TM&D "\n Chon so bi tru..."))))
	(while (null	(setq	ss2	 (ES_TM&D "\n Chon so tru..."))))
	(setq ent1 (car (C_S2L ss1))
				ent2 (car (C_S2L ss2))
	)
	(setq Tgt	(strcat "%<\\AcExpr (" 
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object ent1))
											">%).TextString>%"
											"-"
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object ent2))
											">%).TextString>%"
											") \\f \"%lu2%pr" (itoa ltr) "\""
										">%"
						)
	)
	(EX_VALUE_T_P_L Tgt ent1)
	(vl-cmdf "regen")
	(END_PG)
	(princ)
)

;;;----------------------------------------
;;;LINK CHIA

(defun C:L/ (/ Tgt ent1 ent2)
	(START_PG)
	(setq ltr		(I_INT0 "\n Nhap chu so lam tron" ltr))
	(while (null	(setq	ss1	 (ES_TM&D "\n Chon so BI CHIA..."))))
	(while (null	(setq	ss2	 (ES_TM&D "\n Chon so CHIA.."))))
	(setq ent1 	(car (C_S2L ss1))
				ent2 	(car (C_S2L ss2))
	)
	(setq Tgt	(strcat "%<\\AcExpr (" 
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object ent1))
											">%).TextString>%"
											"/"
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object ent2))
											">%).TextString>%"
											") \\f \"%lu2%pr" (itoa ltr) "\""
										">%"
						)
	)
	(EX_VALUE_T_P_L Tgt ent1)
	(vl-cmdf "regen")
	(END_PG)
	(princ)
)

;;;----------------------------------------
;;;LINK TONG
(defun C:LMH (/ Lst1 Lst2 Lst3 Tgt dem pt1 ob Tj) ;;;Link Multi Hang
	(START_PG) 
	(setq	42pan	(I_KEY "\n Tinh Cong/Nhan/CHia <C/N/CH>" "C N CH" 42pan)
				ltr		(I_INT0 "\n Nhap chu so lam tron" ltr)
				hso		(I_REAL "\n Nhap he so nhan" hso)
				Lst1	(OD_SSY_DES_L (C_S2L (ES_TM "\nChon cot thu nhat...")))
				Lst2	(OD_SSY_DES_L (C_S2L (ES_TM "\nChon cot thu hai...")))
				Lst3	(OD_SSY_DES_L (C_S2L (S_TM "\nChon cot ket qua/ENTER de xuat ke qua...")))
				Tgt 	"%<\\AcExpr (0"
				dem		0
	)
	(if (null Lst3)
		(while (null (setq pt1 (getpoint "\n X dat cot: "))))
	)
	(if (/= (length Lst1) (length Lst2))
		(progn
			(alert "So hang cua 2 cot khong bang nhau. Chon lai")
			(exit)
		)
	)
	(repeat (length Lst1)
		(setq ent1 (nth dem Lst1)
					ent2 (nth dem Lst2)
		)
		(if Lst3
			(setq ent3 (nth dem Lst3))
			(setq ent3 nil)
		)
		(setq dem (1+ dem))
		(cond	(	(= 42pan "C")
						(setq Tgt	(CALC_LINK ent1 ent2 "+" ltr hso))
					)
					(	(= 42pan "N")
						(setq Tgt	(CALC_LINK ent1 ent2 "*" ltr hso))
					)
					(	(= 42pan "CH")
						(setq Tgt	(CALC_LINK ent1 ent2 "/" ltr hso))
					)
		)
		(if	(/= ent3 nil)
			(progn
				(setq ob (entget ent3))
				(entmod (subst (cons 1 Tgt) (assoc 1 ob) ob))
			)
			(progn
				(if	(and (= (cadr (assoc 11 (entget ent1))) 0.0)
								 (= (caddr (assoc 11 (entget ent1))) 0.0)
						)
					(setq Tj 10)
					(setq Tj 11)
				)
				(setq	ent1	(entget ent1)
							pt1		(list (car pt1) (caddr (assoc Tj ent1)))
			 	)
				(entmakex (list	'(0 . "TEXT")
												'(100 . "AcDbEntity")
												(assoc 8 ent1)
												'(100 . "AcDbText")
												(cons Tj pt1)
												(assoc 40 ent1)
												(cons 1 Tgt)
												(assoc 50 ent1)
												(assoc 41 ent1)
												(assoc 51 ent1)
												(assoc 7 ent1)
												(assoc 71 ent1)
												(assoc 72 ent1)
												'(100 . "AcDbText")
												(assoc 73 ent1)
									)
				)
			)
		)
	)
	(vl-cmdf "regen")
	(END_PG)
	(princ)
)
;;;============================================================================================
;;;---------------------------------PHEP TINH TOAN VOI LINK------------------------------------
;;;============================================================================================

(defun CALC_LINK (ent1 ent2 ptinh ltr hso)
	(strcat "%<\\AcExpr (" 
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object ent1))
											">%).TextString>%"
											ptinh
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object ent2))
											">%).TextString>%"
											") \\f \"%lu2"
															"%pr" (itoa ltr)
															"%ct8[" (rtos hso 2 5) "]\""
					">%"
	)
)


(defun OWNER_ENAME (obn)
	(vlax-vla-object->ename
		(vla-objectidtoobject
			(vla-get-activedocument (vlax-get-acad-object))
			(vla-get-ownerid
				(vlax-ename->vla-object obn)
			)
		)
	)
)

;;;----------------------------------------------------------
;;;HAM LUU BAT DAU VA KET THUC CHUONG TRINH
(C:EXPRESSTOOLS)
;;;===============================================================
;;;---------- CAC HAM THIET LAP BAY LOI, RESTORE------------------
;;;===============================================================

;;;HAM BAY LOI
(defun INIT	()
	(setq	OLD_ERROR	*error*
				*error*	MYERROR
	)
	(command "Undo" "begin")
)

(defun MYERROR (errmsg)

	(cond
		((= errmsg "quit / exit abort")
		 (princ)
		)
		((/= errmsg "Function cancelled")
		 (princ (strcat "\n Co loi: " errmsg))
		)
	)

	(setvar "osmode" OLD_OSMODE)
	(setvar "AUTOSNAP" OLD_AUTOSNAP)
	(setvar "ORTHOMODE" OLD_ORTHOMODE)
	(setvar "DIMZIN" OLD_DIMZIN)
	(setvar "clayer" OLD_CLAYER)
	(setvar "CECOLOR" OLD_CECOLOR)
	(setvar "cmdecho" 1)
	(command "Undo" "end")
	(DONE)
	(prompt "\n Da Reset lai thiet lap ban dau")


)

(defun DONE	()
	(if	OLD_ERROR
		(setq *error* OLD_ERROR)
	)
)
;;;----------------------------------------------------------
;;;HAM LUU VA TRA LAI CAC THONG SO BAN DAU
(defun SAVE_MODE ()

	(setvar "cmdecho" 0)
	(command "Undo" "begin")
	(command "UCS" "W")
	(setq	OLD_OSMODE		(getvar "OSMODE")
				OLD_CECOLOR		(getvar "CECOLOR")
				OLD_AUTOSNAP	(getvar "AUTOSNAP")
				OLD_ORTHOMODE	(getvar "ORTHOMODE")
				OLD_CLAYER		(getvar "clayer")
				OLD_DIMZIN		(getvar "DIMZIN")
	)
	(setvar "DIMZIN" 0)

)
(defun RESTORE ()

	(setvar "osmode" OLD_OSMODE)
	(setvar "AUTOSNAP" OLD_AUTOSNAP)
	(setvar "ORTHOMODE" OLD_ORTHOMODE)
	(setvar "DIMZIN" OLD_DIMZIN)
	(setvar "clayer" OLD_CLAYER)
	(setvar "CECOLOR" OLD_CECOLOR)
	(command "Undo" "end")
	(setvar "cmdecho" 1)
	(Grtext -1 "Copyright by Nataca - 0983.715.333")
)
(defun START_PG	(/ ss)
	(setq ss (ssget "I"))

	(INIT)
	(SAVE_MODE)
	(sssetfirst nil ss)
)

(defun END_PG	()
	(DONE)
	(RESTORE)
)
;;;------------------------------------------
;;;NHAP GIA TRI LA SO NGUYEN ( BAO GOM CA SO 0)
(defun I_INT0	(dongnhac Tso)
	(if	(null Tso)
		(progn
			(initget (+ 1 4))
			(getint (strcat dongnhac " <?>:"))
		)
		(progn
			(cond
				((progn
					 (initget 4)
					 (getint (strcat dongnhac " < " (itoa Tso) " >:"))
				 )
				)
				(T Tso)

			)
		)

	)
)
;;;NHAP GIA TRI LA SO THUC
(defun I_REAL	(dongnhac Tso / Tso1)
	(if	(null Tso)
		(progn
			(initget (+ 1 2))
			(setq Tso (getdist (strcat dongnhac " <?>:")))
			(princ (strcat "\nGia tri vua nhap la: " (rtos Tso 2 5)))
			Tso
		)
		(progn
			(cond
				((progn
					 (initget (+ 2))
					 (setq Tso1 (getdist (strcat dongnhac " < " (rtos Tso 2 5) " >:")))
					 (if Tso1
						 (progn
							 (princ (strcat "\nGia tri vua nhap la: " (rtos Tso1 2 5)))
							 (setq Tso Tso1)
						 )
					 )
				 )
				)
				(T Tso)

			)
		)

	)
)
;;;------------------------------------------
;;;CHON LIEN TIEP NHIEU DOI TUONG THEO PHUONG PHAP PICK KEM DONG NHAC (BAT BUOC CHON)
(defun ES_ENT_LMP	(dongnhac / Lsel sel mouse ew)   ;;;LMP = List Multi Pick
	(prompt dongnhac)
	(while (/= (car mouse) 2)
		(setq mouse (grread 0 15 2))
		(if	(= (car mouse) 3)
	 		(if (setq sel (car (nentselp (cadr mouse))))
				(progn
					(setq Lsel (append Lsel (list sel)))
					(princ (strcat "\n" (itoa (length Lsel)) " doi tuong duoc pick chon/ENTER ke ket thuc chon"))
				)
				(princ "\nChon chua dung!")
			)
		)
	)
	Lsel
)

;;;------------------------------------------
;;;XUAT/EDIT KET QUA VOI TEXT MAU BANG CACH PICK DIEM (EDIT CA ATTRIBUTE, DUNG CHO LINK GIA TRI)
(defun EX_VALUE_T_P_L	(Tkq Tmau / mouse sel pt1 ob kq1 Elst Tj caoText oldTsize oldTstyle)
;;;Real+interge
	(prompt "\n Chon text chua kq / An enter de viet text kq...")
	(while (and (/= (car mouse) 2) (null sel))
		(setq mouse (grread 0 15 2))
		(if	(= (car mouse) 3)
			(if (null (setq sel (car (nentselp (cadr mouse)))))
					(princ "\nChon chua dung! Chon lai...")
			)
		)
	)
	(if	(/= sel nil)
		(progn
			(setq ob (entget sel))
			(entmod (subst (cons 1 Tkq) (assoc 1 ob) ob))
		)
		(progn
			(while (null (setq pt1 (getpoint "\n Diem dat text: "))))
			(if	Tmau
				(progn
					(if	(and (= (cadr (assoc 11 (entget Tmau))) 0.0)
									 (= (caddr (assoc 11 (entget Tmau))) 0.0)
							)
						(setq Tj 10)
						(setq Tj 11)
					)
					(setq	Tmau	(entget Tmau))
					(entmakex (list	'(0 . "TEXT")
													'(100 . "AcDbEntity")
													(assoc 8 Tmau)
													'(100 . "AcDbText")
													(cons Tj pt1)
													(assoc 40 Tmau)
													(cons 1 Tkq)
													(assoc 50 Tmau)
													(assoc 41 Tmau)
													(assoc 51 Tmau)
													(assoc 7 Tmau)
													(assoc 71 Tmau)
													(assoc 72 Tmau)
													'(100 . "AcDbText")
													(assoc 73 Tmau)
										)
					)
				)
			)
		)
	)

)

;;;------------------------------------------
;;;CHON TEXT VA DIMENSION KEM DONG NHAC (BAT BUOC CHON)
(defun ES_TM&D (dongnhac / ss)
	(while (and	(not (prompt dongnhac))
							(not (or (setq ss (ssget "I" '((0 . "*TEXT,DIMENSION"))))
											 (setq ss (ssget '((0 . "*TEXT,DIMENSION"))))
									 )
							)
				 )
	)
	ss
)
;;;CHUYEN BIEU DIEN TAP HOP DOI TUONG DUOI DANG LIST CHUA ENAME CUA CAC DOI TUONG
(defun C_S2L (ss)
	(if	ss
		(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
		nil
	)
)

;;;------------------------------------------
;;;NHAP KEY VAO
(defun I_KEY (dongnhac key Text)

	(if	(null Text)
		(progn
			(initget 1 key)
			(getkword (strcat dongnhac " :"))
		)
		(progn
			(cond
				((progn
					 (initget key)
					 (getkword (strcat dongnhac " < " Text " >:"))
				 )
				)
				(T Text)

			)
		)

	)
)

(defun OD_SSY_DES_L	(Lst)
	(setq	lst	(vl-sort lst
										 '(lambda	(e1 e2)
												(>
													(caddr (assoc
																	 (if (and	(= (cadr (assoc 11 (entget e1))) 0.0)
																						(= (caddr (assoc 11 (entget e1))) 0.0)
																			 )
																		 10
																		 11
																	 )
																	 (entget e1)
																 )
													)
													(caddr (assoc
																	 (if (and	(= (cadr (assoc 11 (entget e2))) 0.0)
																						(= (caddr (assoc 11 (entget e2))) 0.0)
																			 )
																		 10
																		 11
																	 )
																	 (entget e2)
																 )
													)
												)
											)
						)
	)
)

;;;------------------------------------------
;;;CHON TEXT, MTEXT KEM DONG NHAC (BAT BUOC CHON)
(defun ES_TM (dongnhac / ss)
	(while (and	(not (prompt dongnhac))
							(not (or (setq ss (ssget "I" '((0 . "*TEXT"))))
											 (setq ss (ssget '((0 . "*TEXT"))))
									 )
							)
				 )
	)
	ss
)

;;;CHON TEXT, MTEXT KEM DONG NHAC
(defun S_TM	(dongnhac / ss)
	(prompt dongnhac)
	(if	(null (setq ss (ssget "I" '((0 . "*TEXT")))))
		(setq ss (ssget '((0 . "*TEXT"))))
	)
	ss
)

lisp sửa chạy dc trên cad 64 bit

 

Mình mới thử lệnh LL nhưng vẫn lỗi toàn ####


  • 0

    146106_untitled444_2.png


#50 phongtran86

phongtran86

    biết lệnh offset

  • Members
  • PipPipPip
  • 177 Bài viết
Điểm đánh giá: 22 (tàm tạm)

Đã gửi 23 May 2016 - 04:13 PM

Mình mới thử lệnh LL nhưng vẫn lỗi toàn ####

mình dùng bt. cad 207, 2010, 2015. bạn lỗi up thử file bạn bị lỗi lên mình xem thử


  • 0

#51 ancontau

ancontau

    Chưa sử dụng CAD

  • Members
  • Pip
  • 3 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 14 June 2016 - 11:23 PM

;;;============================================================================================
;;;-------------------LINK GIA TRI CUA DOI TUONG NAY DEN DOI TUONG TEXT KHAC (>=Cad2006)-------
;;;============================================================================================
(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)
(defun LM:ObjectID ( obj )
    (eval
        (list 'defun 'LM:ObjectID '( obj )
            (if
                (and
                    (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
                    (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
                )
                (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
               '(itoa (vla-get-objectid obj))
            )
        )
    )
    (LM:ObjectID obj)
)
;;;----------------------------------------
;;;LINK CHIEU DAI
(defun C:LL (/ obn Tkq)
	(START_PG)
	(setq obn (vlax-ename->vla-object (car (entsel "\nChon doi tuong nguon")))
				obd	(vlax-ename->vla-object (car (nentsel "\nChon text ghi chieu dai")))
				ltr	(I_INT0 "\n Nhap chu so lam tron" ltr)
				hso	(I_REAL "\n Nhap he so nhan" hso)
				Tkq	(strcat "%<\\AcObjProp Object(%<\\_ObjId "
										(LM:ObjectID obn)
										">%).Length \\f \"%lu2"
										"%pr" (rtos ltr 2 0)
										"%ct8[" (rtos hso 2 0) "]"
										"\">%"
						)

	)
	(vla-put-textstring obd Tkq)
	(vl-cmdf "regen")
	(END_PG)
	(princ)
)

;;;----------------------------------------
;;;LINK GIA TRI
(defun C:LGT (/ obn Tkq)
	(START_PG)
	(setq obn (vlax-ename->vla-object (car (nentsel "\nChon doi tuong nguon")))
				obd	(vlax-ename->vla-object (car (nentsel "\nChon text dich")))
				Tkq	(strcat "%<\\AcObjProp Object(%<\\_ObjId "
										(LM:ObjectID obn)
										">%).TextString>%"
						)
	)
	(vla-put-textstring obd Tkq)
	(vla-update obd)
	(vl-cmdf "regen")
	(END_PG)
	(princ)
)

;;;----------------------------------------
;;;LINK TONG
(defun C:LC (/ obn Lob Tgt)
	(START_PG) 
	(setq	ltr		(I_INT0 "\n Nhap chu so lam tron" ltr)
				Tgt "%<\\AcExpr (0")
	(foreach obn	(setq Lob (ES_ENT_LMP "\nChon cac Gia tri can tinh tong/ENTER de ket thuc chon..."))
		(setq Tgt	(strcat Tgt "+"
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object obn))
											">%).TextString>%"
							)
		)
	)
 	(setq Tgt	(strcat Tgt ") \\f \"%lu2%pr" (itoa ltr) "\">%"))
	(EX_VALUE_T_P_L Tgt (car Lob))
	(vl-cmdf "regen")
	(END_PG)
	(princ)
)

;;;----------------------------------------
;;;LINK TICH
(defun C:LN (/ Tgt obn Lob)
	(START_PG)
	(setq	ltr		(I_INT0 "\n Nhap chu so lam tron" ltr)
				Tgt 	"%<\\AcExpr (1"
	)
	(foreach obn	(setq Lob (ES_ENT_LMP "\nChon cac Gia tri can tinh tich/ENTER de ket thuc chon..."))
		(setq Tgt	(strcat Tgt "*"
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object obn))
											">%).TextString>%"
							)
		)
	)
 	(setq Tgt	(strcat Tgt ") \\f \"%lu2%pr" (itoa ltr) "\">%"))
	(EX_VALUE_T_P_L Tgt (car Lob))
	(vl-cmdf "regen")
	(END_PG)
	(princ)
)

;;;----------------------------------------
;;;LINK HIEU

(defun C:LH (/ Tgt ent1 ent2)
	(START_PG)
	(setq ltr		(I_INT0 "\n Nhap chu so lam tron" ltr))
	(while (null	(setq	ss1	 (ES_TM&D "\n Chon so bi tru..."))))
	(while (null	(setq	ss2	 (ES_TM&D "\n Chon so tru..."))))
	(setq ent1 (car (C_S2L ss1))
				ent2 (car (C_S2L ss2))
	)
	(setq Tgt	(strcat "%<\\AcExpr (" 
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object ent1))
											">%).TextString>%"
											"-"
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object ent2))
											">%).TextString>%"
											") \\f \"%lu2%pr" (itoa ltr) "\""
										">%"
						)
	)
	(EX_VALUE_T_P_L Tgt ent1)
	(vl-cmdf "regen")
	(END_PG)
	(princ)
)

;;;----------------------------------------
;;;LINK CHIA

(defun C:L/ (/ Tgt ent1 ent2)
	(START_PG)
	(setq ltr		(I_INT0 "\n Nhap chu so lam tron" ltr))
	(while (null	(setq	ss1	 (ES_TM&D "\n Chon so BI CHIA..."))))
	(while (null	(setq	ss2	 (ES_TM&D "\n Chon so CHIA.."))))
	(setq ent1 	(car (C_S2L ss1))
				ent2 	(car (C_S2L ss2))
	)
	(setq Tgt	(strcat "%<\\AcExpr (" 
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object ent1))
											">%).TextString>%"
											"/"
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object ent2))
											">%).TextString>%"
											") \\f \"%lu2%pr" (itoa ltr) "\""
										">%"
						)
	)
	(EX_VALUE_T_P_L Tgt ent1)
	(vl-cmdf "regen")
	(END_PG)
	(princ)
)

;;;----------------------------------------
;;;LINK TONG
(defun C:LMH (/ Lst1 Lst2 Lst3 Tgt dem pt1 ob Tj) ;;;Link Multi Hang
	(START_PG) 
	(setq	42pan	(I_KEY "\n Tinh Cong/Nhan/CHia <C/N/CH>" "C N CH" 42pan)
				ltr		(I_INT0 "\n Nhap chu so lam tron" ltr)
				hso		(I_REAL "\n Nhap he so nhan" hso)
				Lst1	(OD_SSY_DES_L (C_S2L (ES_TM "\nChon cot thu nhat...")))
				Lst2	(OD_SSY_DES_L (C_S2L (ES_TM "\nChon cot thu hai...")))
				Lst3	(OD_SSY_DES_L (C_S2L (S_TM "\nChon cot ket qua/ENTER de xuat ke qua...")))
				Tgt 	"%<\\AcExpr (0"
				dem		0
	)
	(if (null Lst3)
		(while (null (setq pt1 (getpoint "\n X dat cot: "))))
	)
	(if (/= (length Lst1) (length Lst2))
		(progn
			(alert "So hang cua 2 cot khong bang nhau. Chon lai")
			(exit)
		)
	)
	(repeat (length Lst1)
		(setq ent1 (nth dem Lst1)
					ent2 (nth dem Lst2)
		)
		(if Lst3
			(setq ent3 (nth dem Lst3))
			(setq ent3 nil)
		)
		(setq dem (1+ dem))
		(cond	(	(= 42pan "C")
						(setq Tgt	(CALC_LINK ent1 ent2 "+" ltr hso))
					)
					(	(= 42pan "N")
						(setq Tgt	(CALC_LINK ent1 ent2 "*" ltr hso))
					)
					(	(= 42pan "CH")
						(setq Tgt	(CALC_LINK ent1 ent2 "/" ltr hso))
					)
		)
		(if	(/= ent3 nil)
			(progn
				(setq ob (entget ent3))
				(entmod (subst (cons 1 Tgt) (assoc 1 ob) ob))
			)
			(progn
				(if	(and (= (cadr (assoc 11 (entget ent1))) 0.0)
								 (= (caddr (assoc 11 (entget ent1))) 0.0)
						)
					(setq Tj 10)
					(setq Tj 11)
				)
				(setq	ent1	(entget ent1)
							pt1		(list (car pt1) (caddr (assoc Tj ent1)))
			 	)
				(entmakex (list	'(0 . "TEXT")
												'(100 . "AcDbEntity")
												(assoc 8 ent1)
												'(100 . "AcDbText")
												(cons Tj pt1)
												(assoc 40 ent1)
												(cons 1 Tgt)
												(assoc 50 ent1)
												(assoc 41 ent1)
												(assoc 51 ent1)
												(assoc 7 ent1)
												(assoc 71 ent1)
												(assoc 72 ent1)
												'(100 . "AcDbText")
												(assoc 73 ent1)
									)
				)
			)
		)
	)
	(vl-cmdf "regen")
	(END_PG)
	(princ)
)
;;;============================================================================================
;;;---------------------------------PHEP TINH TOAN VOI LINK------------------------------------
;;;============================================================================================

(defun CALC_LINK (ent1 ent2 ptinh ltr hso)
	(strcat "%<\\AcExpr (" 
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object ent1))
											">%).TextString>%"
											ptinh
											"%<\\AcObjProp Object(%<\\_ObjId "
											(LM:ObjectID (vlax-ename->vla-object ent2))
											">%).TextString>%"
											") \\f \"%lu2"
															"%pr" (itoa ltr)
															"%ct8[" (rtos hso 2 5) "]\""
					">%"
	)
)


(defun OWNER_ENAME (obn)
	(vlax-vla-object->ename
		(vla-objectidtoobject
			(vla-get-activedocument (vlax-get-acad-object))
			(vla-get-ownerid
				(vlax-ename->vla-object obn)
			)
		)
	)
)

;;;----------------------------------------------------------
;;;HAM LUU BAT DAU VA KET THUC CHUONG TRINH
(C:EXPRESSTOOLS)
;;;===============================================================
;;;---------- CAC HAM THIET LAP BAY LOI, RESTORE------------------
;;;===============================================================

;;;HAM BAY LOI
(defun INIT	()
	(setq	OLD_ERROR	*error*
				*error*	MYERROR
	)
	(command "Undo" "begin")
)

(defun MYERROR (errmsg)

	(cond
		((= errmsg "quit / exit abort")
		 (princ)
		)
		((/= errmsg "Function cancelled")
		 (princ (strcat "\n Co loi: " errmsg))
		)
	)

	(setvar "osmode" OLD_OSMODE)
	(setvar "AUTOSNAP" OLD_AUTOSNAP)
	(setvar "ORTHOMODE" OLD_ORTHOMODE)
	(setvar "DIMZIN" OLD_DIMZIN)
	(setvar "clayer" OLD_CLAYER)
	(setvar "CECOLOR" OLD_CECOLOR)
	(setvar "cmdecho" 1)
	(command "Undo" "end")
	(DONE)
	(prompt "\n Da Reset lai thiet lap ban dau")


)

(defun DONE	()
	(if	OLD_ERROR
		(setq *error* OLD_ERROR)
	)
)
;;;----------------------------------------------------------
;;;HAM LUU VA TRA LAI CAC THONG SO BAN DAU
(defun SAVE_MODE ()

	(setvar "cmdecho" 0)
	(command "Undo" "begin")
	(command "UCS" "W")
	(setq	OLD_OSMODE		(getvar "OSMODE")
				OLD_CECOLOR		(getvar "CECOLOR")
				OLD_AUTOSNAP	(getvar "AUTOSNAP")
				OLD_ORTHOMODE	(getvar "ORTHOMODE")
				OLD_CLAYER		(getvar "clayer")
				OLD_DIMZIN		(getvar "DIMZIN")
	)
	(setvar "DIMZIN" 0)

)
(defun RESTORE ()

	(setvar "osmode" OLD_OSMODE)
	(setvar "AUTOSNAP" OLD_AUTOSNAP)
	(setvar "ORTHOMODE" OLD_ORTHOMODE)
	(setvar "DIMZIN" OLD_DIMZIN)
	(setvar "clayer" OLD_CLAYER)
	(setvar "CECOLOR" OLD_CECOLOR)
	(command "Undo" "end")
	(setvar "cmdecho" 1)
	(Grtext -1 "Copyright by Nataca - 0983.715.333")
)
(defun START_PG	(/ ss)
	(setq ss (ssget "I"))

	(INIT)
	(SAVE_MODE)
	(sssetfirst nil ss)
)

(defun END_PG	()
	(DONE)
	(RESTORE)
)
;;;------------------------------------------
;;;NHAP GIA TRI LA SO NGUYEN ( BAO GOM CA SO 0)
(defun I_INT0	(dongnhac Tso)
	(if	(null Tso)
		(progn
			(initget (+ 1 4))
			(getint (strcat dongnhac " <?>:"))
		)
		(progn
			(cond
				((progn
					 (initget 4)
					 (getint (strcat dongnhac " < " (itoa Tso) " >:"))
				 )
				)
				(T Tso)

			)
		)

	)
)
;;;NHAP GIA TRI LA SO THUC
(defun I_REAL	(dongnhac Tso / Tso1)
	(if	(null Tso)
		(progn
			(initget (+ 1 2))
			(setq Tso (getdist (strcat dongnhac " <?>:")))
			(princ (strcat "\nGia tri vua nhap la: " (rtos Tso 2 5)))
			Tso
		)
		(progn
			(cond
				((progn
					 (initget (+ 2))
					 (setq Tso1 (getdist (strcat dongnhac " < " (rtos Tso 2 5) " >:")))
					 (if Tso1
						 (progn
							 (princ (strcat "\nGia tri vua nhap la: " (rtos Tso1 2 5)))
							 (setq Tso Tso1)
						 )
					 )
				 )
				)
				(T Tso)

			)
		)

	)
)
;;;------------------------------------------
;;;CHON LIEN TIEP NHIEU DOI TUONG THEO PHUONG PHAP PICK KEM DONG NHAC (BAT BUOC CHON)
(defun ES_ENT_LMP	(dongnhac / Lsel sel mouse ew)   ;;;LMP = List Multi Pick
	(prompt dongnhac)
	(while (/= (car mouse) 2)
		(setq mouse (grread 0 15 2))
		(if	(= (car mouse) 3)
	 		(if (setq sel (car (nentselp (cadr mouse))))
				(progn
					(setq Lsel (append Lsel (list sel)))
					(princ (strcat "\n" (itoa (length Lsel)) " doi tuong duoc pick chon/ENTER ke ket thuc chon"))
				)
				(princ "\nChon chua dung!")
			)
		)
	)
	Lsel
)

;;;------------------------------------------
;;;XUAT/EDIT KET QUA VOI TEXT MAU BANG CACH PICK DIEM (EDIT CA ATTRIBUTE, DUNG CHO LINK GIA TRI)
(defun EX_VALUE_T_P_L	(Tkq Tmau / mouse sel pt1 ob kq1 Elst Tj caoText oldTsize oldTstyle)
;;;Real+interge
	(prompt "\n Chon text chua kq / An enter de viet text kq...")
	(while (and (/= (car mouse) 2) (null sel))
		(setq mouse (grread 0 15 2))
		(if	(= (car mouse) 3)
			(if (null (setq sel (car (nentselp (cadr mouse)))))
					(princ "\nChon chua dung! Chon lai...")
			)
		)
	)
	(if	(/= sel nil)
		(progn
			(setq ob (entget sel))
			(entmod (subst (cons 1 Tkq) (assoc 1 ob) ob))
		)
		(progn
			(while (null (setq pt1 (getpoint "\n Diem dat text: "))))
			(if	Tmau
				(progn
					(if	(and (= (cadr (assoc 11 (entget Tmau))) 0.0)
									 (= (caddr (assoc 11 (entget Tmau))) 0.0)
							)
						(setq Tj 10)
						(setq Tj 11)
					)
					(setq	Tmau	(entget Tmau))
					(entmakex (list	'(0 . "TEXT")
													'(100 . "AcDbEntity")
													(assoc 8 Tmau)
													'(100 . "AcDbText")
													(cons Tj pt1)
													(assoc 40 Tmau)
													(cons 1 Tkq)
													(assoc 50 Tmau)
													(assoc 41 Tmau)
													(assoc 51 Tmau)
													(assoc 7 Tmau)
													(assoc 71 Tmau)
													(assoc 72 Tmau)
													'(100 . "AcDbText")
													(assoc 73 Tmau)
										)
					)
				)
			)
		)
	)

)

;;;------------------------------------------
;;;CHON TEXT VA DIMENSION KEM DONG NHAC (BAT BUOC CHON)
(defun ES_TM&D (dongnhac / ss)
	(while (and	(not (prompt dongnhac))
							(not (or (setq ss (ssget "I" '((0 . "*TEXT,DIMENSION"))))
											 (setq ss (ssget '((0 . "*TEXT,DIMENSION"))))
									 )
							)
				 )
	)
	ss
)
;;;CHUYEN BIEU DIEN TAP HOP DOI TUONG DUOI DANG LIST CHUA ENAME CUA CAC DOI TUONG
(defun C_S2L (ss)
	(if	ss
		(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
		nil
	)
)

;;;------------------------------------------
;;;NHAP KEY VAO
(defun I_KEY (dongnhac key Text)

	(if	(null Text)
		(progn
			(initget 1 key)
			(getkword (strcat dongnhac " :"))
		)
		(progn
			(cond
				((progn
					 (initget key)
					 (getkword (strcat dongnhac " < " Text " >:"))
				 )
				)
				(T Text)

			)
		)

	)
)

(defun OD_SSY_DES_L	(Lst)
	(setq	lst	(vl-sort lst
										 '(lambda	(e1 e2)
												(>
													(caddr (assoc
																	 (if (and	(= (cadr (assoc 11 (entget e1))) 0.0)
																						(= (caddr (assoc 11 (entget e1))) 0.0)
																			 )
																		 10
																		 11
																	 )
																	 (entget e1)
																 )
													)
													(caddr (assoc
																	 (if (and	(= (cadr (assoc 11 (entget e2))) 0.0)
																						(= (caddr (assoc 11 (entget e2))) 0.0)
																			 )
																		 10
																		 11
																	 )
																	 (entget e2)
																 )
													)
												)
											)
						)
	)
)

;;;------------------------------------------
;;;CHON TEXT, MTEXT KEM DONG NHAC (BAT BUOC CHON)
(defun ES_TM (dongnhac / ss)
	(while (and	(not (prompt dongnhac))
							(not (or (setq ss (ssget "I" '((0 . "*TEXT"))))
											 (setq ss (ssget '((0 . "*TEXT"))))
									 )
							)
				 )
	)
	ss
)

;;;CHON TEXT, MTEXT KEM DONG NHAC
(defun S_TM	(dongnhac / ss)
	(prompt dongnhac)
	(if	(null (setq ss (ssget "I" '((0 . "*TEXT")))))
		(setq ss (ssget '((0 . "*TEXT"))))
	)
	ss
)

lisp sửa chạy dc trên cad 64 bit

 

phongtran86 quá tuyệt, quá pro, cám ơn bạn mình hóng lâu quá rồi!!!!!!!!!!!!


  • 1