Đến nội dung


Hình ảnh
* * * - - 2 Bình chọn

Viết Lisp theo yêu cầu


  • Chủ đề bị khóa Chủ đề bị khóa
2780 replies to this topic

#2441 ngaxd050

ngaxd050

    Chưa sử dụng CAD

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

Đã gửi 18 July 2009 - 09:34 AM

cho em hoi với các bác ơi,down sxtext.lsp,rồi chép vào đâu để sử dụng vậy. em đọc trên diễn đàn thấy hay, nhưng em con wá kém coi nên chịu,từ trước tới zờ toàn được ngưòi khác cài zùm cho xài,nên máy cài này em dốt đặc.
  • 0

#2442 xuandao0708

xuandao0708

    biết lệnh scale

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

Đã gửi 18 July 2009 - 10:51 AM

Chào bạn Kid112 mình đã có nhờ bác q288 sữa lại 1 lisp cũng giống yêu cầu như bạn
Nếu bạn chưa hiểu thì có thể coi từ trang 111
Hy vọng lisp này sẽ giải quyết được vấn đề của bạn đưa ra.
Tên lệnh : ghitd1
Yêu cầu: 1: nhập chiều cao chữ
2: chữ số thập phân ( dùng để định là cm hay mm)
3: bán kính vòng tròn ( dùng để tô đỉnh thửa)
4: có lưu file hay không ( file được save dạng .txt ngay tại thư mục của bản vẽ)
codebox
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Chuong trinh danh so va lap bang toa do ho so thua dat dia chinh
;;;Bang toa do tao thanh block, duoc dat ten theo so thu tu 1, 2, 3...
;;;Chap nhan cac doi tuong la Region, Polyline, Line va Arc khep kin
;;;Written by ssg and elleHCSC - January 2009 - www.cadviet.com
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;PUBLIC FUNCTIONS
;;;-------------------------------------------------------------------------------
(Defun DTR (x) (/ (* x pi) 180))
;;;change degree to radian, return REAL
;;;-------------------------------------------------------------------------------
(defun lineP (p0 a r / p1)
;;;Line polar: point, degree angle, radius
(setq p1 (polar p0 (dtr a) r))
(command "line" p0 p1 "")
)
;;;-------------------------------------------------------------------------------
(defun linePX (p0 x) (lineP p0 0 x))
;;;Horizontal line: length x, from p0
;;;-------------------------------------------------------------------------------
(defun linePY (p0 y) (lineP p0 90 y))
;;;Vertical line: length y, from p0
;;;-------------------------------------------------------------------------------
(defun getVert (e / i L)
;;;Return list of all vertex from pline e
(setq i 0
L nil
)
(vl-load-com)
(repeat (fix (+ (vlax-curve-getEndParam e) 1))
(setq L (append L (list (vlax-curve-getPointAtParam e i))))
(setq i (1+ i))
)
L
)

;;; First point of List rearrangement
(defun relist(pt0 Lst / i rt)
(setq i 0)
(foreach pt Lst
(if (equal pt0 pt 0.001)
(setq rt i))
(setq i (1+ i)))
(append (append (member (nth rt Lst) Lst)
(cdr (reverse (cdr (member (nth rt Lst) (reverse Lst))))))
(list (nth rt Lst)))
)

;;;New Layer
(defun newlayer(a b c d)
(if (not (tblsearch "layer" a))
(command "-layer" "n" a "c" b a "l" c a "lw" d a ""))
)
;;;-------------------------------------------------------------------------------
(defun wtxtMC (txt p h k)
;;;Write text Middle Center, specify text, point, height
(entmake (list (cons 0 "TEXT")
(cons 7 (getvar "textstyle"))
(cons 1 txt)
(cons 10 p)
(cons 11 p)
(cons 40 h)
(cons 72 1)
(cons 73 2)
(if k (cons 51 (DTR 18)) (cons 51 0))
)
)
)
;;;-------------------------------------------------------------------------------
(defun Collect (e / e2 SS)
;;;Selection set from e to entlast
(setq SS (ssadd))
(ssadd e SS)
(while (setq e2 (entnext e)) (ssadd e2 SS) (setq e e2))
SS
)
;;;-------------------------------------------------------------------------------
(defun Collect1 (e / ss)
;;;Selection set after e to entlast. If e nil, select all from fist entity of drawing.
(if (= e nil)
(setq ss (collect (entnext)))
(progn (setq ss (collect e)) (ssdel e ss))
)
)
;;;-------------------------------------------------------------------------------

;;;PRIVATE FUNCTIONS
;;;-------------------------------------------------------------------------------
(defun txt1 (txtL / p1 p2 p3 p4 pL i)
;;;Write texts in 1 row
(setq
p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))
p2 (polar p1 0 (* 7 h))
p3 (polar p2 0 (* 10 h))
p4 (polar p3 0 (* 9 h))
pL (list p1 p2 p3 p4)
i 0
)
(repeat 4
(wtxtMC (nth i txtL) (nth i pL) h t)
(setq i (1+ i))
)
)
;;;-------------------------------------------------------------------------------
(defun txt2 (txtL / p1 p2 p3 p4 pL i)
;;;Write texts in 1 row
(setq
p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))
p2 (polar p1 0 (* 7 h))
p3 (polar p2 0 (* 10 h))
p4 (polar p3 0 (* 9 h))
p4 (polar p4 (* 0.5 pi) h)
pL (list p1 p2 p3 p4)
i 0
)
(repeat 4
(wtxtMC (nth i txtL) (nth i pL) h t)
(setq i (1+ i))
)
)
;;;-------------------------------------------------------------------------------


