ro88

Tháng 6 14, 2013

các bác ơi, cho em hỏi tí là muốn sửa để phần toạ độ XY có 4 số sau dấu phẩy (,) thì làm thế nào ạ! cả thay đổi cột YX thành XY nữa! cảm ơn các bác

thanks vì lisp của bạn cái mình đang cần

mình có 1 yêu cầu nhỏ là bạn có thể chỉnh lại cho số tọa độ lấy làm tròn 2 số lẻ dc ko ( trong lisp lấy 3 số lẻ)

thank a lot

http://www.cadviet.com/upfiles/3/23835_xxx.lsp

Mình up cho các bạn lisp này theo yêu cầu cái này mình cũng sư tầm trên cadviet. nhờ rất nhiều người sửa giúp.

cái XY hay YX thì chịu khó sửa đi chứ mình ko biết.

Lệnh là TD1 nhé:

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=63922&pid=213751&st=0entry213751
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=63922&pid=199638&st=0entry199638
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=13203&st=3100
;; free lisp from cadviet.com
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;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 - 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:TD1 (/ h p et p0 p00 p01 p02 pt pvL pvL1 n j pv num txtL ss bn ntp p11 p12 p13 p14)
  (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 = M1): " )
  ) 

  ;(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:"))
(initget "T t N n")
(setq chieu (getkword "\nLua chon chieu ghi toa do < T/N >"))
(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 "")
  (setq Lkqua nil)
  (command "style" "Standard" ".Arial" "" "" "" "" "")
  (wtxtMC "B¶ng kª to¹ d«d vµ kho¶ng c¸ch"
  	(polar (polar p0 0 (* 16 h)) (* 0.5 pi) (* 4 h))
  	(* 1.2 h) nil)
  (wtxtMC "H? t?a d? VN-2000"
  	(polar (polar p0 0 (* 16 h)) (* 0.5 pi) (* 2 h))
  	(* 1.2 h) nil)
  (txt1 (setq Lkq (list "TT" "Y (m)" "X (m)" "S (m)")))
  (setq Lkqua (append Lkqua (list Lkq)))
  (setq p0 (polar p0 (* 1.5 pi) (* 3 h)))
;;;MAKE RECORDS
  (if (or (= chieu "N") (= chieu "n")) (setq pvL (reverse pvL)) )
  (setq	j  0
	pt nil)
  (repeat n
(setq
   pv  (nth j pvL)
   num (itoa (1+ j))
num (strcat "M" num)
)
(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 p11 (polar p0 (* 1.5 pi) (* 2.5 h)))
(setq P12 (polar p11 0 (* 25 h)))
(setq P13 (polar p11 0 (* 31 h)))
(setq P14 (polar p11 0 (* 32 h)))
(command "LINE" p11 p12 "")
(command "LINE" p13 p14 "")
(setq p0 (polar p0 (* 1.5 pi) (* 2 h)))
(setq pt pv)
(setq j (1+ j))
(if	(= j (- n 1))  (setq j 0))
  )
  (command "LINE" p11 p14 "")
  (linepy p00 (- (distance p00 (polar p0 (* 1.5 pi) (* 0.5 h)) )))
  (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))
	"")
;;;WRITE POINT NAME
  (setvar "CLAYER" "stt")
  (setq j 0)
  (repeat (1- n)
(setq
   pv  (nth j pvL)
   num (itoa (1+ j))
num (strcat "M" num)
)
(wtxtMC num (polar pv 0 h) h t)
(command "circle" pv cr0)
(command "HATCH" "solid" "L" "")
(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
;;;------------------------------------------------------------------------------------
(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 2)
    	(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 2)
    	(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 mp1)
  (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 mp1 (polar mp (angle p mp) (* 2 h)) )
(command "DIMALIGNED" p1 p2 mp1)
(setq i (1+ i))
  )
  ;; repeat k;
)
;;;--------------------------

Tháng 6 14, 2013

Hic, h thì em tính toán được rồi. Nhưng với điều kiện là phải lập thêm các CAO ĐỘ THIẾT KẾ ở ngoài khu vực giới hạn san nền và tạo các CAO ĐỘ TỰ NHIÊN ẢO bên ngoài khu vực san nền ( vì e không có bản đồ địa hình quá xa ngoài khu vực san nền ).

Còn việc tính toán taluy thì e thấy có ông anh đi làm 4 5 năm rồi dùng NOVA để tính khối lượng chạy dài (vì taluy ở bản vẽ e tính phức tạp, có những chỗ đào 32m, phải làm taluy giật cấp, những chỗ đắp làm bệ phản áp 1:2), ko biết diễn đàn mình có ace nào làm về thiết kế san nền và taluy thì chỉ giáo cho e với, e cám ơn nhiều.

mình có cái này up lên hi vọng có thể giúp gì đó cho bạn

http://www.mediafire.com/download/i7dupfu8vvmmfgp/HƯỚNG DẪN TÍNH SAN LẤP.rar

còn đây là Font

http://www.mediafire.com/?f46pauaw8cm85x5

ko biết sao khi mình download lisp về thì sử dụng ko được.mở bằng notepad thì thấy những đoạn code nằm một hàng ngang ko có xuống hàng như những lisp khác.load vào cad gõ lệnh nó ko hiểu.có ai biết cách khắc phục xin chỉ giúp.

