[ Nhờ chỉnh sửa ] Lisp link chiều dài đối tượng đến text

Tháng 11 20, 2012

Em muốn nhờ các bác sửa giùm lisp "LL" _ link chiều dài đối tượng đến text.

Yêu cầu:

1. Sau khi chọn đối tượng cần tính chiều dài thì hiện thông báo hỏi: "Nhập số cần cộng thêm" để mình nhập vào, Sau đó chọn text đích. text đích sẽ hiển thị kết quả là chiều dài của đối tượng + số đã nhập.

Khi chiều dài đối tượng thay đổi, text đích thay đổi theo.

2. (yêu cầu thêm, không liên quan đến yêu cầu 1, bác nào giúp em được thì tốt) Lisp này chỉ link chiều dài 1 đối tượng được chọn chứ không thể chọn nhiều đối tượng để tính tổng chiều dài, các bác cho em hỏi có thể link tổng chiều dài các đối tượng đã chọn đến text được không, khi 1 đối tượng thay đổi thì tất nhiên tổng chiều dài thay đổi và text cũng tự thay đổi theo.

Cảm ơn các bác nhiều

Lisp: http://www.cadviet.c...ln_lh_l_lmh.lsp

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=40442&pid=76557&st=0entry76557
;;;====================================================================


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

Tháng 8 10, 2015

Bài viết này từ 2012 rồi nhưng ko thấy chủ thớt theo nhỉ.

Trong bài này chủ thớt có yêu cầu thứ 2 là link tổng chiều dài pline, line, arc đến text.

"các bác cho em hỏi có thể link tổng chiều dài các đối tượng đã chọn đến text được không, khi 1 đối tượng thay đổi thì tất nhiên tổng chiều dài thay đổi và text cũng tự thay đổi theo."????

Mong các bác giúp chỉnh sửa theo yêu cầu này ah!

Tháng 9 28, 2019

Em đang cần link chiều dài các đối tượng ra text. Các anh giúp em với

Đăng nhập

[ Nhờ chỉnh sửa ] Lisp link chiều dài đối tượng đến text

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

dothanhdatvtchd 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

bach1212 4

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

CuongXD7 3

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

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

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

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

Tạo tài khoản

Đăng nhập

Diễn đàn

Download

Đào tạo CADViet

Browse