Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
nataca

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

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

;;;============================================================================================
;;;-------------------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!!!!!!!!!!!!

  • Vote tăng 1

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

Chào các anh. Đoạn lisp của anh nataca em có sửa lại với mục đích không phải chọn lại đối tượng mới vẽ nhưng chưa thành công, mong các anh chỉnh lại giúp em với ạ.

 

 

(setq
Tyle 1
tphan 2
)
(defun C:x22 (/ obn Tkq)
(setq G1 (Getpoint "\nChon Diem Bat dau : "))
(setq G2 (Getpoint "\nChon Diem ket thuc: "))
(command "Pline" g1 g2 "")
(setq et (entlast))
; (setq obn (vlax-ename->vla-object (car (entsel "\nChon doi tuong nguon")))
(setq obn (vlax-ename->vla-object (car et))
obd (vlax-ename->vla-object (car (nentsel "\nChon text ghi chieu dai")))
Tkq (strcat
"%<\\AcObjProp Object(%<\\_ObjId "
(rtos (vla-get-objectid obn) 2 0)">%).Length \\f \"%lu2"
"%pr" (rtos tphan 2 0) "%ct8[" (rtos Tyle 2 0) "]" "\">%"
)
)
(vla-put-textstring obd Tkq)
(vl-cmdf "regen")

(princ)
)

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

Chào các anh. Đoạn lisp của anh nataca em có sửa lại với mục đích không phải chọn lại đối tượng mới vẽ nhưng chưa thành công, mong các anh chỉnh lại giúp em với ạ.

 

 

(setq

Tyle 1

tphan 2

)

(defun C:x22 (/ obn Tkq)

(setq G1 (Getpoint "\nChon Diem Bat dau : "))

(setq G2 (Getpoint "\nChon Diem ket thuc: "))

(command "Pline" g1 g2 "")

(setq et (entlast))

; (setq obn (vlax-ename->vla-object (car (entsel "\nChon doi tuong nguon")))

(setq obn (vlax-ename->vla-object (car et))

obd (vlax-ename->vla-object (car (nentsel "\nChon text ghi chieu dai")))

Tkq (strcat

"%<\\AcObjProp Object(%<\\_ObjId "

(rtos (vla-get-objectid obn) 2 0)">%).Length \\f \"%lu2"

"%pr" (rtos tphan 2 0) "%ct8[" (rtos Tyle 2 0) "]" "\">%"

)

)

(vla-put-textstring obd Tkq)

(vl-cmdf "regen")

 

(princ)

)

Thay dòng:

(setq obn (vlax-ename->vla-object (car ET))

thành:

(setq obn (vlax-ename->vla-object ET)

  • Vote tăng 1

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

Em có ý tưởng chèn Field vào block att để đánh cốt cao độ. Em đã tìm hiểu trên diễn đàn có lisp của bác Ketxu rất hay nhưng tiếc là mã đóng. Em cũng có mày mò sửa lại code ban đầu  nhưng vẫn còn vướng việc đưa field vào ATT.  Các anh có thể xem và sửa lại hoặc gợi ý giúp em với ạ. Cám ơn . :))

Code dưới em đang cố đưa field vào att thôi ạ. chưa có tính toán gì đâu ạ

(setvar "cmdecho" 0) (vl-load-com)

(setq
Caochu (getvar "dimtxt") Tyle 1 tphan 2
)(setvar "TEXTSIZE" CaoChu)
(setvar "qaflags" 0)
;;;;;;;
(defun SuaAtt ( ss new / sodt index entdt soapp)
(setq sodt (cond
(ss (sslength ss))
(t 0)
)
soapp 0
index 0
)
(repeat sodt
(setq entdt (ssname ss index)
index (1+ index)
)
(if
(progn
(setq entdt (entnext entdt))
(setq tt (entget entdt)
old (assoc 1 tt)
; new Caodo2
new (cons 1 (rtos new 2 2) )
tt (subst new old tt)
)
(entmod tt)
(entupd entdt))
(setq soapp (1+ soapp))
)
)
soapp
)
;
(defun MaBlCdd (name pp2 / pp2 x2 y2 e3 )
(setvar "aflags" 0)
(setq lay (getvar "clayer"))
(command "layer" "m" "3.Bl" "c" "3" "3.Bl.n" "")
(command "style" "Thuong.Bl" ".VnArial Narrow" "" "" "" "" "")
(if (not (tblsearch "block" name ))
(progn
(command "osnap" "none")
(setq BlCdd (ssadd))
(setq p3 (polar pp2 0 1))
(setq p2 (polar pp2 0 (* 1 0.5)))
(setq p31 (polar p3 0 (* 1 2)))
(setq p4 (polar p2 (/ pi 2) (* 1 0.7)))
(setq p5 (polar pp2 (/ pi 2) (* 1 0.7)))
(setq p6 (polar p5 0 1))
(setq p7 (polar pp2 (/ pi 2) 1))
(setq p8 (polar p31 (/ pi 2) 1))
(setq p9 (polar p7 (/ pi 2) (* 1 0.2)))
(command "color" bylayer )
(command "line" pp2 p3 "")
(setq et (entlast))
(ssadd et BlCdd)
(command "line" p7 p8 "")
(setq et (entlast))
(ssadd et BlCdd)
(command "solid" p2 p4 p6 p2 "")
(setq et (entlast))
(ssadd et BlCdd)
(command "Pline" p2 p5 p6 p2 "")
(setq et (entlast))
(ssadd et BlCdd)
(command "attdef" "" "CD" "CaoDo" "10.00" "j" "ml" (polar pp2 (/ pi 2) (* 1.75 1)) 1 0 )
(setq et (entlast)) (ssadd et BlCdd)
(command "block" name pp2 BlCdd "")
) )
(command "setvar" "clayer" lay)
);
;;;
(defun c:x22 (/ oldos )
(vl-load-com)
(setq oldos (getvar "osmode"))
(Command "MIRRTEXT" 0 "")
(setvar "cmdecho" 0)
(COMMAND "UCS" "W" )
(command "osmode" 4791)
(setq pcdGoc (getpoint "\n moi ban Pick diem GOC, Da co cao do : "))
(setq x1 (car pcdGoc))
(setq y1 (cadr pcdGoc))
(setq Caodo1 (car (entsel "\n moi ban Chon cao do cua diem GOC : ")))
(setq Caodo1 (entget Caodo1))
(setq Caodo1 (cdr (assoc 1 Caodo1))) ;;Lay noi dung text:ma DXF=1
(setq Caodo1 (atof Caodo1))
(setq pt2 (getpoint "\n moi ban Pick diem Can tinh cao do : " pcdGoc ))
(MaBlCdd "CD.n" pt2 )
(setq BlCdd1 (ssadd))
(While (/= pt2 nil)
(progn ; PRO 1
(setq x2 (car pt2))
(setq y2 (cadr pt2))
(setq Caodo2 (+ Caodo1 (- (/ y2 Tyle ) (/ y1 Tyle )))) ; Caodo2 thoa man de thay vao block att
(setq BlCdd1 (ssadd))
(command "insert" "CD.n" "R" 0 pt2 Caochu Caochu (strcat ""(rtos Caodo2 2 tphan)) )(setq et1 (entlast))
; (setq obn (vlax-ename->vla-object et1 )
; Caodo2 (strcat ; gan Caodo2 chua thoa man de dua vao block att
; "%<\\AcObjProp Object(%<\\_ObjId "
; (rtos (vla-get-objectid obn) 2 0)">%).InsertionPoint \\f \"%lu2" "%pt2"
; "%pr" (rtos tphan 2 0) "%ct8[" (rtos Tyle 2 0) "]" "\">%"
; ))
(ssadd et1 BlCdd1)
(setq ss (ssget "L" '((0 . "INSERT") (66 . 1))))
(SuaAtt ss Caodo2 )(setq et1 (entlast))
(command "osmode" 4791)
(setq pt2 (getpoint "\n moi ban Pick diem Can tinh cao do : " pcdGoc ))

)))

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

Gợi ý:

*** Tìm trên diễn đàn:

1. Hàm để lấy ObjectID (phục vụ việc lấy ID của block vừa tạo ra => gắn vào Field sau này).

2. Hàm gán Value cho tagname

*** VD: (SetTagVal obj "CD" (strcat "%<\\AcObjProp Object(%<\\_ObjId " (GetObjectID obj)">%).InsertionPoint \\f \"%lu6%pt2\">%"))

  • Vote tăng 1

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

Gợi ý:

*** Tìm trên diễn đàn:

1. Hàm để lấy ObjectID (phục vụ việc lấy ID của block vừa tạo ra => gắn vào Field sau này).

2. Hàm gán Value cho tagname

*** VD: (SetTagVal obj "CD" (strcat "%<\\AcObjProp Object(%<\\_ObjId " (GetObjectID obj)">%).InsertionPoint \\f \"%lu6%pt2\">%"))

SetTagVal em chưa hiểu hàm  này cho lắm

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

SetTagVal em chưa hiểu hàm  này cho lắm

Không phải hàm có sẵn mà do lisper viết. Ví dụ: (settagval obj "CD" "value").

Trong đó: settagval là hàm, obj là block, "CD" là tagname, "value" là giá trị của tag có tên là CD.

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ìm giúp bạn đây (hàm của Lee Mac):

;;; Set Attribute Value  -  Lee Mac
;; Sets the value of the first attribute with the given tag found within the block, if present.
;; blk - [vla] VLA Block Reference Object
;; tag - [str] Attribute TagString
;; val - [str] Attribute Value
;; Returns: [str] Attribute value if successful, else nil.

(defun LM:vl-setattributevalue  (blk tag val)
  (setq tag (strcase tag))
  (vl-some '(lambda (att)
              (if (= tag (strcase (vla-get-tagstring att)))
                (progn (vla-put-textstring att val) val)))
           (vlax-invoke blk 'getattributes)))

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ìm giúp bạn đây (hàm của Lee Mac):

;;; Set Attribute Value  -  Lee Mac

;; Sets the value of the first attribute with the given tag found within the block, if present.

;; blk - [vla] VLA Block Reference Object

;; tag - [str] Attribute TagString

;; val - [str] Attribute Value

;; Returns: [str] Attribute value if successful, else nil.

(defun LM:vl-setattributevalue  (blk tag val)

  (setq tag (strcase tag))

  (vl-some '(lambda (att)

              (if (= tag (strcase (vla-get-tagstring att)))

                (progn (vla-put-textstring att val) val)))

           (vlax-invoke blk 'getattributes)))

Cám ơn bác. Lisp cơ bản ok nhưng không được ưng ý lắm :((

 

32412829240_0ebc3f4ed0_o.gif

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
lisp sửa chạy dc trên cad 64 bit

mình thử thấy chạy được mỗi lệnh LL là cho ra kết quả nhưng cũng ko link được (sửa line thì text vẫn nguyên)

còn các lisp khác thì chọn đối tượng xong xuất kết quả bị lỗi ####

command cũng ko có báo lỗi gì cả

mình dùng cad 2008

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

Đây là một lisp hay, nhưng mình thấy còn vướng hai vấn đề :

1/ Khi thực hiện hoàn tất một lệnh nào đó, Nếu ta block đối tượng nguồn thì các đối tượng kia sẽ bị lỗi.

2/ Khi chúng ta chọn đối tượng thì đối tượng bị chọn không mờ đi, để dễ nhận biết là đã chọn đối tượng rồi.

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

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay


×