;;;MAIN PROGRAM
;;;-------------------------------------------------------------------------------
(defun C:ghitd1 (/ h p et p0 p00 p01 p02 pt pvL n j pv num txtL ss bn ntp)
(setvar "cmdecho" 0)

;;;New layer check
(newlayer "kichthuoc" 7 "continuous" "default")
(newlayer "stt" 1 "continuous" "default")
(newlayer "bangtd" 7 "continuous" "default")

;;;GET TEXT HEIGHT
(if (not h0) (setq h0 1))
(setq h (getreal (strcat "\nChon chieu cao text <" (rtos h0) ">:")))
(if (not h) (setq h h0) (setq h0 h))

;;;GET DECIMAL PRECISION
(if (not ntp0) (setq ntp0 2))
(setq ntp (getint (strcat "\nSo chu so thap phan <" (itoa ntp0) ">:")))
(if (not ntp) (setq ntp ntp0) (setq ntp0 ntp))

;;;GET CIRCLE RADIUS
(if (not cr0) (setq cr0 0.3))
(setq cr (getreal (strcat "\nNhap ban kinh vong tron <" (rtos cr0) ">:")))
(if cr (setq cr0 cr))

;;;PICK & BASE POINT
(initget "Y")
(setq save (getkword "\nBan co muon luu file? < Y / Enter for No >:"))

(setq oldos (getvar "osmode")
pdau (getpoint "\nPick diem dau tien (so thu tu = 1) :"))

(while pdau
(setq p (getpoint "\nPick 1 diem giua mien kin:")
pvL nil pvL1 nil)
(command "boundary" p "")
(setq et (entlast)
pvL1 (reverse (getvert et)))
(redraw et 3)
(setq p00 (getpoint "\nDiem dat Bang TDGR:"))
(command "erase" et "")
(setq p0 p00
p01 (polar p00 (* 1.5 pi) (* h 3))
pvL (relist pdau pvL1)
n (length pvL)
p02 (polar p01 (* 1.5 pi) (+ (* h 3) (* (1- n) h 2)))
)
(setvar "osmode" 0)
;;;HEADER
(setvar "CLAYER" "bangtd")
(linepx p0 (* 32 h))
(command "copy" "L" "" "m" p00 p01 p02 "")
(linepy p0 (- (distance p0 p02)))
(command "copy" "L" "" "m" p0
(list (+ (car p0) (* 4 h)) (cadr p0))
(list (+ (car p0) (* 14 h)) (cadr p0))
(list (+ (car p0) (* 24 h)) (cadr p0))
(list (+ (car p0) (* 32 h)) (cadr p0))
"")
(setq Lkqua nil)
(wtxtMC "BAÛNG TOÏA ÑOÄ GOÙC RANH"
(polar (polar p0 0 (* 16 h)) (* 0.5 pi) (* 2 h))
(* 1.2 h) nil)
(txt1 (setq Lkq (list "TT" "X (m)" "Y (m)" "S (m)")))
(setq Lkqua (append Lkqua (list Lkq)))
(setq p0 (polar p0 (* 1.5 pi) (* 3 h)))

;;;MAKE RECORDS
(setq j 0
pt nil)
(repeat n
(setq
pv (nth j pvL)
num (itoa (1+ j))
)
(if pt
(setq S (rtos (distance pt pv) 2 ntp))
(setq S "")
)
(setq
txtL (list num (rtos (car pv) 2 ntp) (rtos (cadr pv) 2 ntp) S)
Lkqua (append Lkqua (list txtL))
)
(txt2 txtL)
(setq p0 (polar p0 (* 1.5 pi) (* 2 h)))
(setq pt pv)
(setq j (1+ j))
(if (= j (- n 1)) (setq j 0))
)

;;;MAKE BLOCK
(setq ss (collect1 et))
(setq bn "1")
(while (tblsearch "block" bn)
(setq bn (itoa (1+ (atoi bn))))
)
(command "block" bn p00 ss "")
(command "insert" bn p00 "" "" "")

;;;WRITE POINT NAME
(setvar "CLAYER" "stt")
(setq j 0)
(repeat (1- n)
(setq
pv (nth j pvL)
num (itoa (1+ j))
)
(wtxtMC num (polar pv 0 h) h t)
(command "circle" pv cr0)
(command "hatch" "S" (setq vtron (entlast)) "")
(command "erase" vtron "")
(setq j (1+ j))
)

;;;GHI CANH THUA
(setvar "CLAYER" "kichthuoc")
(ghicanh)

;;;FINISH
(savef)
(setvar "osmode" oldos)
(setq pdau (getpoint "\nPick diem dau tien (so thu tu = 1) :"))
)
(setvar "cmdecho" 1)
(princ)
)

;;;-------------------------------------------------------------------------------
(defun savef()
(if save
(progn
(setq file (open (setq tenfile (strcat (getvar "dwgprefix")
(vl-filename-base (vl-string-right-trim "\\" (getvar "dwgname"))) ".txt")) "a"))
(foreach line Lkqua
(setq line1 "")
(foreach it line
(setq line1 (strcat line1 " " it)))
(write-line line1 file)
)
(close file)
(princ (strcat "\nDa luu thanh file " tenfile))
)
)
)

;;;PHAN BO SUNG CUA elleHCSC
;;;------------------------------------------------------------------------------------
(defun Text_canh_TCA (S p a)
;;;Entmake text S at p with angle A - Top Center
(if (/= p nil)
(entmake (list
(cons 0 "TEXT")
(cons 62 5)
(cons 10 p)
(cons 40 h)
(cons 1 S)
(cons 50 a)
(cons 41 0.7)
(cons 7 (getvar "textstyle"))
(cons 72 1)
(cons 11 p)
(cons 73 3)
)
)
)
)
;;;------------------------------------------------------------------------------------
(defun Text_canh_BCA (S p a)
;;;Entmake text S at p with angle A - Bottom Center
(if (/= p nil)
(entmake (list
(cons 0 "TEXT")
(cons 62 5)
(cons 10 p)
(cons 40 h)
(cons 1 S)
(cons 50 a)
(cons 41 0.7)
(cons 7 (getvar "textstyle"))
(cons 72 1)
(cons 11 p)
(cons 73 1)
)
)
)
)
;;;-------------------------------------------------------------------------------
(defun Ghicanh (/ i k p1 p2 dist rad x_mp y_mp mp)
(setq
i 0
k (1- (length pvL))
)
(repeat k
(setq
p1 (nth i pvL)
p2 (nth (+ i 1) pvL)
dist (distance p1 p2)
rad (angle p1 p2)
x_mp (* (+ (car p1) (car p2)) 0.5)
y_mp (* (+ (cadr p1) (cadr p2)) 0.5)
mp (list x_mp y_mp)
)
(if (and (> rad (* 0.5 pi)) (<= rad (* 1.5 pi)))
(setq mp (polar mp (+ rad (* 0.5 pi)) (* 0.3 h)))
)
(if (and (> rad (* 0.5 pi)) (<= rad (* 1.5 pi)))
(progn
(setq rad (+ rad pi))
(Text_canh_TCA (rtos dist 2 2) mp rad)
)
(Text_canh_BCA (rtos dist 2 2) mp rad)
)
(setq i (1+ i))
)
;; repeat k;
)
;;;--------------------------
/codebox
  • 1

#2443 xuandao0708

xuandao0708

    biết lệnh scale

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

Đã gửi 18 July 2009 - 10:54 AM

