Viết Lisp theo yêu cầu

[phuchauctc 0]

Chào các cao thủ.

Mình mới tham gia diễn đàn và thấy rất nhiều điều hay. Hôm trước mình có dùng một số lisp tạo bảng toạ độ để lấy toạ độ của các điểm trên Pline hoặc Region rồi xuất ngay trong CAD hoặc sang Excel hoặc text. Mình thấy cũng tốt nhiều cho mình rồi nhưng còn một số việc chưa được nên nhờ các cao thủ lập giúp mình một lisp thực hiện công việc sau:

Có 1 bản vẽ mặt bằng công trình theo dạng tuyến được vẽ với tỷ lệ 1/2000. Trên mặt bằng có các mốc giải phóng mặt bằng có tọa độ X và Y. Giả sử mốc GPMB1 có tọa độ chuẩn theo hệ tọa độ Quốc gia VN2000 là X1, Y1. Trong quá trình lập bản vẽ thiết kế lại chuyển cả bản vẽ mặt bằng đi một vị trí khác (move tự do không định trước khoảng cách) nên điểm GPMB1 bây giờ có tọa độ là X2, Y2. Để có bảng tọa độ đúng của các mốc GPMB, mình đã làm như sau:

- Chuyển tỷ lệ bản vẽ về đúng tỷ lệ thật.

- Chuyển (move) một điểm nào đó (ví dụ điểm đường chuyền) trên bản vẽ đã bị dịch đi về đúng tọa độ của nó theo tài liệu khảo sát địa hình.

- Dùng Lisp sau (xin lỗi ko nhớ của tác giả nào nữa):

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

 

 

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

;;;Free utility - www.cadviet.com - September 2008

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

 

 

 

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

)

;;;-------------------------------------------------------------------------------

(defun wtxtMC (txt p h) ;;;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)))

)

;;;-------------------------------------------------------------------------------

(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 (* 8 h))

p3 (polar p2 0 (* 12 h))

p4 (polar p3 0 (* 10 h))

pL (list p1 p2 p3 p4)

i 0

)

(repeat 4

(wtxtMC (nth i txtL) (nth i pL) h)

(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 (* 8 h))

p3 (polar p2 0 (* 12 h))

p4 (polar p3 0 (* 10 h))

p4 (polar p4 (* 0.5 pi) (* 1.5 h))

pL (list p1 p2 p3 p4)

i 0

)

(repeat 4

(wtxtMC (nth i txtL) (nth i pL) h)

(setq i (1+ i))

)

)

;;;-------------------------------------------------------------------------------

 

 

;;;MAIN PROGRAM

;;;-------------------------------------------------------------------------------

(defun C:VC( / h p et p0 p00 p01 p02 pt pvL n j pv num txtL ss bn)

;;;Vertex Co-ordinate

 

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

 

;;;PICK & BASE POINT

(setq p (getpoint "\nPick 1 diem giua mien kin:"))

(command "boundary" p "")

(setq et (entlast))

(redraw et 3)

(setq

p00 (getpoint "\nDiem chuan bang toa do (phia tren ben trai):")

p0 p00

p01 (polar p00 (* 1.5 pi) (* h 3))

pvL (reverse (getvert et))

n (length pvL)

p02 (polar p01 (* 1.5 pi) (* n h 3))

oldos (getvar "osmode")

)

(setvar "osmode" 0)

 

;;;HEADER

(linepx p0 (* 38 h))

(command "copy" "L" "" "m" p00 p01 p02 "")

(linepy p0 (* (+ n 1) -3 h))

(command "copy" "L" "" "m" p0

(list(+ (car p0) (* 4 h)) (cadr p0))

(list(+ (car p0) (* 16 h)) (cadr p0))

(list(+ (car p0) (* 28 h)) (cadr p0))

(list(+ (car p0) (* 38 h)) (cadr p0))

""

)

 

(txt1 (list "TT" "X (m)" "Y (m)" "S (m)"))

(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))) (setq S ""))

(setq txtL (list num (rtos (cadr pv)) (rtos (car pv)) S))

(txt2 txtL)

(setq p0 (polar p0 (* 1.5 pi) (* 3 h)))

(setq pt pv)

(setq j (1+ j))

(if (= j (- n 1)) (setq j 0))

)

 

;;;MAKE BLOCK

(setq ss (collect1 et))

(command "erase" 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

(setq j 0)

(repeat (1- n)

(setq

pv (nth j pvL)

num (itoa (1+ j))

)

(wtxtMC num (polar pv 0 h) h)

(setq j (1+ j))

)

;;;FINISH

(setvar "osmode" oldos)

(princ)

)

;;;-------------------------------------------------------------------------------

 

Mình đã tạo được bảng tọa độ theo ý muốn. Tuy nhiên mình muốn các cao thủ sửa giúp (do mình hoàn toàn mù tịt về AutoLisp) Lisp trên nhằm thực hiện các việc:

- Nhập tỷ lệ bản vẽ hiện hành.

- Nhập tỷ lệ thực cần chuyển về.

- Chọn điểm chuẩn cần chuyển tọa độ.

- Nhập tọa độ hiện hành (đã bị dịch chuyển) của điểm đó.

- Nhập tọa độ chuẩn của điểm chuẩn đó.

Sau đó mới đến các việc của đoạn Lisp trên và việc đánh số thứ tự không là 1,2,3... mà có thể là GPMB1, GPMB2, GPMB3,... hoặc gì đó theo bước nhảy do người dùng đặt (mặc định là 1) và xuất trực tiếp ra bản vẽ hoặc sang Excel hoặc text.