Tháng 1 9, 2013

Có ai giúp dùm với.sao mãi chẳng thấy ai giúp dùm .

Tháng 1 9, 2013

có ai ghé thăm giúp dùm với

Tháng 1 9, 2013

Thân bác phamthanhbinh,

Đúng là em có chút sơ suất khi đã không giải thích cụ thể. Lô đất của em ban đầu như thế này ạ!

3582aa41af1fd9ef3d9c337448014f65_52433831.1.700x0.jpg

Em đã có xem một vài lisp về thống kê đỉnh nhưng đều không đạt yêu cầu. Em thấy có mỗi 1 lisp đánh số thứ tự bằng tay như thế này thôi ạ.

(defun c:stt (/ oldPref oldSuf oldStart curStr newNum
           	actDoc actSp oldEcho oldSize *error*)
 (defun *error* (msg)
(setvar "CMDECHO" oldEcho)
(princ)
); end *error*

 (vl-load-com)
 (if(not num:Size)(setq num:Size(getvar "DIMTXT")))
 (if(not num:Pref)(setq num:Pref ""))
 (if(not num:Suf)(setq num:Suf ""))
 (if(not num:Num)(setq num:Num 1))
 (setq oldPref num:Pref
   	oldSuf num:Suf
   	oldStart num:Num
   	oldSize num:Size
   	actDoc(vla-get-ActiveDocument
           	(vlax-get-acad-object))
   	oldEcho(getvar "CMDECHO")
  ); end setq
 (setvar "CMDECHO" 0)
 (if(=(vla-get-ActiveSpace actDoc)1)
		(setq actSp(vla-get-ModelSpace actDoc))
		(setq actSp(vla-get-PaperSpace actDoc))
); end if
 (setq num:Size
(getreal
 	(strcat "\nText size <"(rtos num:Size)">: ")))
 (if(null num:Size)(setq num:Size oldSize))
 (setq num:Pref
(getstring T
 	(strcat "\nPrefix: <"num:Pref">: ")))
 (if(= "" num:Pref)(setq num:Pref oldPref))
 (if(= " " num:Pref)(setq num:Pref ""))
 (setq num:Suf
(getstring T
 	(strcat "\nSuffix: <"num:Suf">: ")))
 (if(= "" num:Suf)(setq num:Suf oldSuf))
 (if(= " " num:Suf)(setq num:Suf ""))
 (setq num:Num
(getint
 	(strcat "\nStarting number <"(itoa num:Num)">: ")))
 (if(null num:Num)(setq num:Num oldStart))
 (princ "\n<<< Insert numbers or press Esc to quit >>> ")
 	(while T
   	(setq curStr(strcat num:Pref(itoa num:Num)num:Suf)
         	newNum(vla-AddText actSp
         	curStr (vlax-3d-point '(0.0 0.0 0.0)) num:Size))
   	(vla-put-Alignment newNum acAlignmentMiddleCenter)
   	(command "_.copybase"(trans '(0.0 0.0 0.0)0 1)(entlast)"")
   	(command "_.erase" (entlast) "")
   	(command "_.pasteclip" pause)
   	(setq num:Num(1+ num:Num))
  	); end while
 (princ)
); end of c:stt
(princ "\n***Lenh STT.*** ")

Mong bác giúp em bổ sung thêm yêu cầu về chiều dài và diện tích ạ.

Em cảm ơn bác ạ!

bạn dùng thử cái này xem sao

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=63922&pid=213751&st=0entry213751
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=63922&pid=199638&st=0entry199638
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=13203&st=3100
;; free lisp from cadviet.com
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;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 - 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:TD (/ h p et p0 p00 p01 p02 pt pvL pvL1 n j pv num txtL ss bn ntp p11 p12 p13 p14)
 (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 = M1): " )
 )
 ;(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:"))
(initget "T t N n")
(setq chieu (getkword "\nLua chon chieu ghi toa do < T/N >"))
(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 "")
 (setq Lkqua nil)
 (command "style" "CadViet" ".VnArialH" "" "" "" "" "")
 (wtxtMC "B¶ng kª täa ®é vµ kho¶ng c¸ch"
  (polar (polar p0 0 (* 16 h)) (* 0.5 pi) (* 4 h))
  (* 1.2 h) nil)
 (wtxtMC "HÖ täa ®é VN - 2000"
  (polar (polar p0 0 (* 16 h)) (* 0.5 pi) (* 2 h))
  (* 1.2 h) nil)
 (txt1 (setq Lkq (list "TT" "Y (m)" "X (m)" "S (m)")))
 (setq Lkqua (append Lkqua (list Lkq)))
 (setq p0 (polar p0 (* 1.5 pi) (* 3 h)))
;;;MAKE RECORDS
 (if (or (= chieu "N") (= chieu "n")) (setq pvL (reverse pvL)) )
 (setq j  0
pt nil)
 (repeat n
(setq
  pv  (nth j pvL)
  num (itoa (1+ j))
num (strcat "M" num)
)
(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 p11 (polar p0 (* 1.5 pi) (* 2.5 h)))
(setq P12 (polar p11 0 (* 25 h)))
(setq P13 (polar p11 0 (* 31 h)))
(setq P14 (polar p11 0 (* 32 h)))
(command "LINE" p11 p12 "")
(command "LINE" p13 p14 "")
(setq p0 (polar p0 (* 1.5 pi) (* 2 h)))
(setq pt pv)
(setq j (1+ j))
(if (= j (- n 1))  (setq j 0))
 )
 (command "LINE" p11 p14 "")
 (linepy p00 (- (distance p00 (polar p0 (* 1.5 pi) (* 0.5 h)) )))
 (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))
"")
;;;WRITE POINT NAME
 (setvar "CLAYER" "stt")
 (setq j 0)
 (repeat (1- n)
(setq
  pv  (nth j pvL)
  num (itoa (1+ j))
num (strcat "M" num)
)
(wtxtMC num (polar pv 0 h) h t)
(command "circle" pv cr0)
(command "HATCH" "solid" "L" "")
(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
;;;------------------------------------------------------------------------------------
(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 2)
	(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 2)
	(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 mp1)
 (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 mp1 (polar mp (angle p mp) (* 2 h)) )
(command "DIMALIGNED" p1 p2 mp1)
(setq i (1+ i))
 )
 ;; repeat k;
)
;;;--------------------------

cái này mình tìm trên diễn đàn và có nhờ Thiep sửa lại đôi chút bạn xem có được ko

Tháng 1 8, 2013

;----------------------------------------------------------------------------
;;; COMMAND: RD
;;; This command read datafile & draw line with elevation
;;; Datafile structure : North East Height
;----------------------------------------------------------------------------
 (if (not ai_utils)(load "ai_utils"))  
 (if (not my_utils)(load "my_utils"))  
;----------------------------------------------------------------------------
(defun strltrim (s)
 (cond
((eq s "") s)
((or(= " " (substr s 1 1))(= " " (substr s 1 1))) s)
(t (strltrim (substr s 2)))
 )
)
(defun tabltrim (s)
 (cond
((eq s "") s)
((or(= " " (substr s 1 1))(= " " (substr s 1 1))) (tabltrim (substr s 2)))
(t s)
 )
)
;----------------------------------------------------------------------------        
;; Subfunction for change 1 data-line to list
 (defun linetopoint(line)
 	(setq y (read line)
       	line (tabltrim line)
       	line (strltrim line)
       	x (read line)
       	line (strltrim (tabltrim line))
       	z (read line)
 	)
 	(setq point (list x y z))
 )
;;;-----------------------------------------------
;; Subfunction for read data from 1 file and change to list
 (defun read_fs()
 	(setq dlist nil)
 	(setq datafile (GETFILED "TUAN - Select data-file " (GETVAR "dwgprefix") "*" 2))
 	(setq filename datafile)
 	(princ (strcat "\nPlease, wait!. READ & DRAW is reading data from " filename))
 	(if (setq f (open filename "r"))
     	(progn
         	(while (setq pl (read-line f))
				(setq p (linetopoint pl) dlist (cons p dlist))
         	)
         	(close f)
     	)
 	)
(reverse dlist)
 )
;---------------------------------------------------
;(defun C:van ( / li)
;   (rd nil)
;   (princ)
;)
(defun c:van ( / li n i li htext)
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(Setq ts (tblsearch "STYLE" (GETVAR "TEXTSTYLE")))
(setq tsize (cdr(assoc '40 ts)))
(INITGET +3)
(if (= tsize 0)(setq h (getreal "\nHeigth of text :"))(setq h tsize))
(initget)
(setq tr (getreal "\nRotation of text <0>:"))
(if (= tr nil) (setq tr 0))
;-------------------------------------------
(initget "y n Y N")
(setq yn (getkword "\nDo you want to draw in 3D <y/n> ?<y>"))
(if (= yn nil)(setq yn "Y"))
(if (= (strcase yn) "N")(setq yn "N")(setq yn "Y"))
;-------------------------------------------
;(initget "y n Y N")
;(setq ynl (getkword "\nDo you want to connect each to other <y/n> ?<y>"))
;(if (= ynl nil)(setq ynl "Y"))
;(if (= (strcase ynl) "N")(setq ynl "N")(setq ynl "Y"))
;-------------------------------------------
;(initget "y n Y N")
;(setq ynd (getkword "\nDo you want to insert donut at each point <y/n> ?<y>"))
;(if (= ynd nil)(setq ynd "Y"))
;(if (= (strcase ynd) "N")(setq ynd "N")(setq ynd "Y"))
;-------------------------------------------
;(initget "y n Y N")
;(setq ynC (getkword "\nDo you want to insert coconut at each point <y/n> ?<y>"))
;(if (= ynC nil)(setq ynC "Y"))
;(if (= (strcase ynC) "N")(setq ynC "N")(setq ynC "Y"))
;-------------------------------------------
;(initget "y n Y N")
;(setq ynTD (getkword "\nDo you want to insert TD at each point <y/n> ?<y>"))
;(if (= ynTD nil)(setq ynTD "Y"))
;(if (= (strcase ynTD) "N")(setq ynTD "N")(setq ynTD "Y"))
;-------------------------------------------
;(initget "y n Y N")
;(setq ynCL (getkword "\nDo you want to insert CL at each point <y/n> ?<y>"))
;(if (= ynCL nil)(setq ynCL "Y"))
;(if (= (strcase ynCL) "N")(setq ynCL "N")(setq ynCL "Y"))
;-------------------------------------------
(setq tb (* h 0.50))
(setq li (read_fs) n (length li) i -1 ipold (list 0 0 0))
;(print li)
 	(ai_undo_on)                	; Turn UNDO on
 	(command "_.UNDO" "_GROUP")
(setq o_osmode (getvar "osmode"))
(setvar "osmode" 0)
;(COMMAND "insert" "DONUT" "0,0")
(command)
(repeat n
  (setq i (1+ i) ip (nth i li) htext (zrtos (last ip) 2))
(setq ip1 (list (car ip) (cadr ip) 0.00))
(setq zi (atof htext))
(cond
((and( > zi 1000)(< zi 2000))(command "insert" "bienbao" ip1 tb tb 0))
((and( > zi 2000)(< zi 3000))(command "insert" "buiram" ip1 tb tb 0))
((and( > zi 3000)(< zi 4000))(command "insert" "cayanqua" ip1 tb tb 0))
((and( > zi 4000)(< zi 5000))(command "insert" "caycothu" ip1 tb tb 0))
((and( > zi 5000)(< zi 6000))(command "insert" "caydua" ip1 tb tb 0))
((and( > zi 6000)(< zi 7000))(command "insert" "caylua" ip1 tb tb 0))
((and( > zi 7000)(< zi 8000))(command "insert" "caymia" ip1 tb tb 0))
((and( > zi 8000)(< zi 9000))(command "insert" "caynhon" ip1 tb tb 0))
((and( > zi 9000)(< zi 10000))(command "insert" "caythong" ip1 tb tb 0))
((and( > zi 10000)(< zi 11000))(command "insert" "caytre" ip1 tb tb 0))
((and( > zi 11000)(< zi 12000))(command "insert" "cocchuyen" ip1 tb tb 0))
((and( > zi 12000)(< zi 13000))(command "insert" "dadoclap" ip1 tb tb 0))
((and( > zi 13000)(< zi 14000))(command "insert" "g1" ip1 tb tb 0))
((and( > zi 14000)(< zi 15000))(command "insert" "g2" ip1 tb tb 0))
((and( > zi 15000)(< zi 16000))(command "insert" "g3" ip1 tb tb 0))
((and( > zi 16000)(< zi 17000))(command "insert" "g4" ip1 tb tb 0))
((and( > zi 17000)(< zi 18000))(command "insert" "g5" ip1 tb tb 0))
((and( > zi 18000)(< zi 19000))(command "insert" "gieng" ip1 tb tb 0))
((and( > zi 19000)(< zi 20000))(command "insert" "hoamau" ip1 tb tb 0))
((and( > zi 20000)(< zi 21000))(command "insert" "leduong" ip1 tb tb 0))
((and( > zi 21000)(< zi 22000))(command "insert" "moma" ip1 tb tb 0))
((and( > zi 22000)(< zi 23000))(command "insert" "rao" ip1 tb tb 0))
((and( > zi 23000)(< zi 24000))(command "insert" "raumau" ip1 tb tb 0))
((and( > zi 24000)(< zi 25000))(command "insert" "sl" ip1 tb tb 0))
((and( > zi 25000)(< zi 26000))(command "insert" "t1" ip1 tb tb 0))
((and( > zi 26000)(< zi 27000))(command "insert" "t2" ip1 tb tb 0))
((and( > zi 27000)(< zi 28000))(command "insert" "t3" ip1 tb tb 0))
((and( > zi 28000)(< zi 29000))(command "insert" "t4" ip1 tb tb 0))
((and( > zi 29000)(< zi 30000))(command "insert" "tuong" ip1 tb tb 0))
((and( > zi 30000)(< zi 31000))(command "insert" "tram" ip1 tb tb 0))
((and( > zi 31000)(< zi 32000))(command "insert" "trucaothe" ip1 tb tb 0))
((and( > zi 32000)(< zi 33000))(command "insert" "truco" ip1 tb tb 0))
((and( > zi 33000)(< zi 34000))(command "insert" "truden" ip1 tb tb 0))
((and( > zi 34000)(< zi 35000))(command "insert" "trudendoi" ip1 tb tb 0))
((and( > zi 35000)(< zi 36000))(command "insert" "trudien1" ip1 tb tb 0))
((and( > zi 36000)(< zi 37000))(command "insert" "truttin" ip1 tb tb 0))
((and( > zi 37000)(< zi 38000))(command "insert" "2tuong" ip1 tb tb 0))
((and( > zi 38000)(< zi 39000))(command "insert" "3tuong" ip1 tb tb 0))
((and( > zi 39000)(< zi 40000))(command "insert" "2rao" ip1 tb tb 0))
((and( > zi 40000)(< zi 41000))(command "insert" "3rao" ip1 tb tb 0))
((and( > zi 41000)(< zi 42000))(command "insert" "T1T2" ip1 tb tb 0))
((and( > zi 42000)(< zi 43000))(command "insert" "G1G2" ip1 tb tb 0))
((and( > zi 43000)(< zi 44000))(command "insert" "Cong" ip1 tb tb 0))
((and( > zi 44000)(< zi 45000))(command "insert" "Hangcay" ip1 tb tb 0))
((and( > zi 45000)(< zi 46000))(command "insert" "Ao" ip1 tb tb 0))
((and( > zi 46000)(< zi 47000))(command "insert" "Raokhac" ip1 tb tb 0))
((and( > zi 47000)(< zi 48000))(command "insert" "trudien2" ip1 tb tb 0))
((and( > zi 48000)(< zi 49000))(command "insert" "chanbc" ip1 tb tb 0))
((and( > zi 49000)(< zi 50000))(command "insert" "tuongkhac" ip1 tb tb 0))
((and( > zi 50000)(< zi 51000))(command "insert" "lekhac" ip1 tb tb 0))
)
  ;(setq ip (list (car ip) (cadr ip) 0)))
  ;(if (= ynl "Y")(if (> i 1)(command "line" ipold ip "")))
 ; (if (= ynd "Y")(command "insert" "donut" ip tb tb 0))
  ;(if (= ynC "Y")(command "insert" "coconut" ip tb tb 0))
  ;(if (= ynTD "Y")(command "insert" "TD" ip tb tb 0))
  ;(if (= ynCL "Y")(command "insert" "CL" ip tb tb 0))
(cond
((< zi 1000)(setq ri (- (atof htext) 00.0)))
((and( > zi 1000)(< zi 2000))(setq ri (- (atof htext) 1000.0)))
((and( > zi 2000)(< zi 3000))(setq ri (- (atof htext) 2000.0)))
((and( > zi 3000)(< zi 4000))(setq ri (- (atof htext) 3000.0)))
((and( > zi 4000)(< zi 5000))(setq ri (- (atof htext) 4000.0)))
((and( > zi 5000)(< zi 6000))(setq ri (- (atof htext) 5000.0)))
((and( > zi 6000)(< zi 7000))(setq ri (- (atof htext) 6000.0)))
((and( > zi 7000)(< zi 8000))(setq ri (- (atof htext) 7000.0)))
((and( > zi 8000)(< zi 9000))(setq ri (- (atof htext) 8000.0)))
((and( > zi 9000)(< zi 10000))(setq ri (- (atof htext) 9000.0)))
((and( > zi 10000)(< zi 11000))(setq ri (- (atof htext) 10000.0)))
((and( > zi 11000)(< zi 12000))(setq ri (- (atof htext) 11000.0)))
((and( > zi 12000)(< zi 13000))(setq ri (- (atof htext) 12000.0)))
((and( > zi 13000)(< zi 14000))(setq ri (- (atof htext) 13000.0)))
((and( > zi 14000)(< zi 15000))(setq ri (- (atof htext) 14000.0)))
((and( > zi 15000)(< zi 16000))(setq ri (- (atof htext) 15000.0)))
((and( > zi 16000)(< zi 17000))(setq ri (- (atof htext) 16000.0)))
((and( > zi 17000)(< zi 18000))(setq ri (- (atof htext) 17000.0)))
((and( > zi 18000)(< zi 19000))(setq ri (- (atof htext) 18000.0)))
((and( > zi 19000)(< zi 20000))(setq ri (- (atof htext) 19000.0)))
((and( > zi 20000)(< zi 21000))(setq ri (- (atof htext) 20000.0)))
((and( > zi 21000)(< zi 22000))(setq ri (- (atof htext) 21000.0)))
((and( > zi 22000)(< zi 23000))(setq ri (- (atof htext) 22000.0)))
((and( > zi 23000)(< zi 24000))(setq ri (- (atof htext) 23000.0)))
((and( > zi 24000)(< zi 25000))(setq ri (- (atof htext) 24000.0)))
((and( > zi 25000)(< zi 26000))(setq ri (- (atof htext) 25000.0)))
((and( > zi 26000)(< zi 27000))(setq ri (- (atof htext) 26000.0)))
((and( > zi 27000)(< zi 28000))(setq ri (- (atof htext) 27000.0)))
((and( > zi 28000)(< zi 29000))(setq ri (- (atof htext) 28000.0)))
((and( > zi 29000)(< zi 30000))(setq ri (- (atof htext) 29000.0)))
((and( > zi 30000)(< zi 31000))(setq ri (- (atof htext) 30000.0)))
((and( > zi 31000)(< zi 32000))(setq ri (- (atof htext) 31000.0)))
((and( > zi 32000)(< zi 33000))(setq ri (- (atof htext) 32000.0)))
((and( > zi 33000)(< zi 34000))(setq ri (- (atof htext) 33000.0)))
((and( > zi 34000)(< zi 35000))(setq ri (- (atof htext) 34000.0)))
((and( > zi 35000)(< zi 36000))(setq ri (- (atof htext) 35000.0)))
((and( > zi 36000)(< zi 37000))(setq ri (- (atof htext) 36000.0)))
((and( > zi 37000)(< zi 38000))(setq ri (- (atof htext) 37000.0)))
((and( > zi 38000)(< zi 39000))(setq ri (- (atof htext) 38000.0)))
((and( > zi 39000)(< zi 40000))(setq ri (- (atof htext) 39000.0)))
((and( > zi 40000)(< zi 41000))(setq ri (- (atof htext) 40000.0)))
((and( > zi 41000)(< zi 42000))(setq ri (- (atof htext) 41000.0)))
((and( > zi 42000)(< zi 43000))(setq ri (- (atof htext) 42000.0)))
((and( > zi 43000)(< zi 44000))(setq ri (- (atof htext) 43000.0)))
((and( > zi 44000)(< zi 45000))(setq ri (- (atof htext) 44000.0)))
((and( > zi 45000)(< zi 46000))(setq ri (- (atof htext) 45000.0)))
((and( > zi 46000)(< zi 47000))(setq ri (- (atof htext) 46000.0)))
((and( > zi 47000)(< zi 48000))(setq ri (- (atof htext) 47000.0)))
((and( > zi 48000)(< zi 49000))(setq ri (- (atof htext) 48000.0)))
((and( > zi 49000)(< zi 50000))(setq ri (- (atof htext) 49000.0)))
((and( > zi 50000)(< zi 51000))(setq ri (- (atof htext) 50000.0)))
)
(if (> (atof htext) 1000)(setq htext (zrtos ri  2)))
(if (= yn "N")(setq ip (list (car ip) (cadr ip) 0.00))(setq ip (list (car ip) (cadr ip) ri)))
  (print ip)
  (if (= tsize 0)
       	(COMMAND "text" "j" "c" ip h tr htext)
       	(COMMAND "text" "j" "c" ip tr htext)
  )
(command "insert" "donut" ip tb tb 0) ;(neu su dung YN donut thi xoa ca hang nay)
  ;(setq ipold ip)
)
(setvar "osmode" o_osmode)
(command "_.UNDO" "_E")
 	(ai_undo_off)
(princ "\nThank you for using this command")
(princ)
)
;;;--------------------------------------------------------------------------------
(princ "   READ & DRAW loaded.")
(princ )

Mình có lisp phun điểm này nhờ các Anh/Chị,sửa dùm với.

Lisp chạy tốt nhưng bị hạn chế là chỉ chạy được tới 99,xxx. Chỉ được 2 số nguyên tới 100,xxx là ko hiểu

Nhờ các Anh/ Chị sửa dùm

Lệnh: RD

chiều cao text:

Góc quay(0):

Do you want to draw in 3D (y/n)?

Thêm dòng này: Số thập phân :

copy lisp vào support của Cad và phải có dấu chấm vàng trong bản vẽ bên dưới thì lisp mới chạy được

Dưới đây là file TxT và file mẫu do lisp chạy đượchttp://www.cadviet.c...3751_text_1.dwg

http://www.cadviet.c...751_datlanh.txt

Tháng 10 24, 2012

nói thật là đánh trong Word thì e cũng ko biết nên tóm tắt thế nào cho mọi ng dễ hiểu nên e nghĩ chỉ cần viết tính khối lượng thế là cũng tàm tạm rùi ^^

mong mọi ng trong diễn đàn thông cảm và giúp đỡ e đang cần để làm đồ án tốt nghiệp, vì file của e up lên cũng nhẹ (250Kb)

với lại e post lại lần 2 rồi mới được bác Hà cho biết chỗ sai nên e ko mún post lần 3 nữa vì nó trùng nhiều quá

Bạn dùng thử HS của Hài Hòa tính thử xem sao.Nếu bạn chưa có phần mềm thì để mình up lên cho có cả video hướng dẫn

Tháng 10 2, 2012

like rồi nhé

vô ý quá.bây giờ lisp này đã hoàn thành rồi rất tốt có thể up lên cho mọi người dùng.

Thanks lần nữa nhé :))

Mình có lisp này thấy cũng hay up lên có bạn nào cần thì dùng ko biết tác giả là ai

Lisp copy text từ Cad sang Excel(có luôn hướng dẫn)

Mình có dùng nhưng có lúc được lúc không vd: có 2 cột tọa độ X và Y thì chỉ copy được 1 cột (có lúc được cả 2) :) hên xui

Nó đây lệnh là (b2e);

http://www.mediafire...q8vh4cea2vgq25q

ko biết up ở đây có bị la hay ko nữa.

Tháng 10 2, 2012

Ý của em cũng như bác bảo, không xóa file cũng không move đi đâu hết nhưng vẫn gặp phải lỗi, bác giabach xem lại tí nha. Cám ơn bác nhiều

mình cũng bị như vậy

đã load file ChangeCode.dll kên rồi như khi gõ lệnh Chcode thì vẫn báo lỗi

Unknown command "CHCODE". Press F1 for help

ko biết như thế nào

nhờ bác sửa lại giúp

Tháng 10 2, 2012

quansla ơi.Sửa lại giúp mình cao text với

VD:khi chọn text đầu A cao text=1.25 thì khi +vào 50 thì text kết quả có cao text bằng A cũng là 1.25

P/s: có nghĩa là cao text của điểm đầu bao nhiêu thì kết quả ra cao text cũng như vậy

Mình ko rành về lisp bạn sửa lại dùm nhé

Thanks nhiều.

Tháng 10 1, 2012

Thanks quansla

ok rồi

Tháng 10 1, 2012

Đúng roi quansla a

Sử dụng đồng thời 2 lựa chọn lun

mà mình chỉ cần lấy kết quả la số chẵn thôi.

VD:1300+50=1350, lisp xuất ra là 1350,00 mình ko cần lấy 2 số sau dấu phẩy

Thanks bạn đã quan tâm

Tháng 10 1, 2012

ketxu chưa onl hay sao nhỉ.có lên thì xem sửa giúp mình với nhé.Thanks.

Tháng 9 30, 2012

ketxu ơi mình tìm thấy lisp này bác có thể sửa lại mình tí nhé VD minh co text A=700 +50 thì cho nó là số 750 còn lisp xuất ra 750,00

sửa lại giúp mình nhé

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=13203&st=80&p=72664entry72664
(defun c:tinh()
(setq i 0 nhan 1 chia 1 cong 0)
(setq  nhan1 (getreal (strcat "\n nhap so muon nhan hoac chia <" (rtos nhan 2 3) ">: "))
cong1 (getreal (strcat "\n nhap so muon cong hoac tru <" (rtos cong 2 3) ">:")))
(if nhan1 (setq nhan nhan1))
(if cong1 (setq cong cong1))
(prompt "\nchon cac so can sua ...")
(setq txt (ssget '((0 . "TEXT"))))
(command "undo" "begin")
(repeat  (sslength txt)
(setq txt_name (ssname txt i))
(setq txt_ent (entget txt_name))
(setq cont1 (cdr(assoc 1 txt_ent)))
(setq cont (atof cont1))
(if (distof cont1 2)
 (progn
 (setq s (+ (* cont nhan) cong))
 (setq txt_ent  (subst (cons 1 (rtos s)) (assoc 1 txt_ent) txt_ent))
 (entmod txt_ent));if
);if
(setq i (+ i 1))
);repeat
(command "undo" "end")
);defun

cảm ơn bác.

Tháng 9 30, 2012

Mình ko cần điểm mốc bạn à.Vẫn giũ lại điểm tiếp theo rồi chọn text và đè lên text đó.

Tháng 9 30, 2012

Để nhờ bạn master_worse sửa lại lisp (+c) cho nó xuất kết quả đè lên text cũ là ok rồi. còn mấy cái kia để sửa 1 cái rồi copy qua cho mấy bản khác.ketxu xem có thể giúp mình sửa lisp đó được ko vậy.

À cho minh hỏi cái này nhé

VD mình có text A=5000 (hay một số bất kỳ) B=6000 (hay một số bất kỳ) C= 7000 (hay một số bất kỳ),v.v.......

mình copy text A =5000 (hay một số bất kỳ) past đè vào text B,C,v.v.....đó.nó sẽ thay đổi text của B,C,v.v.. đấy thành text của A

có lisp nào như vậy ko,và nếu có thì bạn có thể cho mình cái tên để minh seach trên diễn đàn nhé.

Thanks rất nhiều.

Tháng 9 30, 2012

Tạm thời làm thế này:

(defun c:+c (/ b p1 p2 cong value dimzin)
(defun *error* (msg) (and dimzin (setvar "dimzin" dimzin)) (setq *error* nil) (princ))
(while (null (setq b (ssget ":S" '((0 . "TEXT") (1 . "~*[~0-9]*,~*[~0-9`.0-9]*")))))
 (princ "\nKhong phai so. Chon lai.")
);_ end while
(setq dimzin (getvar "dimzin"))
(setvar "dimzin" 0)
(setq b     (ssname b 0)
      value (cdr (assoc 1 (entget B)))
);_ end setq
(or *cong* (setq *cong* 1.0))
(or (setq cong (getreal (strcat "\nNhap so cong them: <" (rtos *cong* 2 2) ">")))
    (setq cong *cong*)
);_ end or
(setq *cong* cong)
(setq p1 (getpoint "\nDiem moc: "))
(while (setq p2 (getpoint p1 "\nDiem tiep theo: "))
 (command "copy" b "" p1 p2)
 (setq value (rtos (+ cong (atof value)) 2 2))
 (entmod (subst (cons 1 value) (assoc 1 (entget (entlast))) (entget (entlast))))
);_ end while
(setvar "dimzin" dimzin)
(setq *error* nil)
(princ)
);_ end defun

Bạn ơi có thể cho kết quả xuất ra đè lên text cũ được ko vậy?

Tháng 9 30, 2012

Ngày hôm nay mới đi làm về ko trả lời được.

Cảm ơn VoHoan và ketxu nhiều nhé.

ý của mình cũng giống như ketxu nói đấy

tạo lisp sao cho pick 2 điểm ở 2 góc khung bản đồ với nhập tỉ lệ vào là là chạy một phát ra hết cái đống lằn nhằn kia là được

ko biết là có khả thi ko nữa

Tháng 9 29, 2012

Các text số mép ngoài cũng thay đổi dựa theo mắt lưới.để mình ví dụ thế này nhé:

Bạn có thể tạo lips thế này:

Tên lệnh :KBD

pick chọn điểm góc dưới bên trái (điểm này là mắt lưới mình tạo ra co tọa độ chẵn VD: X=1349000 Y=602000)

pick chọn điểm trên cùng bên phải

VD:Tỉ lệ bản vẽ là 1/500 thì khoảng cách mỗi mắt lưới là 50 thi tọa độ sẽ tăng dần lên X=1349050 Y=602050

Text Tọa độ X và Y bạn để giống như bản vẽ của mình nhé 1349 là (0.85) 050là 1.25 và tọa độ Y cũng vậy

Quan trọng là tọa độ này thôi,tại vì khi mình có một bản vẽ lớn mình muốn tạo tờ bản đồ để in phải chia ra từng tờ mà mỗi tờ thì phải sủa lại các text tọa độ nên rất lâu, còn phần Khung tên , tỉ lệ xích, tên bản vẽ ,địa chỉ bạn tạo thế nào cũng được nhưng có thể chỉnh sủa là được rồi.

Nếu ko thấy phiền bạn có thể cho mình xin số điện thoại mình có thể trình bày rõ ràng hơn.

Thanks bạn nhiều nhé.

Bây giờ mình phải ngồi sửa từng cái lâu quá.

Để mình up bản vẽ này lên chắc bạn sẽ hình dung được,

http://www.cadviet.c...1_ban_mau_2.dwg

Sđt mình là 01662203938 có gì bạn nhá máy mình gọi lại nhé,mình tên vũ.

Tháng 9 29, 2012

VoHoan đã xem file bản vẽ của mình rồi ha?

Nguyên cái khung đấy là mình làm thủ công từng cái một cho nên rất mất thời gian

ở trong Topo co cái tạo khung bản đồ kiểu pick điểm dưới cùng bên trái rồi pick điểm trên cùng góc bên phải là nó chạy ra khung luôn cho mình có cả mắt lưới luôn

Nhưng nó lại không giống với cái khung mà ở cty mình đã làm,mình có up trên bản vẽ đấy.

Mình muốn nhờ bạn có thể xem bản vẽ rồi từ đó tạo lisp tạo khung tờ giúp minh được ko?

Hay là có cách nào khác bạn chỉ giúp nhé.

Cảm ơn rất nhiều.

Mình up lại bản vẽ nhé

http://www.cadviet.com/upfiles/3/73751_khung_to_2.dwg

Rất mong được các bạn giúp đỡ.

Tháng 9 29, 2012

Các bạn có thể bớt chút thời gian giúp mình với.Đang tạo khung tờ cho 59 tờ bản đồ mà ngồi sửa tùng tờ 1 lâu quá.nhìn loạn hết cả mắt.

Làm ơn giúp với.Cảm ơn các bạn nhiều lắm.CÓ bạn nào ở Nha Trang mình mời uống cafe.

Tháng 9 29, 2012

VoHoan ơi có thể giúp mình ko vậy?Tại vì đang làm gấp quá nên có gì anh em thông cảm mình nha.

Tháng 9 29, 2012

Mình có cái khung tên này do ở công ty mình làm từ lâu giờ. toàn bộ làm thủ công hết.nhưng đối với bản vẽ nhỏ thì còn đỡ chứ mấy bản vẽ lớn thì làm mất phải vài ngày.Nhờ các bạn dựa trên khung tên có sẵn trên bản vẽ có thể viết cho mình cái lisp để làm cho nhanh hơn được ko. Cảm ơn rất nhiều.

đây là bản mẫu:

http://www.cadviet.com/upfiles/3/73751_khung_to_1.dwg

Mong được các bạn quan tâm

Tháng 9 29, 2012

post nhầm topic sorry nhé.

Tháng 9 29, 2012

Mình có cái khung tên này do ở công ty mình làm từ lâu giờ. toàn bộ làm thủ công hết.nhưng đối với bản vẽ nhỏ thì còn đỡ chứ mấy bản vẽ lớn thì làm mất phải vài ngày.Nhờ các bạn dựa trên khung tên có sẵn trên bản vẽ có thể viết cho mình cái lisp để làm cho nhanh hơn được ko. Cảm ơn rất nhiều.

đây là bản mẫu:

http://www.cadviet.com/upfiles/3/73751_khung_to.dwg

Mong được các bạn quan tâm .

Đăng nhập

ro88

Số lượng nội dung

Đã tham gia

Lần ghé thăm cuối

Loại nội dung

Hồ sơ

Diễn đàn

Bài đăng được đăng bởi ro88

[ Nhờ chỉnh sửa] Lisp xuất tọa độ

Bác nào dùng HS2005 cho em hỏi chút

[Nhờ chỉnh sửa] Nhờ hoàn thiện lisp phun điểm mia địa chính ra Autocad

[Nhờ chỉnh sửa] Nhờ hoàn thiện lisp phun điểm mia địa chính ra Autocad

[Giúp đỡ] Viết lisp đánh số thứ tự đỉnh,khoảng cách và diện tích

[Nhờ chỉnh sửa] Nhờ hoàn thiện lisp phun điểm mia địa chính ra Autocad

[Yêu cầu] Viết lisp tính khối lượng đất cho lưới ô vuông

Nhờ sửa lisp cộng tăng dần với số bất kỳ

Ứng dụng AutoCAD .NET: chuyển đổi các bảng mã tiếng Việt thông dụng

Nhờ sửa lisp cộng tăng dần với số bất kỳ

Nhờ sửa lisp cộng tăng dần với số bất kỳ

Nhờ sửa lisp cộng tăng dần với số bất kỳ

Tạo Khung tên

Tạo Khung tên

Nhờ sửa lisp cộng tăng dần với số bất kỳ

Tạo Khung tên

Nhờ sửa lisp cộng tăng dần với số bất kỳ

Tạo Khung tên

Tạo Khung tên

Tạo Khung tên

Tạo Khung tên

Tạo Khung tên

Tạo Khung tên

'Tạo khung bản đồ'

'Tạo khung bản đồ'

Diễn đàn

Download

Đào tạo CADViet

Browse