Chào bạn Kid112 mình đã có nhờ bác q288 sữa lại 1 lisp cũng giống yêu cầu như bạn
Nếu bạn chưa hiểu thì có thể coi từ trang 111
Hy vọng lisp này sẽ giải quyết được vấn đề của bạn đưa ra.
Tên lệnh : ghitd1
Yêu cầu: 1: nhập chiều cao chữ
2: chữ số thập phân ( dùng để định là cm hay mm)
3: bán kính vòng tròn ( dùng để tô đỉnh thửa)
4: có lưu file hay không ( file được save dạng .txt ngay tại thư mục của bản vẽ)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Chuong trinh danh so va lap bang toa do ho so thua dat dia chinh
;;;Bang toa do tao thanh block, duoc dat ten theo so thu tu 1, 2, 3...
;;;Chap nhan cac doi tuong la Region, Polyline, Line va Arc khep kin
;;;Written by ssg and elleHCSC - January 2009 - www.cadviet.com
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;PUBLIC FUNCTIONS
;;;-------------------------------------------------------------------------------
(Defun DTR (x) (/ (* x pi) 180))
;;;change degree to radian, return REAL
;;;-------------------------------------------------------------------------------
(defun lineP (p0 a r / p1)
;;;Line polar: point, degree angle, radius
(setq p1 (polar p0 (dtr a) r))
(command "line" p0 p1 "")
)
;;;-------------------------------------------------------------------------------
(defun linePX (p0 x) (lineP p0 0 x))
;;;Horizontal line: length x, from p0
;;;-------------------------------------------------------------------------------
(defun linePY (p0 y) (lineP p0 90 y))
;;;Vertical line: length y, from p0
;;;-------------------------------------------------------------------------------
(defun getVert (e / i L)
;;;Return list of all vertex from pline e
(setq i 0
L nil
)
(vl-load-com)
(repeat (fix (+ (vlax-curve-getEndParam e) 1))
(setq L (append L (list (vlax-curve-getPointAtParam e i))))
(setq i (1+ i))
)
L
)

;;; First point of List rearrangement
(defun relist(pt0 Lst / i rt)
(setq i 0)
(foreach pt Lst
(if (equal pt0 pt 0.001)
(setq rt i))
(setq i (1+ i)))
(append (append (member (nth rt Lst) Lst)
(cdr (reverse (cdr (member (nth rt Lst) (reverse Lst))))))
(list (nth rt Lst)))
)

;;;New Layer
(defun newlayer(a b c d)
(if (not (tblsearch "layer" a))
(command "-layer" "n" a "c" b a "l" c a "lw" d a ""))
)
;;;-------------------------------------------------------------------------------
(defun wtxtMC (txt p h k)
;;;Write text Middle Center, specify text, point, height
(entmake (list (cons 0 "TEXT")
(cons 7 (getvar "textstyle"))
(cons 1 txt)
(cons 10 p)
(cons 11 p)
(cons 40 h)
(cons 72 1)
(cons 73 2)
(if k (cons 51 (DTR 18)) (cons 51 0))
)
)
)
;;;-------------------------------------------------------------------------------
(defun Collect (e / e2 SS)
;;;Selection set from e to entlast
(setq SS (ssadd))
(ssadd e SS)
(while (setq e2 (entnext e)) (ssadd e2 SS) (setq e e2))
SS
)
;;;-------------------------------------------------------------------------------
(defun Collect1 (e / ss)
;;;Selection set after e to entlast. If e nil, select all from fist entity of drawing.
(if (= e nil)
(setq ss (collect (entnext)))
(progn (setq ss (collect e)) (ssdel e ss))
)
)
;;;-------------------------------------------------------------------------------

;;;PRIVATE FUNCTIONS
;;;-------------------------------------------------------------------------------
(defun txt1 (txtL / p1 p2 p3 p4 pL i)
;;;Write texts in 1 row
(setq
p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))
p2 (polar p1 0 (* 7 h))
p3 (polar p2 0 (* 10 h))
p4 (polar p3 0 (* 9 h))
pL (list p1 p2 p3 p4)
i 0
)
(repeat 4
(wtxtMC (nth i txtL) (nth i pL) h t)
(setq i (1+ i))
)
)
;;;-------------------------------------------------------------------------------
(defun txt2 (txtL / p1 p2 p3 p4 pL i)
;;;Write texts in 1 row
(setq
p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))
p2 (polar p1 0 (* 7 h))
p3 (polar p2 0 (* 10 h))
p4 (polar p3 0 (* 9 h))
p4 (polar p4 (* 0.5 pi) h)
pL (list p1 p2 p3 p4)
i 0
)
(repeat 4
(wtxtMC (nth i txtL) (nth i pL) h t)
(setq i (1+ i))
)
)
;;;-------------------------------------------------------------------------------


;;;MAIN PROGRAM
;;;-------------------------------------------------------------------------------
(defun C:ghitd1 (/ h p et p0 p00 p01 p02 pt pvL n j pv num txtL ss bn ntp)
(setvar "cmdecho" 0)

;;;New layer check
(newlayer "kichthuoc" 7 "continuous" "default")
(newlayer "stt" 1 "continuous" "default")
(newlayer "bangtd" 7 "continuous" "default")

;;;GET TEXT HEIGHT
(if (not h0) (setq h0 1))
(setq h (getreal (strcat "\nChon chieu cao text <" (rtos h0) ">:")))
(if (not h) (setq h h0) (setq h0 h))

;;;GET DECIMAL PRECISION
(if (not ntp0) (setq ntp0 2))
(setq ntp (getint (strcat "\nSo chu so thap phan <" (itoa ntp0) ">:")))
(if (not ntp) (setq ntp ntp0) (setq ntp0 ntp))

;;;GET CIRCLE RADIUS
(if (not cr0) (setq cr0 0.3))
(setq cr (getreal (strcat "\nNhap ban kinh vong tron <" (rtos cr0) ">:")))
(if cr (setq cr0 cr))

;;;PICK & BASE POINT
(initget "Y")
(setq save (getkword "\nBan co muon luu file? < Y / Enter for No >:"))

(setq oldos (getvar "osmode")
pdau (getpoint "\nPick diem dau tien (so thu tu = 1) :"))

(while pdau
(setq p (getpoint "\nPick 1 diem giua mien kin:")
pvL nil pvL1 nil)
(command "boundary" p "")
(setq et (entlast)
pvL1 (reverse (getvert et)))
(redraw et 3)
(setq p00 (getpoint "\nDiem dat Bang TDGR:"))
(command "erase" et "")
(setq p0 p00
p01 (polar p00 (* 1.5 pi) (* h 3))
pvL (relist pdau pvL1)
n (length pvL)
p02 (polar p01 (* 1.5 pi) (+ (* h 3) (* (1- n) h 2)))
)
(setvar "osmode" 0)
;;;HEADER
(setvar "CLAYER" "bangtd")
(linepx p0 (* 32 h))
(command "copy" "L" "" "m" p00 p01 p02 "")
(linepy p0 (- (distance p0 p02)))
(command "copy" "L" "" "m" p0
(list (+ (car p0) (* 4 h)) (cadr p0))
(list (+ (car p0) (* 14 h)) (cadr p0))
(list (+ (car p0) (* 24 h)) (cadr p0))
(list (+ (car p0) (* 32 h)) (cadr p0))
"")
(setq Lkqua nil)
(wtxtMC "BAÛNG TOÏA ÑOÄ GOÙC RANH"
(polar (polar p0 0 (* 16 h)) (* 0.5 pi) (* 2 h))
(* 1.2 h) nil)
(txt1 (setq Lkq (list "TT" "X (m)" "Y (m)" "S (m)")))
(setq Lkqua (append Lkqua (list Lkq)))
(setq p0 (polar p0 (* 1.5 pi) (* 3 h)))

;;;MAKE RECORDS
(setq j 0
pt nil)
(repeat n
(setq
pv (nth j pvL)
num (itoa (1+ j))
)
(if pt
(setq S (rtos (distance pt pv) 2 ntp))
(setq S "")
)
(setq
txtL (list num (rtos (car pv) 2 ntp) (rtos (cadr pv) 2 ntp) S)
Lkqua (append Lkqua (list txtL))
)
(txt2 txtL)
(setq p0 (polar p0 (* 1.5 pi) (* 2 h)))
(setq pt pv)
(setq j (1+ j))
(if (= j (- n 1)) (setq j 0))
)

;;;MAKE BLOCK
(setq ss (collect1 et))
(setq bn "1")
(while (tblsearch "block" bn)
(setq bn (itoa (1+ (atoi bn))))
)
(command "block" bn p00 ss "")
(command "insert" bn p00 "" "" "")

;;;WRITE POINT NAME
(setvar "CLAYER" "stt")
(setq j 0)
(repeat (1- n)
(setq
pv (nth j pvL)
num (itoa (1+ j))
)
(wtxtMC num (polar pv 0 h) h t)
(command "circle" pv cr0)
(command "hatch" "S" (setq vtron (entlast)) "")
(command "erase" vtron "")
(setq j (1+ j))
)

;;;GHI CANH THUA
(setvar "CLAYER" "kichthuoc")
(ghicanh)

;;;FINISH
(savef)
(setvar "osmode" oldos)
(setq pdau (getpoint "\nPick diem dau tien (so thu tu = 1) :"))
)
(setvar "cmdecho" 1)
(princ)
)