Đây là lần đầu tiên viết bài trên diễn đàn nên có gì chưa được xin được chỉ giáo.

Mr Hoành hoặc Mr ssg ơi, nếu ai sửa giúp được xin nhờ gửi cho mình theo Email: phuchauctc@gmail.com với nhé.

Xin đa tạ và chúc sức khỏe!

[Tue_NV 3.912]

Chào các cao thủ.

Mình mới tham gia diễn đàn và thấy rất nhiều điều hay. Hôm trước mình có dùng một số lisp tạo bảng toạ độ để lấy toạ độ của các điểm trên Pline hoặc Region rồi xuất ngay trong CAD hoặc sang Excel hoặc text. Mình thấy cũng tốt nhiều cho mình rồi nhưng còn một số việc chưa được nên nhờ các cao thủ lập giúp mình một lisp thực hiện công việc sau:

 

 

Theo em anh ko nên "viết chào các cao thủ"! Viết như thế kỳ kỳ thế nào ứ! Vì có người biết nhưng cũng ngại ko dám trả lời câu hỏi của anh chỉ vì một lý do tế nhị là họ ko thích làm cao thủ! Anh hiểu chửa???

[thuyvan0210 0]

Chào bạn thuyvan0210. Đây là Code mà Tue_NV viết theo ý của bạn. Hy vọng bạn hài lòng :

(defun c:SCD()
(vl-load-com)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 15359)

(setq olddim (getvar "dimzin"))

(setvar "dimzin" 0)
(setq mss (car(entsel "\n Chon mat so sanh :")))
(HLI mss)
(setq gtmss (getreal "\n Nhap gia tri mat so sanh :"))

(setq PL (car (entsel "\n Chon Pline :")))
(HLI PL)
(setq po (getpoint "\n Chon cac nut tren Polyline can ghi cao do :"))
(setq cao (getreal "\n Chon chieu cao chu :"))
(setq tp (getint "\n So chu so thap phan :"))

(while po

(setq po2 (vlax-curve-getClosestPointTo mss po))
(setq pot (list (car po2) (- (cadr po2) (/ cao 2)) 0))
(setq kc (+ (distance po po2) gtmss))
(Command "line" po po2 "")
(Command "style" "CADVIET" "TIMES.TTF" "0" "1" "0" "N" "N")
(Command "Text" "j" "BR" pot cao "90" (rtos kc 2 tp))
(HLI PL)
(setq po (getpoint "\n Chon cac nut tren Polyline can ghi cao do :"))

)
(setvar "dimzin" olddim)
(setvar "osmode" oldos)
(command "undo" "end")
(Princ)
)

;
(defun HLI(enT)
(sssetfirst (ssadd enT (ssadd)) (ssadd enT (ssadd)))
)

Trước tiên mình cảm ơn bạn! Nhưng mà đoạn lisp bạn viết nó cũng gần giống đoạn lisp của mình. Mình muốn chỉ chọn pline một lần duy nhất thôi, lisp sẽ tự định nghĩa các nút của pline đó, chứ ko phải chọn lại từng nút như vậy nữa. bạn xem lại hộ mình nhé!

[Tue_NV 3.912]

Trước tiên mình cảm ơn bạn! Nhưng mà đoạn lisp bạn viết nó cũng gần giống đoạn lisp của mình. Mình muốn chỉ chọn pline một lần duy nhất thôi, lisp sẽ tự định nghĩa các nút của pline đó, chứ ko phải chọn lại từng nút như vậy nữa. bạn xem lại hộ mình nhé!

Hy vọng lần này thì bạn hài lòng :

(defun c:SCD()
(vl-load-com)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)

(setq olddim (getvar "dimzin"))

(setvar "dimzin" 0)
(setq mss (car(entsel "\n Chon mat so sanh :")))
(HLI mss)
(setq gtmss (getreal "\n Nhap gia tri mat so sanh :"))

(setq PL (car (entsel "\n Chon Pline :")))
(HLI PL)

(setq pr (vlax-curve-getEndParam PL) i 0)

(setq cao (getreal "\n Chon chieu cao chu :"))
(setq tp (getint "\n So chu so thap phan :"))

(while (
(setq po (vlax-curve-getPointAtParam PL i))

(setq po2 (vlax-curve-getClosestPointTo mss po))
(setq pot (list (car po2) (- (cadr po2) (/ cao 2)) 0))
(setq kc (+ (distance po po2) gtmss))
(Command "line" po po2 "")
(Command "style" "CADVIET" "TIMES.TTF" "0" "1" "0" "N" "N")
(Command "Text" "j" "BR" pot cao "90" (rtos kc 2 tp))
(HLI PL)
(setq i (1+ i))

)
(setvar "dimzin" olddim)
(setvar "osmode" oldos)
(command "undo" "end")
(Princ)
)

;
(defun HLI(enT)
(sssetfirst (ssadd enT (ssadd)) (ssadd enT (ssadd)))
)

:mellow:

[thuyvan0210 0]

Hy vọng lần này thì bạn hài lòng :

 

cảm ơn bạn nhiều, lisp rất đúngý mình. bây giờ rất cần những người nhiệt tình như bạn

[conghoan1003 0]

Chào cả nhà!

Mình đang cần cái lisp chèn một ký tự phía trước hoặc phía sau tấc cả các text mình chọn. Ai có cho mình xin với. Cảm ơn nhiều!

Chúc mọi người tuần làm việc hiệu quả!