;;;-------------------------------------------------------------------------------
(defun savef()
(if save
(progn
(setq file (open (setq tenfile (strcat (getvar "dwgprefix")
(vl-filename-base (vl-string-right-trim "\\" (getvar "dwgname"))) ".txt")) "a"))
(foreach line Lkqua
(setq line1 "")
(foreach it line
(setq line1 (strcat line1 " " it)))
(write-line line1 file)
)
(close file)
(princ (strcat "\nDa luu thanh file " tenfile))
)
)
)

;;;PHAN BO SUNG CUA elleHCSC
;;;------------------------------------------------------------------------------------
(defun Text_canh_TCA (S p a)
;;;Entmake text S at p with angle A - Top Center
(if (/= p nil)
(entmake (list
(cons 0 "TEXT")
(cons 62 5)
(cons 10 p)
(cons 40 h)
(cons 1 S)
(cons 50 a)
(cons 41 0.7)
(cons 7 (getvar "textstyle"))
(cons 72 1)
(cons 11 p)
(cons 73 3)
)
)
)
)
;;;------------------------------------------------------------------------------------
(defun Text_canh_BCA (S p a)
;;;Entmake text S at p with angle A - Bottom Center
(if (/= p nil)
(entmake (list
(cons 0 "TEXT")
(cons 62 5)
(cons 10 p)
(cons 40 h)
(cons 1 S)
(cons 50 a)
(cons 41 0.7)
(cons 7 (getvar "textstyle"))
(cons 72 1)
(cons 11 p)
(cons 73 1)
)
)
)
)
;;;-------------------------------------------------------------------------------
(defun Ghicanh (/ i k p1 p2 dist rad x_mp y_mp mp)
(setq
i 0
k (1- (length pvL))
)
(repeat k
(setq
p1 (nth i pvL)
p2 (nth (+ i 1) pvL)
dist (distance p1 p2)
rad (angle p1 p2)
x_mp (* (+ (car p1) (car p2)) 0.5)
y_mp (* (+ (cadr p1) (cadr p2)) 0.5)
mp (list x_mp y_mp)
)
(if (and (> rad (* 0.5 pi)) (<= rad (* 1.5 pi)))
(setq mp (polar mp (+ rad (* 0.5 pi)) (* 0.3 h)))
)
(if (and (> rad (* 0.5 pi)) (<= rad (* 1.5 pi)))
(progn
(setq rad (+ rad pi))
(Text_canh_TCA (rtos dist 2 2) mp rad)
)
(Text_canh_BCA (rtos dist 2 2) mp rad)
)
(setq i (1+ i))
)
;; repeat k;
)
;;;--------------------------

  • 1

#2444 xuandao0708

xuandao0708

    biết lệnh scale

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

Đã gửi 18 July 2009 - 11:23 AM

Nhờ các Bác viết dùng em 1 lisp dùng để chạy kích thước và ghi text khoảng cách song song và nằm giữa với đường line hoặc pline được chọn. Lisp sẽ tạo layer kthuoc nếu bản vẽ chưa có layer kthuoc.
1: nhập tỷ lệ bản vẽ ( do em làm bên trắc địa nên tỷ lệ bản vẽ thường là 1/200 = tỷ lệ 5/2, 1/500 = tỷ lệ 1/1, 1/1000 = 5/10)
2: có vẽ mũi tên hay không(c/k)
3: chọn các đối tượng cần ghi kích thước.
Dưới đây là file mẫu em thể hiện ở 2 tỷ lệ 1/500 và 1/200
http://www.cadviet.c...files/mau_7.dwg
Thank các Bác nhiều.
  • 0

#2445 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6007 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 18 July 2009 - 11:35 AM

cho em hoi với các bác ơi,down sxtext.lsp,rồi chép vào đâu để sử dụng vậy. em đọc trên diễn đàn thấy hay, nhưng em con wá kém coi nên chịu,từ trước tới zờ toàn được ngưòi khác cài zùm cho xài,nên máy cài này em dốt đặc.

Chào bạn ngaxd050,
Để sử dụng được các lisp có trên diễn đàn này hay bất kỳ diễn đàn nào khác, bạn chỉ cần thực hiện như sau:
1/- Download về máy của bạn và save nó vào một thư mục nào đó.
2/- Mở Autocad và bổ sung thêm thư mục này của bạn vào các đường dẫn tìm kiếm của Cad
3/- Load file lisp này vào cad bằng cách sử dụng lệng Load application trên menu Tool.
4/- Nhập lệnh sử dụng của file lisp. Lệnh này được viết sau lý tự C: trong dòng (defun C:***** .........

Nhìn chung để có thể hiểu và sử dụng các lisp bạn nên tìm hiểu một cách kỹ lưỡng hơn về Lisp thông qua các tài liệu và qua các topic dưới đây trên diễn đàn này.
Khi đó bạn không những có thể xài mà bạn còn có khả năng cải tạo các lisp đó theo các yêu cầu riêng của bạn. Rất mong bạn thành công.
http://www.cadviet.c...?showtopic=2480
http://www.cadviet.c...?showtopic=1787
http://www.cadviet.c...p?showtopic=371
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2446 conghoan1003

conghoan1003

    biết vẽ point

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

Đã gửi 18 July 2009 - 12:01 PM

Đây là kết quả mà Tue_NV test file của conghoan :
http://www.cadviet.c...CHITIET_1_1.dwg

Tue_NV xem hộ mình khi mình test thì nó báo như thế này, Tuê_Vn xem thử nó bị thế nào nhé. Cảm ơn nhiều.
Command: vbun
Select objects: Specify opposite corner: 3 found
Select objects:
Nhap do sau vet bun : 1
Nhap he so mai doc o diem dau :1
Nhap he so mai doc o diem cuoi :1
Nhap chieu cao chu ghi mai doc :1
So chu so thap phan :1
Chon diem dau :
Chon diem cuoi :
Cannot TRIM this object.
Cannot TRIM this object.
Chon diem dau :
Chon diem cuoi :
  • 0
Học học nữa học mãi.
Đúp học lại!

#2447 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 18 July 2009 - 12:50 PM

File đây conghoan test thử nhé. http://www.cadviet.c...files/VBUN7.vlx
Conghoan nhớ rằng Lisp sẽ hiện sáng đối tượng và bạn phải chọn điểm đầu và điểm cuối trên đối tượng hiện sáng đó nhé.


Tue_NV xem hộ mình khi mình test thì nó báo như thế này, Tuê_Vn xem thử nó bị thế nào nhé. Cảm ơn nhiều.
Command: vbun
Select objects: Specify opposite corner: 3 found
Select objects:
Nhap do sau vet bun : 1
Nhap he so mai doc o diem dau :1
Nhap he so mai doc o diem cuoi :1
Nhap chieu cao chu ghi mai doc :1
So chu so thap phan :1
Chon diem dau :
Chon diem cuoi :
Cannot TRIM this object.
Cannot TRIM this object.
Chon diem dau :
Chon diem cuoi :

Trước khi chạy Lisp -> Conghoan đánh lệnh trim -> và thiết lập như sau :
Command: trim

Select objects: Specify opposite corner: 1 found : chọn đối tượng

Select objects: Enter

Select object to trim or shift-select to extend or [Project/Edge/Undo]: e : gõ e
Enter an implied edge extension mode [Extend/No extend] : e gõ e
Select object to trim or shift-select to extend or [Project/Edge/Undo]:
-> rồi sau đó mới sử dụng lệnh VBUN
Hy vọng bạn thành công :s_dead:
-> Conghoan sử dụng giải pháp này xem sao
  • 1

#2448 kid112

kid112

    Chưa sử dụng CAD

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

Đã gửi 18 July 2009 - 05:18 PM

Chào bạn Kid112 mình đã có nhờ bác q288 sữa lại 1 lisp cũng giống yêu cầu như bạn
Nếu bạn chưa hiểu thì có thể coi từ trang 111
Hy vọng lisp này sẽ giải quyết được vấn đề của bạn đưa ra.
Tên lệnh : ghitd1
Yêu cầu: 1: nhập chiều cao chữ
2: chữ số thập phân ( dùng để định là cm hay mm)
3: bán kính vòng tròn ( dùng để tô đỉnh thửa)
4: có lưu file hay không ( file được save dạng .txt ngay tại thư mục của bản vẽ)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Chuong trinh danh so va lap bang toa do ho so thua dat dia chinh
;;;Bang toa do tao thanh block, duoc dat ten theo so thu tu 1, 2, 3...
;;;Chap nhan cac doi tuong la Region, Polyline, Line va Arc khep kin
;;;Written by ssg and elleHCSC - January 2009 - www.cadviet.com
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;PUBLIC FUNCTIONS
;;;-------------------------------------------------------------------------------
(Defun DTR (x) (/ (* x pi) 180))
;;;change degree to radian, return REAL
;;;-------------------------------------------------------------------------------
(defun lineP (p0 a r / p1)
;;;Line polar: point, degree angle, radius
(setq p1 (polar p0 (dtr a) r))
(command "line" p0 p1 "")
)
;;;-------------------------------------------------------------------------------
(defun linePX (p0 x) (lineP p0 0 x))
;;;Horizontal line: length x, from p0
;;;-------------------------------------------------------------------------------
(defun linePY (p0 y) (lineP p0 90 y))
;;;Vertical line: length y, from p0
;;;-------------------------------------------------------------------------------
(defun getVert (e / i L)
;;;Return list of all vertex from pline e
(setq i 0
L nil
)
(vl-load-com)
(repeat (fix (+ (vlax-curve-getEndParam e) 1))
(setq L (append L (list (vlax-curve-getPointAtParam e i))))
(setq i (1+ i))
)
L
)

;;; First point of List rearrangement
(defun relist(pt0 Lst / i rt)
(setq i 0)
(foreach pt Lst
(if (equal pt0 pt 0.001)
(setq rt i))
(setq i (1+ i)))
(append (append (member (nth rt Lst) Lst)
(cdr (reverse (cdr (member (nth rt Lst) (reverse Lst))))))
(list (nth rt Lst)))
)

;;;New Layer
(defun newlayer(a b c d)
(if (not (tblsearch "layer" a))
(command "-layer" "n" a "c" b a "l" c a "lw" d a ""))
)
;;;-------------------------------------------------------------------------------
(defun wtxtMC (txt p h k)
;;;Write text Middle Center, specify text, point, height
(entmake (list (cons 0 "TEXT")
(cons 7 (getvar "textstyle"))
(cons 1 txt)
(cons 10 p)
(cons 11 p)
(cons 40 h)
(cons 72 1)
(cons 73 2)
(if k (cons 51 (DTR 18)) (cons 51 0))
)
)
)
;;;-------------------------------------------------------------------------------
(defun Collect (e / e2 SS)
;;;Selection set from e to entlast
(setq SS (ssadd))
(ssadd e SS)
(while (setq e2 (entnext e)) (ssadd e2 SS) (setq e e2))
SS
)
;;;-------------------------------------------------------------------------------
(defun Collect1 (e / ss)
;;;Selection set after e to entlast. If e nil, select all from fist entity of drawing.
(if (= e nil)
(setq ss (collect (entnext)))
(progn (setq ss (collect e)) (ssdel e ss))
)
)
;;;-------------------------------------------------------------------------------

;;;PRIVATE FUNCTIONS
;;;-------------------------------------------------------------------------------
(defun txt1 (txtL / p1 p2 p3 p4 pL i)
;;;Write texts in 1 row
(setq
p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))
p2 (polar p1 0 (* 7 h))
p3 (polar p2 0 (* 10 h))
p4 (polar p3 0 (* 9 h))
pL (list p1 p2 p3 p4)
i 0
)
(repeat 4
(wtxtMC (nth i txtL) (nth i pL) h t)
(setq i (1+ i))
)
)
;;;-------------------------------------------------------------------------------
(defun txt2 (txtL / p1 p2 p3 p4 pL i)
;;;Write texts in 1 row
(setq
p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))
p2 (polar p1 0 (* 7 h))
p3 (polar p2 0 (* 10 h))
p4 (polar p3 0 (* 9 h))
p4 (polar p4 (* 0.5 pi) h)
pL (list p1 p2 p3 p4)
i 0
)
(repeat 4
(wtxtMC (nth i txtL) (nth i pL) h t)
(setq i (1+ i))
)
)
;;;-------------------------------------------------------------------------------
;;;MAIN PROGRAM
;;;-------------------------------------------------------------------------------
(defun C:ghitd1 (/ h p et p0 p00 p01 p02 pt pvL n j pv num txtL ss bn ntp)
(setvar "cmdecho" 0)

;;;New layer check
(newlayer "kichthuoc" 7 "continuous" "default")
(newlayer "stt" 1 "continuous" "default")
(newlayer "bangtd" 7 "continuous" "default")

;;;GET TEXT HEIGHT
(if (not h0) (setq h0 1))
(setq h (getreal (strcat "\nChon chieu cao text <" (rtos h0) ">:")))
(if (not h) (setq h h0) (setq h0 h))

;;;GET DECIMAL PRECISION
(if (not ntp0) (setq ntp0 2))
(setq ntp (getint (strcat "\nSo chu so thap phan <" (itoa ntp0) ">:")))
(if (not ntp) (setq ntp ntp0) (setq ntp0 ntp))

;;;GET CIRCLE RADIUS
(if (not cr0) (setq cr0 0.3))
(setq cr (getreal (strcat "\nNhap ban kinh vong tron <" (rtos cr0) ">:")))
(if cr (setq cr0 cr))

;;;PICK & BASE POINT
(initget "Y")
(setq save (getkword "\nBan co muon luu file? < Y / Enter for No >:"))

(setq oldos (getvar "osmode")
pdau (getpoint "\nPick diem dau tien (so thu tu = 1) :"))

(while pdau
(setq p (getpoint "\nPick 1 diem giua mien kin:")
pvL nil pvL1 nil)
(command "boundary" p "")
(setq et (entlast)
pvL1 (reverse (getvert et)))
(redraw et 3)
(setq p00 (getpoint "\nDiem dat Bang TDGR:"))
(command "erase" et "")
(setq p0 p00
p01 (polar p00 (* 1.5 pi) (* h 3))
pvL (relist pdau pvL1)
n (length pvL)
p02 (polar p01 (* 1.5 pi) (+ (* h 3) (* (1- n) h 2)))
)
(setvar "osmode" 0)
;;;HEADER
(setvar "CLAYER" "bangtd")
(linepx p0 (* 32 h))
(command "copy" "L" "" "m" p00 p01 p02 "")
(linepy p0 (- (distance p0 p02)))
(command "copy" "L" "" "m" p0
(list (+ (car p0) (* 4 h)) (cadr p0))
(list (+ (car p0) (* 14 h)) (cadr p0))
(list (+ (car p0) (* 24 h)) (cadr p0))
(list (+ (car p0) (* 32 h)) (cadr p0))
"")
(setq Lkqua nil)
(wtxtMC "BAÛNG TOÏA ÑOÄ GOÙC RANH"
(polar (polar p0 0 (* 16 h)) (* 0.5 pi) (* 2 h))
(* 1.2 h) nil)
(txt1 (setq Lkq (list "TT" "X (m)" "Y (m)" "S (m)")))
(setq Lkqua (append Lkqua (list Lkq)))
(setq p0 (polar p0 (* 1.5 pi) (* 3 h)))

;;;MAKE RECORDS
(setq j 0
pt nil)
(repeat n
(setq
pv (nth j pvL)
num (itoa (1+ j))
)
(if pt
(setq S (rtos (distance pt pv) 2 ntp))
(setq S "")
)
(setq
txtL (list num (rtos (car pv) 2 ntp) (rtos (cadr pv) 2 ntp) S)
Lkqua (append Lkqua (list txtL))
)
(txt2 txtL)
(setq p0 (polar p0 (* 1.5 pi) (* 2 h)))
(setq pt pv)
(setq j (1+ j))
(if (= j (- n 1)) (setq j 0))
)

;;;MAKE BLOCK
(setq ss (collect1 et))
(setq bn "1")
(while (tblsearch "block" bn)
(setq bn (itoa (1+ (atoi bn))))
)
(command "block" bn p00 ss "")
(command "insert" bn p00 "" "" "")

;;;WRITE POINT NAME
(setvar "CLAYER" "stt")
(setq j 0)
(repeat (1- n)
(setq
pv (nth j pvL)
num (itoa (1+ j))
)
(wtxtMC num (polar pv 0 h) h t)
(command "circle" pv cr0)
(command "hatch" "S" (setq vtron (entlast)) "")
(command "erase" vtron "")
(setq j (1+ j))
)

;;;GHI CANH THUA
(setvar "CLAYER" "kichthuoc")
(ghicanh)

;;;FINISH
(savef)
(setvar "osmode" oldos)
(setq pdau (getpoint "\nPick diem dau tien (so thu tu = 1) :"))
)
(setvar "cmdecho" 1)
(princ)
)