[duy782006 1.548]

Chào cả nhà!

Mình đang cần cái lisp chèn một ký tự phía trước hoặc phía sau tấc cả các text mình chọn. Ai có cho mình xin với. Cảm ơn nhiều!

Chúc mọi người tuần làm việc hiệu quả!

Xem đây:

http://www.cadviet.com/forum/index.php?showtopic=6991

[q288 166]

Chào cả nhà!

Mình đang cần cái lisp chèn một ký tự phía trước hoặc phía sau tấc cả các text mình chọn. Ai có cho mình xin với. Cảm ơn nhiều!

Chúc mọi người tuần làm việc hiệu quả!

 

Nói chung lisp kiểu này chắc có nhiều trên diễn đàn này rồi, tuy nhiên mình cũng làm thêm 1 cái nữa. Lisp này chọn text, mtext và thêm vào đầu hay cuối ký tự chèn.

(defun c:ckt()
 (vl-load-com)   
 (setq kt (getstring "Chen ky tu: ")
dc (strcase (getstring "Chen vao dau hay cuoi?  :") t)
	sst (ssget '((0 . "TEXT,MTEXT"))))
 (while (and sst (> (sslength sst) 0))
(setq ven (ssname sst 0)
  vob (vlax-ename->vla-object ven)
  txt (vla-get-TextString vob))

(if (= dc "d")
  (vla-put-TextString vob (strcat kt txt))
  (vla-put-TextString vob (strcat txt kt)))
(ssdel ven sst)
 )	
)

[oanhvang 0]

thanks các bạn

[q288 166]

Nhân tiện mình cũng bổ sung chèn ký tự cho cả DIM nữa.

Lệnh này khi hỏi chèn đầu hay cuối, nếu đầu thì gõ "d" , còn nếu cuối thì enter cũng chạy đc.

(defun c:ckt()
 (vl-load-com)   
 (setq kt (getstring "Chen ky tu: ")
dc (strcase (getstring "Chen vao dau hay cuoi?  :") t)
	sst (ssget '((0 . "TEXT,MTEXT,DIMENSION"))))
 (while (and sst (> (sslength sst) 0))
(setq ven (ssname sst 0)
  vob (vlax-ename->vla-object ven))

(if (member (vla-get-ObjectName vob) '("AcDbText" "AcDbMText"))
  (if (= dc "d")
	 (vla-put-TextString vob (strcat kt (vla-get-TextString vob)))
	 (vla-put-TextString vob (strcat (vla-get-TextString vob) kt)))	  
  (progn
	(if (= "" (setq to (vla-get-TextOverride vob)))
  (setq to "<>"))
	(if (= dc "d")
	 (vla-put-TextOverride vob (strcat kt to))
	 (vla-put-TextOverride vob (strcat to kt))))
)
(ssdel ven sst)
 )	
)

[nguyenkhoadung98 2]

chào cả nhà CADVIET, hồi trước mình có nhờ các bạn NDTVN, TUE_NV, THANHBINH viết cho mình cái lisp bắn cột đèn và bắn số cột đèn nôi dung của nó như sau :

nó sẽ tu dong rải cho mình 1 block trên 1 đoạn thẳng Pline hoặc SPline... sau đó nó sẽ đánh tên blog này theo thứ tự là T1/L1-1A rồi đến T1/L1-2B, T1/L1-3C, T1/L1-4A.....

 

bây giờ mình chỉ cần nó tu dong đánh số cho mình thôi mà kô cần rải blog kia nữa ( vì mình rải block sẵn rồi giờ chỉ đánh số thôi ) xin nhờ các bạn : lisp ấy đây

 

(defun GetDxf(n e) (cdr (assoc n e)))

(defun ModDxf(n v e)

(if (GetDxf n e)

(entmod (subst (cons n v) (assoc n e) e))

(entmod (append e (list (cons n v))))

)

)

 

(defun c:dsc ( / i k e ss plObj p0 p1 a0 a1 kc d d0 len om pre id inc pos asc las)

(defun TachTen(s)

(setq pre "T1/l1-" id 1 pos "" asc 97 las 0)

)

(defun TenCotKe()

(setq id (+ id inc))

(if asc (setq las (rem (1+ las) 3)))

(strcat pre (itoa id) pos (if asc (chr (+ asc las)) ""))

)

; Main program

(princ "\nChon doi tuong va text :")

(setq ss (ssget ) i -1)

(repeat (sslength ss)

(setq i (1+ i)e (entget (ssname ss i)) )

(if (= "INSERT" (GetDxf 0 e))

(setq p1 (GetDxf 10 e))

)

(if (= "TEXT" (GetDxf 0 e))

(progn (TachTen (GetDxf 1 e)) (setq k i) )

)

)

(setq plObj (car (entsel "\nHay chon duong polyline ")))

(if (not (and k plObj)) (quit))

(setq p0 (getpoint "\nChon diem goc de copy : "))

(if (not p0) (setq p0 p1))

(if (not (setq p0 (vlax-curve-getClosestPointTo plObj p0))) (quit))

(setq inc (getint "\nHay nhap he so tang giam <1> : "))

(if (not inc ) (setq inc 1) )

(setq d (getreal "\nChon khoang cach giua cac doi tuong: "))

(setq om (getvar "OSMODE")) (setvar "OSMODE" 0)

(setq a0 (angle '(0 0) (vlax-curve-getFirstDeriv plObj (vlax-curve-getParamAtPoint plObj p0))))

(setq d0 (vlax-curve-getDistAtPoint plObj p0))

(setq len (vlax-curve-getDistAtPoint plObj (vlax-curve-getEndPoint plObj)))

(if (< d0 (/ len 2))

(setq len (- len d0))

(setq len d0 d (- d))

)

(setq d0 (+ d0 d) i (fix (abs (/ len d))))

(while (and (> i 0) (setq p1 (vlax-curve-getpointatdist plObj d0)))

(setq a1 (angle '(0 0) (vlax-curve-getFirstDeriv plObj (vlax-curve-getParamAtPoint plObj p1))))

(command "COPY" ss "" p0 p0)

(command "MOVE" "P" "" p0 p1)

(command "ROTATE" "P" "" p1 (/ (* 180 (- a1 a0)) pi))

(setq e (entget (ssname ss k)))

(ModDxf 1 (TenCotKe) e)

(setq d0 (+ d0 d) p0 p1 a0 a1 i (1- i))

)

(setvar "OSMODE" om)

 

 

cam on cac ban

)

[phamthanhbinh 3.146]

chào cả nhà CADVIET, hồi trước mình có nhờ các bạn NDTVN, TUE_NV, THANHBINH viết cho mình cái lisp bắn cột đèn và bắn số cột đèn nôi dung của nó như sau :

nó sẽ tu dong rải cho mình 1 block trên 1 đoạn thẳng Pline hoặc SPline... sau đó nó sẽ đánh tên blog này theo thứ tự là T1/L1-1A rồi đến T1/L1-2B, T1/L1-3C, T1/L1-4A.....

 

bây giờ mình chỉ cần nó tu dong đánh số cho mình thôi mà kô cần rải blog kia nữa ( vì mình rải block sẵn rồi giờ chỉ đánh số thôi ) xin nhờ các bạn : lisp ấy đây

 

(defun GetDxf(n e) (cdr (assoc n e)))

(defun ModDxf(n v e)

(if (GetDxf n e)

(entmod (subst (cons n v) (assoc n e) e))

(entmod (append e (list (cons n v))))

)

)

 

(defun c:dsc ( / i k e ss plObj p0 p1 a0 a1 kc d d0 len om pre id inc pos asc las)

(defun TachTen(s)

(setq pre "T1/l1-" id 1 pos "" asc 97 las 0)

)

(defun TenCotKe()

(setq id (+ id inc))

(if asc (setq las (rem (1+ las) 3)))

(strcat pre (itoa id) pos (if asc (chr (+ asc las)) ""))

)

; Main program

(princ "\nChon doi tuong va text :")

(setq ss (ssget ) i -1)

(repeat (sslength ss)

(setq i (1+ i)e (entget (ssname ss i)) )

(if (= "INSERT" (GetDxf 0 e))

(setq p1 (GetDxf 10 e))

)

(if (= "TEXT" (GetDxf 0 e))

(progn (TachTen (GetDxf 1 e)) (setq k i) )

)

)

(setq plObj (car (entsel "\nHay chon duong polyline ")))

(if (not (and k plObj)) (quit))

(setq p0 (getpoint "\nChon diem goc de copy : "))

(if (not p0) (setq p0 p1))

(if (not (setq p0 (vlax-curve-getClosestPointTo plObj p0))) (quit))

(setq inc (getint "\nHay nhap he so tang giam : "))

(if (not inc ) (setq inc 1) )

(setq d (getreal "\nChon khoang cach giua cac doi tuong: "))

(setq om (getvar "OSMODE")) (setvar "OSMODE" 0)

(setq a0 (angle '(0 0) (vlax-curve-getFirstDeriv plObj (vlax-curve-getParamAtPoint plObj p0))))

(setq d0 (vlax-curve-getDistAtPoint plObj p0))

(setq len (vlax-curve-getDistAtPoint plObj (vlax-curve-getEndPoint plObj)))

(if (

(setq len (- len d0))

(setq len d0 d (- d))

)

(setq d0 (+ d0 d) i (fix (abs (/ len d))))

(while (and (> i 0) (setq p1 (vlax-curve-getpointatdist plObj d0)))

(setq a1 (angle '(0 0) (vlax-curve-getFirstDeriv plObj (vlax-curve-getParamAtPoint plObj p1))))

(command "COPY" ss "" p0 p0)

(command "MOVE" "P" "" p0 p1)

(command "ROTATE" "P" "" p1 (/ (* 180 (- a1 a0)) pi))

(setq e (entget (ssname ss k)))

(ModDxf 1 (TenCotKe) e)

(setq d0 (+ d0 d) p0 p1 a0 a1 i (1- i))

)

(setvar "OSMODE" om)

cam on cac ban

)

Chào bạn nguyenkhoadung98,

Đọc kỹ lisp của bác ndtvn, bạn sẽ thấy bác ấy copy cả đối tượng block và text sang vị trí mới. Như vậy để có thể làm như ý của bạn bạn phải tách được đối tượng block ra khỏi tập chọn ss trước khi copy. Nhưng vì bạn vẫn muốn còn đối tượng block này tại vị trí đầu tiên khi chọn nên theo mình bạn có thể làm như sau:

1/- Sau khi bạn đã lấy được điểm chèn của block p1, hãy copy block này một lần tại ngay vị trí p1 đó.

2/- Xóa đối tượng block này khỏi tập chọn SS.

Nhờ vậy khi copy tập chọn ss về vị trí mới, bạn sẽ không có các block kèm theo nữa mà chỉ còn text thôi bạn ạ.

 

Bạn hãy thêm các dòng code dưới đây vào bên dưới dòng code (setq p1 (GetDxf 10 e)) trong hàm điều kiện If bạn nhé rồi chạy thử xem có OK không.

(command "copy" e "" p1 p1)

(command "erase" e "")

)

À quên, bạn phải thêm dòng code (progn vào trước dòng (setq p1 (GetDxf 10 e)) nữa nhé.

Vì chưa có thời gian nên mình chưa kiểm lại được mong bạn thông cảm nếu có sai sót nhé.

Chúc bạn thành công.

[BigBill 11]

Nói chung lisp kiểu này chắc có nhiều trên diễn đàn này rồi, tuy nhiên mình cũng làm thêm 1 cái nữa. Lisp này chọn text, mtext và thêm vào đầu hay cuối ký tự chèn.

(defun c:ckt()
 (vl-load-com)   
 (setq kt (getstring "Chen ky tu: ")
dc (strcase (getstring "Chen vao dau hay cuoi?  :") t)
	sst (ssget '((0 . "TEXT,MTEXT"))))
 (while (and sst (> (sslength sst) 0))
(setq ven (ssname sst 0)
  vob (vlax-ename->vla-object ven)
  txt (vla-get-TextString vob))

(if (= dc "d")
  (vla-put-TextString vob (strcat kt txt))
  (vla-put-TextString vob (strcat txt kt)))
(ssdel ven sst)
 )	
)

không biết có ai biết lisp copy text ATT tăng dần không nhỉ,ví dụ e có 1 cái nút, đó là 1 block ATT, ngoài là 1 vòng tròn, trong là text ATT, bây giờ mình muốn copy nút này và text ATT nhảy theo?Mong mọi người giúp đỡ

[Tue_NV 3.912]

không biết có ai biết lisp copy text ATT tăng dần không nhỉ,ví dụ e có 1 cái nút, đó là 1 block ATT, ngoài là 1 vòng tròn, trong là text ATT, bây giờ mình muốn copy nút này và text ATT nhảy theo?Mong mọi người giúp đỡ

Bạn hãy đọc bài viết này nhé : Lisp copy tang dan vowi Block ATT

:mellow:

[baodenhp 0]

Mình muốn ghi nhãn đường đồng mức như file http://www.cadviet.com/upfiles/nhan_DM.dwg ai có thể giúp mình với.

[nguyenkhoadung98 2]

Chào bạn nguyenkhoadung98,

Đọc kỹ lisp của bác ndtvn, bạn sẽ thấy bác ấy copy cả đối tượng block và text sang vị trí mới. Như vậy để có thể làm như ý của bạn bạn phải tách được đối tượng block ra khỏi tập chọn ss trước khi copy. Nhưng vì bạn vẫn muốn còn đối tượng block này tại vị trí đầu tiên khi chọn nên theo mình bạn có thể làm như sau:

1/- Sau khi bạn đã lấy được điểm chèn của block p1, hãy copy block này một lần tại ngay vị trí p1 đó.

2/- Xóa đối tượng block này khỏi tập chọn SS.

Nhờ vậy khi copy tập chọn ss về vị trí mới, bạn sẽ không có các block kèm theo nữa mà chỉ còn text thôi bạn ạ.

 

Bạn hãy thêm các dòng code dưới đây vào bên dưới dòng code (setq p1 (GetDxf 10 e)) trong hàm điều kiện If bạn nhé rồi chạy thử xem có OK không.

(command "copy" e "" p1 p1)

(command "erase" e )

)

À quên, bạn phải thêm dòng code (progn vào trước dòng (setq p1 (GetDxf 10 e)) nữa nhé.

Vì chưa có thời gian nên mình chưa kiểm lại được mong bạn thông cảm nếu có sai sót nhé.

Chúc bạn thành công.

 

 

thanks bạn BINH, mình đã thử nhưng mà kô đuợc bạn ah, thực ra trong lisp ấy mình chỉ chọn têxt kô thôi thì nó cũng chỉ bắn text cho mình thôi, nhưng mà ý mình muốn text nó phải đứng cạnh block như cái ban đầu cơ, ở trong bản vẽ mình đã thể hiện :mellow: cảm ơn các bạn

 

 

http://www.mediafire.com/file/zxv4nvnjnmz/Drawing11.dwg

[phamthanhbinh 3.146]

thanks bạn BINH, mình đã thử nhưng mà kô đuợc bạn ah, thực ra trong lisp ấy mình chỉ chọn têxt kô thôi thì nó cũng chỉ bắn text cho mình thôi, nhưng mà ý mình muốn text nó phải đứng cạnh block như cái ban đầu cơ, ở trong bản vẽ mình đã thể hiện :mellow: cảm ơn các bạn

http://www.mediafire.com/file/zxv4nvnjnmz/Drawing11.dwg

Xin lỗi bạn nguyen khoadung98.

Do vội nên đoạn code trước mình viết thiếu hai dâu "" trong hàm (command "erase" e) bạn ạ nên chắc khi bạn load lisp nó báo lỗi. Bạn thử sửa nó thành (command "erase" e "") xem sao.

Việc bạn muốn vị trí tương đối của text với block giữ nguyên thực ra là điều khá khó khăn vì để làm được điều đó cần xác định vị trí tương đối giữa điểm chèn của block và điểm chèn của text. Không những thế bạn còn phải xác định góc quay tương đối của chúng tại từng vị trí chèn so với vị trí ban đầu, rồi tính toán tọa độ điểm chèn mới của text sao cho phù hợp với góc quay đó và vẫn đảm bảo text không bị lộn ngược.

Việc này mình đã nói trước đây rồi. Bác ndtvn đã xử lý bằng cách copy chung cả text và block và như vậy là bác ấy đã chấp nhận ở một số trường hợp đặc biệt text và block sẽ cùng chổng tu đúng không bạn. Nay bạn lại tách rời chúng ra, nên gay thiệt. Việc giải bài toán lượng giác này (sin (a-:mellow:, cos(a-:cheers:.... rồi lúc thì cộng lúc thì trừ làm mình rối mù chưa gỡ ra được bạn ạ.

Hy vọng bạn hay các bác khác sẽ có cách giải quyết vấn đề triệt để hơn.

Chúc bạn vui.

[nguyenkhoadung98 2]

Xin lỗi bạn nguyen khoadung98.

Do vội nên đoạn code trước mình viết thiếu hai dâu "" trong hàm (command "erase" e) bạn ạ nên chắc khi bạn load lisp nó báo lỗi. Bạn thử sửa nó thành (command "erase" e "") xem sao.

Việc bạn muốn vị trí tương đối của text với block giữ nguyên thực ra là điều khá khó khăn vì để làm được điều đó cần xác định vị trí tương đối giữa điểm chèn của block và điểm chèn của text. Không những thế bạn còn phải xác định góc quay tương đối của chúng tại từng vị trí chèn so với vị trí ban đầu, rồi tính toán tọa độ điểm chèn mới của text sao cho phù hợp với góc quay đó và vẫn đảm bảo text không bị lộn ngược.

Việc này mình đã nói trước đây rồi. Bác ndtvn đã xử lý bằng cách copy chung cả text và block và như vậy là bác ấy đã chấp nhận ở một số trường hợp đặc biệt text và block sẽ cùng chổng tu đúng không bạn. Nay bạn lại tách rời chúng ra, nên gay thiệt. Việc giải bài toán lượng giác này (sin (a-:mellow:, cos(a-:cheers:.... rồi lúc thì cộng lúc thì trừ làm mình rối mù chưa gỡ ra được bạn ạ.

Hy vọng bạn hay các bác khác sẽ có cách giải quyết vấn đề triệt để hơn.

Chúc bạn vui.

 

 

đúng thế bạn ah, quả này chắc khó khăn đây, đành hài lòng với cái mình đã có vạy thôi :mellow: cảm ơn bạn rất nhiều :cheers:

[oanhvang 0]

chào các bạn CADVIET, hôm nay mình nhờ các bạn viết giúp mình 1 lisp như thế này: mình có 1 lisp dùng để nối các đoạn PLINE với nhau lisp ấy đây :

 

(defun c:nn (/ tdt ssdt sodt index)

(defun ObjName (ssdt /)

(cdr (assoc '0 (entget ssdt)))

)

(defun MoPL (ssdt /)

(= (cdr (assoc '70 (entget ssdt))) 0)

)

(defun NoiPL (ssdt /)

(if (MoPL ssdt)

(command ".PEDIT" ssdt "J" "All" "" "X")

)

)

(defun NoiLC (ssdt /)

(command ".PEDIT" ssdt "Y" "J" "All" "" "X")

)

(setq

tdt (ssget)

sodt (sslength tdt)

index 0

)

(repeat sodt

(setq

ssdt (ssname tdt index)

index (1+ index)

)

(if (or (= (Objname ssdt) "LWPOLYLINE")

(= (Objname ssdt) "POLYLINE")

)

(NoiPL ssdt)

)

(if (or (= (Objname ssdt) "LINE") (= (Objname ssdt) "ARC"))

(NoiLC ssdt)

)

)

(princ)

)

 

 

bây h bản vẽ của mình bao gồm các PLINE nhưng mà nó lại bị cắt đi 1 đoạn nhỏ hoặc là bị chéo nhau 1 đoạn nhỏ. với kiểu như vậy thì lisp này nó kô nối được ( lại phải dùng lệnh PE hoặc filet ), mình mong các bạn cải tiến cái lisp này cho mình để sao cho nó có thể nối được luôn những đoạn như vậy mà kô cần phải dùng lệnh PE hoặc filet, mình gửi cùng bản vẽ. cảm ơn các bạn nhiều

 

 

http://www.2shared.com/file/5880987/fc9ffd08/Drawing1.html

[thiep 365]

Mình muốn ghi nhãn đường đồng mức như file http://www.cadviet.com/upfiles/nhan_DM.dwg ai có thể giúp mình với.

Lisp này giúp cho bạn gần được như ý muốn:

http://www.cadviet.com/upfiles/TEXT_CAODO.lsp

Đây là bản vẽ của bạn, tôi đã test, trong đó, tôi có tạo block là "wip"

http://www.cadviet.com/upfiles/nhan_DM_1.dwg

Tuy nhiên, vì text contuor của bạn là 1 group gồm 1 đối tượng wipeout và 1 đối tượng text, tôi chưa biết tạo mã cho group này. Có ai biết thì ra tay giúp với, cho dòng sông này chảy trôi êm đềm.

[conghoan1003 0]

Chào cả nhà!

mình có cái lisp tính diện tích nhưng có hai điểm bất tiện như sau:

1. Phải klick vào vùng diện tích nào nằm trong vùng thấy của màn hình thì mới thực hiện được nếu không thì báo lỗi (giống như lệnh hatch trong cad 2004).

2. Sau khi lỗi thì nó sẽ tự động tắt tấc cả các truy bắt điểm (Object snap).

Ai biết giúp mình khắc phục lỗi này với. (cố gắng giữ lại mấy lệnh cũ giúp mình nghe, mình chưa học lisp nên mọi người làm hoanf thiện giúp mình nghe)

Cảm ơn nhiều!

Đoạn mã lệnh nè:

(defun DXF (code elist)

(cdr (assoc code elist))

);dxf

 

(defun c:AR(/ dtl dtcon pt1 pt2 ss et oslast vsize)

(if (= tl nil) (progn

(setq tl (getreal "\nDrawing scale : "))

; (setq ntl (/ 1000 tl))

; (setq tl2 (* ntl ntl))

)

)

(setq dtl 0)

(setq ss (ssadd))

(setq oslast (getvar "OSMODE"))

(command "osnap" "")

(setq ntl (/ 1000 tl))

(setq tl2 (* ntl ntl))

 

(print)

(print)

(setq pt1 (getpoint "\nPick internal point : "))

(while (/= pt1 nil)

(command "-boundary" pt1 "")

(setq et (entlast))

(ssadd et ss)

(command "area" "e" "last")

(setq vsize ( /(getvar "VIEWSIZE") 5))

(command "hatch" "SOLID" vsize "0" "l" "")

(setq et (entlast))

(ssadd et ss)

(setq dtcon (/ (getvar "AREA") tl2))

(setq dtl (+ dtcon dtl))

(prompt (strcat "\nComponent area : " (rtos dtcon 2 4)))

(print)

(print)

(setq pt1 (getpoint "\nPick internal point : "))

)

(command "setvar" "OSMODE" oslast)

(command "erase" ss "")

(setq ss nil)

(command "redraw")

; (setq dtl (/ (/ dtl tl2) 2))

; (setq dtl (/ dtl 2))

(print)

(prompt (strcat "\nTotal area : " (rtos dtl 2 4)))

(print)

(setq pt2 (getpoint "\nPoint to write: "))

(if (/= 0 (DXF 40 (tblsearch "STYLE" (getvar "TEXTSTYLE"))))

(command "text" pt2 "0" (rtos dtl 2 2))

(command "text" pt2 "2" "0" (rtos dtl 2 2))

);if

(princ)

);defun AR

;------------------------------------------------------------------------

(defun c:AR2(/ dtl dtcon pt1 pt2 ss et oslast vsize)

(if (= tl nil) (progn

(setq tl (getreal "\nDrawing scale : "))

; (setq ntl (/ 1000 tl))

; (setq tl2 (* ntl ntl))

)

)

(setq dtl 0)

(setq ss (ssadd))

(setq oslast (getvar "OSMODE"))

(command "osnap" "")

(setq ntl (/ 1000 tl))

(setq tl2 (* ntl ntl))

 

(print)

(print)

(setq pt1 (getpoint "\nPick internal point : "))

(while (/= pt1 nil)

(command "-boundary" pt1 "")

(setq et (entlast))

(ssadd et ss)

(command "area" "e" "last")

(setq vsize ( /(getvar "VIEWSIZE") 5))

(command "hatch" "ANSI31" vsize "0" "last" "")

(setq et (entlast))

(ssadd et ss)

(setq dtcon (/ (getvar "AREA") tl2))

(setq dtl (+ dtcon dtl))

(prompt (strcat "\nComponent area : " (rtos dtcon 2 4)))

(print)

(print)

(setq pt1 (getpoint "\nPick internal point : "))

)

(command "setvar" "OSMODE" oslast)

(command "erase" ss "")

(setq ss nil)

(command "redraw")

; (setq dtl (/ (/ dtl tl2) 2))

(setq dtl (/ dtl 2))

(print)

(prompt (strcat "\nHaft total area : " (rtos dtl 2 4)))

(print)

(setq pt2 (getpoint "\nPoint to write: "))

(if (/= 0 (DXF 40 (tblsearch "STYLE" (getvar "TEXTSTYLE"))))

(command "text" pt2 "0" (rtos dtl 2 2))

(command "text" pt2 "2" "0" (rtos dtl 2 2))

);if

(princ)

);defun AR2

;-------------------------------------------------------------------------------

(defun C:vd()

(print)

(print)

(print)

(setq last (getvar "OSMODE"))

(command "setvar" "OSMODE" "33")

(command "setvar" "DIMZIN" 0 )

 

(if (= tl nil) (setq tl (getreal "Ty le ban ve : ")))

 

(setq PT1 (getpoint "Diem 1 : "))

; (setq PT2 (getpoint "Diem 2 : "))

; (setq dist1 (distance pt1 pt2))

; (setq ntl (/ 1000 tl))

; (setq dist (/ dist1 ntl))

(setq sum 0)

 

(while (/= pt1 nil)

(setq PT2 (getpoint "Diem 2 : "))

(print)

(setq dist1 (distance pt1 pt2))

(setq ntl (/ 1000 tl))

(setq dist (/ dist1 ntl))

(prompt (strcat "\n Chieu dai doan vua do la " (rtos dist 2 4)))

(print)

(setq sum (+ sum dist))

(setq PT1 (getpoint "Diem 1 : "))

);while

 

(prompt (strcat "\n Tong chieu dai la " (rtos sum 2 4)))

(print)

(command "setvar" "OSMODE" "64")

(setq pt3 (getpoint "Viet vao cho nao ? : "))

;(setq x (+ (car pt3) 2))

;(setq pt3 (list x (cadr pt3)))

(setq sum2 (/ sum 2))

 

(command "text" "S" "2" pt3 "0" (rtos sum2 2 2))

 

(command "setvar" "OSMODE" last)

(princ)

)

 

(prompt "\n Start with AR to calculate area by pick points method")

(prompt "\n Start with AR2 to calculate haft area by pick points method")

(prompt "\n Danh VD de tinh tong chieu dai ")

(prompt "\n This version is used for Nguyen Cong Hoan-Cienco 625 only - 25/05/2007")

(princ)

[q288 166]

chào các bạn CADVIET, hôm nay mình nhờ các bạn viết giúp mình 1 lisp như thế này: mình có 1 lisp dùng để nối các đoạn PLINE với nhau lisp ấy đây :

bây h bản vẽ của mình bao gồm các PLINE nhưng mà nó lại bị cắt đi 1 đoạn nhỏ hoặc là bị chéo nhau 1 đoạn nhỏ. với kiểu như vậy thì lisp này nó kô nối được ( lại phải dùng lệnh PE hoặc filet ), mình mong các bạn cải tiến cái lisp này cho mình để sao cho nó có thể nối được luôn những đoạn như vậy mà kô cần phải dùng lệnh PE hoặc filet, mình gửi cùng bản vẽ. cảm ơn các bạn nhiều

http://www.2shared.com/file/5880987/fc9ffd08/Drawing1.html

 

Bạn thử cái này xem sao.

(defun c:nn (/ tdt ssdt sodt index)
 (defun ObjName (ssdt /)  (cdr (assoc '0 (entget ssdt)))  )
 (defun MoPL (ssdt /)  (= (cdr (assoc '70 (entget ssdt))) 0))
 (defun NoiPL (ssdt /)
(if (MoPL ssdt)
 (COMMAND ".PEDIT" "M" tdt "" "J" "10" "")))
 (defun NoiLC (ssdt /) (COMMAND ".PEDIT" "M" tdt "" "Y" "J" "10" ""))

 (setq tdt (ssget)
ssdt  (ssname tdt 0))
 (if (or (= (Objname ssdt) "LWPOLYLINE")
	  (= (Objname ssdt) "POLYLINE"))
  (NoiPL ssdt)
 )
 (if	(or (= (Objname ssdt) "LINE") (= (Objname ssdt) "ARC"))
  (NoiLC ssdt)
 )
 (princ)
)

[oanhvang 0]

Bạn thử cái này xem sao.

(defun c:nn (/ tdt ssdt sodt index)
 (defun ObjName (ssdt /)  (cdr (assoc '0 (entget ssdt)))  )
 (defun MoPL (ssdt /)  (= (cdr (assoc '70 (entget ssdt))) 0))
 (defun NoiPL (ssdt /)
(if (MoPL ssdt)
 (COMMAND ".PEDIT" "M" tdt "" "J" "10" "")))
 (defun NoiLC (ssdt /) (COMMAND ".PEDIT" "M" tdt "" "Y" "J" "10" ""))

 (setq tdt (ssget)
ssdt  (ssname tdt 0))
 (if (or (= (Objname ssdt) "LWPOLYLINE")
	  (= (Objname ssdt) "POLYLINE"))
  (NoiPL ssdt)
 )
 (if	(or (= (Objname ssdt) "LINE") (= (Objname ssdt) "ARC"))
  (NoiLC ssdt)
 )
 (princ)
)

 

 

cảm ơn bạn nhiều, lisp này theo mình hiểu là với những đoạn cách nhau hoac chéo nhau có độ dài 10 thì nó mới đc phải kô bạn, liệu có thể cho việc chọn độ dài để nối được ấy vào 1 option của lisp đc kô bạn, cảm ơn bạn lần nữa

[xuandao0708 9]

Hic, em là 1 người mới biết trang này, sau khi đọc 3 ngày thi được 35 trang thì thấy có những Bác rất giỏi về Lisp như: Nguyen Hoang, ssq, vvdesperados, duy78206..... Hi vọng sau khi đọc được đến bài cuối thì em sẽ học hỏi được nhiều điều bổ ích. Cá mơn các Bác đã giúp đỡ mọi người rất nhiều.

[Tue_NV 3.912]

cảm ơn bạn nhiều, lisp này theo mình hiểu là với những đoạn cách nhau hoac chéo nhau có độ dài 10 thì nó mới đc phải kô bạn, liệu có thể cho việc chọn độ dài để nối được ấy vào 1 option của lisp đc kô bạn, cảm ơn bạn lần nữa

Bạn thử cái này xem :

(defun c:nn (/ tdt ssdt sodt index)

(defun ObjName (ssdt /) (cdr (assoc '0 (entget ssdt))) )

(defun MoPL (ssdt /) (= (cdr (assoc '70 (entget ssdt))) 0))

(defun NoiPL (ssdt kn /)
(if (MoPL ssdt)
(COMMAND ".PEDIT" "M" tdt "" "J" kn "")))

(defun NoiLC (ssdt kn /) (COMMAND ".PEDIT" "M" tdt "" "Y" "J" kn ""))

(setq tdt (ssget)
ssdt (ssname tdt 0))
(setq knoi (getreal "\n Chon khoang noi :"))

(if (or (= (Objname ssdt) "LWPOLYLINE")
(= (Objname ssdt) "POLYLINE"))
(NoiPL ssdt knoi)
)
(if (or (= (Objname ssdt) "LINE") (= (Objname ssdt) "ARC"))
(NoiLC ssdt knoi)
)
(princ)
)