;;;-------------------------------------------------------------------------------
(defun savef()
(if save
(progn
(setq file (open (setq tenfile (strcat (getvar "dwgprefix")
(vl-filename-base (vl-string-right-trim "\\" (getvar "dwgname"))) ".txt")) "a"))
(foreach line Lkqua
(setq line1 "")
(foreach it line
(setq line1 (strcat line1 " " it)))
(write-line line1 file)
)
(close file)
(princ (strcat "\nDa luu thanh file " tenfile))
)
)
)

;;;PHAN BO SUNG CUA elleHCSC
;;;------------------------------------------------------------------------------------
(defun Text_canh_TCA (S p a)
;;;Entmake text S at p with angle A - Top Center
(if (/= p nil)
(entmake (list
(cons 0 "TEXT")
(cons 62 5)
(cons 10 p)
(cons 40 h)
(cons 1 S)
(cons 50 a)
(cons 41 0.7)
(cons 7 (getvar "textstyle"))
(cons 72 1)
(cons 11 p)
(cons 73 3)
)
)
)
)
;;;------------------------------------------------------------------------------------
(defun Text_canh_BCA (S p a)
;;;Entmake text S at p with angle A - Bottom Center
(if (/= p nil)
(entmake (list
(cons 0 "TEXT")
(cons 62 5)
(cons 10 p)
(cons 40 h)
(cons 1 S)
(cons 50 a)
(cons 41 0.7)
(cons 7 (getvar "textstyle"))
(cons 72 1)
(cons 11 p)
(cons 73 1)
)
)
)
)
;;;-------------------------------------------------------------------------------
(defun Ghicanh (/ i k p1 p2 dist rad x_mp y_mp mp)
(setq
i 0
k (1- (length pvL))
)
(repeat k
(setq
p1 (nth i pvL)
p2 (nth (+ i 1) pvL)
dist (distance p1 p2)
rad (angle p1 p2)
x_mp (* (+ (car p1) (car p2)) 0.5)
y_mp (* (+ (cadr p1) (cadr p2)) 0.5)
mp (list x_mp y_mp)
)
(if (and (> rad (* 0.5 pi)) (<= rad (* 1.5 pi)))
(setq mp (polar mp (+ rad (* 0.5 pi)) (* 0.3 h)))
)
(if (and (> rad (* 0.5 pi)) (<= rad (* 1.5 pi)))
(progn
(setq rad (+ rad pi))
(Text_canh_TCA (rtos dist 2 2) mp rad)
)
(Text_canh_BCA (rtos dist 2 2) mp rad)
)
(setq i (1+ i))
)
;; repeat k;
)
;;;--------------------------


Chân thành cảm ơn anh.

Em có thêm 1 vấn đề phát sinh là mình muốn xuất các toạ độ đó qua Excel thì phải edit chỗ nào đây ạ?
  • 0

#2449 kimlongbattu9999

kimlongbattu9999

    Chưa sử dụng CAD

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

Đã gửi 18 July 2009 - 06:30 PM

Xin chào tất cả anh em trên diễn đàn, mình thấy khi chú thích kích thước hình chiếu trục đo, chúng ta thường dùng lệnh dimension aligned, sau đó dùng lệnh DED để hiệu chỉnh, vậy có cách nào kết hợp hai lệnh thành 1 không? Mong anh em góp ý và giúp đỡ dùm. Thank you anh em trước....
  • 0

#2450 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 18 July 2009 - 07:03 PM

Chân thành cảm ơn anh.

Em có thêm 1 vấn đề phát sinh là mình muốn xuất các toạ độ đó qua Excel thì phải edit chỗ nào đây ạ?

Chào Kid112
Trong Excel có chức năng tách cột -> Data -> Text to Columns
Bạn copy nội dung file .txt sang Excel -> và thực hiện tách cột trong Excel
Bạn kid112 xuandao hãy cho ví dụ minh hoạ một file txt nào đó đi để Tue_NV chỉ cho cách tách cột nhé

Xin chào tất cả anh em trên diễn đàn, mình thấy khi chú thích kích thước hình chiếu trục đo, chúng ta thường dùng lệnh dimension aligned, sau đó dùng lệnh DED để hiệu chỉnh, vậy có cách nào kết hợp hai lệnh thành 1 không? Mong anh em góp ý và giúp đỡ dùm. Thank you anh em trước....

Bạn muốn kết hợp hai lệnh thành 1 như thế nào?? Hiệu chỉnh về cái gì ????
Bạn phải nói rõ ra thì mọi người mới có thể giúp bạn được
Cần thiết thì bạn upload file minh hoạ của bạn và nói rõ

Chào bạn. Chúc vui vẻ :s_dead:
  • 2

#2451 svba1608

svba1608

    Tưởng Thị Tú Khuyên

  • Moderator
  • PipPipPipPipPipPipPip
  • 601 Bài viết
Điểm đánh giá: 620 (tốt)

Đã gửi 18 July 2009 - 09:28 PM

Em có 1 file có rất nhiều text trùng lên nhau, làm bản vẽ nặng lên. Xin nhờ mọi người và anh Tue_NV viết hộ 1 lisp xóa các text trùng lên nhau (cách thức như dùng lệnh overkill vậy). Thanks!
  • 0
http://khuyen.space

#2452 haanh

haanh

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 2875 Bài viết
Điểm đánh giá: 1554 (rất tốt)

Đã gửi 18 July 2009 - 09:45 PM

Em có 1 file có rất nhiều text trùng lên nhau, làm bản vẽ nặng lên. Xin nhờ mọi người và anh Tue_NV viết hộ 1 lisp xóa các text trùng lên nhau (cách thức như dùng lệnh overkill vậy). Thanks!

Ôi chị Svba! Làm sao chị biết được file có nhiều text trùng nhau???

Cái gì trùng nhau cúng xóa được hết chị ạ!

Chưa mở bản vẽ của anh nhưng em đoán bản vẽ có nhiều nét trùng nhau .Sau PU anh thử thêm cách sau xem:
Express => Modify => Delete duplicate objects => Chọn tất cả các đối tượng vẽ => Enter để xoá các nét vẽ trùng nhau.

Nếu ko xóa được chị upload file bản vẽ đó lên...để em đưa vào mục.... đố vui:
http://www.cadviet.c...o...0&start=380
  • 2

“Sống trong đời sống cần có một tấm lòng / Để làm gì em biết không ? / Để gió cuốn đi, để gió cuốn đi...”


#2453 svba1608

svba1608

    Tưởng Thị Tú Khuyên

  • Moderator
  • PipPipPipPipPipPipPip
  • 601 Bài viết
Điểm đánh giá: 620 (tốt)

Đã gửi 18 July 2009 - 11:06 PM

Ôi chị Svba! Làm sao chị biết được file có nhiều text trùng nhau???
Cái gì trùng nhau cúng xóa được hết chị ạ!
Nếu ko xóa được chị upload file bản vẽ đó lên...để em đưa vào mục.... đố vui:
http://www.cadviet.c...o...0&start=380


Cảm ơn chị nhưng cách của chị em đã dùng rồi mà không được, nó không xóa được text:
Express => Modify => Delete duplicate objects => Chọn tất cả các đối tượng vẽ => Enter để xoá các nét vẽ trùng nhau = Overkill
File đó đây chị thử xem giùm xem: phần khung tên hầu như tất cả các chữ đều có đúng 16 text trùng lên nhau.
(Tiện thể chị xem và góp ý cho em cái bố trí đường ống với :s_dead: ).
  • 0
http://khuyen.space

#2454 TRUNGNGAMY

TRUNGNGAMY

    biết lệnh block

  • Members
  • PipPipPipPipPipPip
  • 401 Bài viết
Điểm đánh giá: 91 (tàm tạm)

Đã gửi 19 July 2009 - 12:16 AM

Em có 1 file có rất nhiều text trùng lên nhau, làm bản vẽ nặng lên. Xin nhờ mọi người và anh Tue_NV viết hộ 1 lisp xóa các text trùng lên nhau (cách thức như dùng lệnh overkill vậy). Thanks!

Bạn dùng tạm cái này
;Ham xoa text trung nhau
(defun C:XOATEXTTRUNG( / ss lis i ds p st ss1)
(defun diem( name n)
(cdr (assoc n (entget name)))
)
(setq lis nil)
(setq ss (ssget '((0 . "text,mtext"))))
(if ss (progn
(setq i 0)
(setq ss1 (ssadd))
(while (< i (sslength ss))
(setq name (ssname ss i))
(setq p (diem name 11) st (diem name 1))
(if (equal p '(0.0 0.0 0.0)) (setq p (diem name 10)))
(if lis
(progn
(setq ds (assoc p lis))
(if (and ds (= st (cadr ds)))
(ssadd name ss1)
(setq lis (append lis (list (list p st))))
)
)
(setq lis (list (list p st)))
)
(setq i (1+ i))
)
))
(if (> (sslength ss1) 0) (command "_.erase" ss1 ""))
)

  • 2

#2455 svba1608

svba1608

    Tưởng Thị Tú Khuyên

  • Moderator
  • PipPipPipPipPipPipPip
  • 601 Bài viết
Điểm đánh giá: 620 (tốt)

Đã gửi 19 July 2009 - 12:25 AM

Bạn dùng tạm cái này

Lisp rất tuyệt vời. Vô cùng cảm ơn bác! :s_dead: Tuy nhiên chỉ dùng được với 1-2 text cùng lúc, còn quét cả cái khung tên thì không được. Nhưng như thế này cũng là tuyệt vời lắm rồi.

Ôi! Chị Svba! Quả thực em ko tin chị đã nghĩ ra "mẹo" này (!)
Đố các bác biết chị Svba đã "nghĩ ra" "mẹo" gì???

Đến em cũng chẳng biết em nghĩ ra mẹo gì nữa. Đúng là đố vui thật! :s_dead:
(Còn về việc em biết có 16 text trùng lên nhau là do người làm khung tên bảo và em cũng xóa thủ công, vừa xóa vừa ... đếm).
  • 0
http://khuyen.space

#2456 haanh

haanh

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 2875 Bài viết
Điểm đánh giá: 1554 (rất tốt)

Đã gửi 19 July 2009 - 12:39 AM

Lisp rất tuyệt vời. Vô cùng cảm ơn bác! :s_dead: Tuy nhiên chỉ dùng được với 1-2 text cùng lúc, còn quét cả cái khung tên thì không được. Nhưng như thế này cũng là tuyệt vời lắm rồi.
Đến em cũng chẳng biết em nghĩ ra mẹo gì nữa. Đúng là đố vui thật! :s_dead:
(Còn về việc em biết có 16 text trùng lên nhau là do người làm khung tên bảo và em cũng xóa thủ công, vừa xóa vừa ... đếm).


Muốn biết nó có bao nhiêu text chị chỉ việc chọn đối tượng rồi gõ lệnh (....) biết liền cái này em đã từng ra câu đố ở trang 13 mục đố vui và quên chưa đưa ra lời giải tiện đây em cũng đố luôn làm thế nào để biết được số lượng text ???
CÔNG TRÌNH: PHÂN TRẠI GIAM SỐ 4 - TRẠI GIAM SỐ 3
HẠNG MỤC NHÀ LÀM VIỆC

Cả cụm từ trên có 49 text trong đó từ HẠNG MỤC chỉ có 1 text!
  • 0

“Sống trong đời sống cần có một tấm lòng / Để làm gì em biết không ? / Để gió cuốn đi, để gió cuốn đi...”


#2457 TRUNGNGAMY

TRUNGNGAMY

    biết lệnh block

  • Members
  • PipPipPipPipPipPip
  • 401 Bài viết
Điểm đánh giá: 91 (tàm tạm)

Đã gửi 19 July 2009 - 01:54 AM

Tuy nhiên chỉ dùng được với 1-2 text cùng lúc, còn quét cả cái khung tên thì không được.

Cái file của bạn với những text trùng sau nhưng tọa độ lệch 1, 2 số cuối làm cho lệnh của cad tìm kg ra. Bạn chỉ nên dùng tạm líp sau chứ kg nên dùng cho nhiều file khác
Bạn dùng tạm cái này
;Ham xoa text trung nhau
(defun C:XOATEXTTRUNG( / ss lis i ds p st ss1)
(defun diem( name n)
(cdr (assoc n (entget name)))
)
(setq lis nil)
(setq ss (ssget '((0 . "text,mtext"))))
(if ss (progn
(setq i 0)
(setq ss1 (ssadd))
(while (< i (sslength ss))
(setq name (ssname ss i))
(setq p (diem name 10) st (diem name 1))
(setq p (strcat (rtos (/ (car p) 100.0) 2 0) (rtos (/ (cadr p) 100.0) 2 0)))
(if lis
(progn
(setq ds (assoc p lis))
(if (and ds (= st (cadr ds)))
(ssadd name ss1)
(setq lis (append lis (list (list p st))))
)
)
(setq lis (list (list p st)))
)
(setq i (1+ i))
)
))
(if (> (sslength ss1) 0) (command "_.erase" ss1 ""))
)

  • 2

#2458 khibeo

khibeo

    Chưa sử dụng CAD

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

Đã gửi 19 July 2009 - 02:46 AM

Các bác ơi giúp em với! loai hoai từ tối tới giờ mà vẫn không làm dc. các bác đừng cười em nhé...hihi
Em đã thực hiện appload chương trình "scale block và text theo điểm chèn đối tượng" và có kết quả:SB.lsp successfuly loader
Khi gõ lệnh SB trên dong command C.Trình báo lỗi " error: no function definition" em phải làm sao bây giờ...
thank you very much!
  • 0

#2459 khibeo

khibeo

    Chưa sử dụng CAD

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

Đã gửi 19 July 2009 - 02:52 AM

giờ này chắc mọi ng ngủ rồi....
  • 0

#2460 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 19 July 2009 - 10:46 AM

Cái file của bạn với những text trùng sau nhưng tọa độ lệch 1, 2 số cuối làm cho lệnh của cad tìm kg ra. Bạn chỉ nên dùng tạm líp sau chứ kg nên dùng cho nhiều file khác
Bạn dùng tạm cái này

Chào svba1608
Tue_NV đã hoàn thiện đoạn Code này khắc phục được nhược điểm của Lisp của Bạn TRUNGNGAMY và có thể áp dụng được cho tất cả mọi bản vẽ.
svba thử nhé :
Code đây. Cách thức hoạt động y như Overkill (cho phép nhập khoảng sai số giữa các text trùng nhau)
Enter Numeric fuzz :

(defun C:XTT(/ ss ss1 fuzzo fuzz n ent p ndung ent1 ndung1)
(prompt "\n Chon Text,MTEXT : ")
   (setq ss (ssget '((0 . "text,mtext"))) n (sslength ss))
(if (null fuzzo) (setq fuzzo 20))
(setq fuzz (getreal (strcat "\n Enter Numeric fuzz < " (rtos fuzzo 2 2) "> : ")))
(if (null fuzz) (setq fuzz fuzzo) (setq fuzzo fuzz))

    (setq ss1 (ssadd))

    (while (> n 0)

      (setq ent (ssname ss 0))

      (setq p (cdr(assoc 10 (entget ent))))
(setq ndung (cdr(assoc 1 (entget ent))) i 1)

(while (< i n)

(setq ent1 (ssname ss i))

      (setq p1 (cdr(assoc 10 (entget ent1))))
(setq ndung1 (cdr(assoc 1 (entget ent1))))
(if (and (equal p p1 fuzz) (eq ndung ndung1))
(progn
(setq ss1 (ssadd ent1 ss1))
);progn
);if
(setq i (1+ i))

);while

(setq ss (ssdel ent ss))
(setq n (sslength ss))


)


(if (> (sslength ss1) 0) (command "_.erase" ss1 ""))
(princ)
)

  • 2