Jump to content
InfoFile
Tác giả: dunguss3581
Bài viết gốc: 196972
Tên lệnh: mm
move đối tượng không đổi cao độ


anh em sửa giùm cái lisp này toi không hiểu sao không nhận lênh move

Filename: 196972_mm.lsp
Tác giả: dunguss3581
Bài viết gốc: 196978
Tên lệnh: mm
move đối tượng không đổi cao độ


các bác ơi em dùng lisp này move nhưng đối tượng move vẫn bị thay đổi cao độ. giúp tôi với

Filename: 196978_mm.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 196992
Tên lệnh: knut gn
Lisp xuất thông số của đường ra block thuộc tính

Sửa như vậy xem sao.

Filename: 196992_knut_gn.lsp
Tác giả: ssg
Bài viết gốc: 6859
Tên lệnh: ll
Viết Lisp theo yêu cầu

Mình không bao giờ bỏ qua bước test khi lập trình. Tuy nhiên, cũng có thể là chưa lường hết các trường hợp có thể xảy ra. Nghe bạn phản hồi, mình đã test lại, kết quả vẫn đúng! Chả hiểu trên máy bạn thế nào!
Thôi được, bạn hãy delete toàn bộ "tàn tích" của các code trước đây, thay bằng đoạn sau. Hy vọng là sẽ đúng ý trong mọi trường hợp:


Filename: 6859_ll.lsp
Tác giả: ketxu
Bài viết gốc: 131138
Tên lệnh: df
Nhờ viết hộ lisp chia trần siêu tốc

E bị loạn rồi ^^ Bác Tuệ gửi phần mềm quay phim e với :")
Dvx và Dvy > 305 chứ ạ ^^
Vì yêu cầu của bạn ý chốt tấm sàn ngoài lớn hơn 305x305 nên e k để là kcv /2

P/S : 3 anh em mình test khác nhau có lẽ do vài thằng biến không hợp nhau


Bạn test lại xem sao

Filename: 131138_df.lsp
Tác giả: ketxu
Bài viết gốc: 135150
Tên lệnh: gl
Cho em hỏi về TOLERANCE!

Mình vẫn chưa hiểu ý bạn nói " cái cần là cái đó " tức là sao ? Tức là bạn cần link để lúc bạn thay đổi nó sẽ đổi theo , hay cần lấy cái đoạn text ra thôi ?? Nếu cần, có thể tạo lại toàn bộ các TOL này bằng text và HCN bao quanh, rồi link nội dung, e là lâu ^^
Trước hết bạn dùng thử cái này để copy nội dung TOL vào sau đoạn text bạn cần đã

Filename: 135150_gl.lsp
Tác giả: phamngoctukts
Bài viết gốc: 113215
Tên lệnh: xemdl
Dung lượng bản vẽ trong miền chọn???

Của bạn đây. Lệnh là xemdl. Chúc bạn vui.

Filename: 113215_xemdl.lsp
Tác giả: nguyentienthanhddksct
Bài viết gốc: 197042
Tên lệnh: gcoor
Lệnh Polyline và Lwpolyne

Nếu có lỗi thì bạn thông báo cho mọi người để cả nhà cùng chữa hỏa. để nhà nước khỏi mất tiền để xây cho anh em ta căn biệt thự bằng đá phiến.
Nhân tiện cho mình hỏi luôn. Lisp đang chỉ thực hiện khi là LWPOLYLINE giờ muốn nó thực hiện luôn với POLYLINE thì làm thế nào.
VD lisp này của Mr. PhamThanhBinh. với POLYLINE thì ko thực hiện được

;; free lisp from...
>>

Nếu có lỗi thì bạn thông báo cho mọi người để cả nhà cùng chữa hỏa. để nhà nước khỏi mất tiền để xây cho anh em ta căn biệt thự bằng đá phiến.
Nhân tiện cho mình hỏi luôn. Lisp đang chỉ thực hiện khi là LWPOLYLINE giờ muốn nó thực hiện luôn với POLYLINE thì làm thế nào.
VD lisp này của Mr. PhamThanhBinh. với POLYLINE thì ko thực hiện được

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=63126&pid=195881&st=0&#entry195881

(defun c:gcoor (/ oldos k k1 p pl pls1 pmin pmax plst sc sh p1el ss1 ssl1 ssl2)
(Init)
(vl-load-com)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
;;; Ve duong bao
;;;(command "pline")
;;;(While (setq p (getpoint "\n chon lan luot cac dinh cua duong bao"))
;;; (command p)
;;;)
;;;(command "c")
(setq pl (car (entsel "\n Pick chon duong bao " ))
pls1 (acet-ent-geomextents pl)
pmin (list (* (1- (fix (/ (caar pls1) k1))) k1) (* (1- (fix (/ (cadar pls1) k1))) k1))
pmax (list (* (1+ (fix (/ (caadr pls1) k1))) k1) (* (1+ (fix (/ (cadadr pls1) k1))) k1))
)
;;;;;;Tao danh sach diem grid
(setq plst (list pmin)
sc 1)
(while (<= (+ (car pmin) (* sc k1)) (car pmax))
(setq p (list (+ (car pmin) (* sc k1)) (cadr pmin))
plst (append plst (list p))
sc (1+ sc)
)
)
(foreach p plst
(setq sh 1)
(while (<= (+ (cadr p) (* sh k1)) (cadr pmax))
(setq p1 (list (car p) (+ (cadr p) (* sh k1)))
plst (append plst (list p1))
sh (1+ sh)
)
)
)
plst
;;;;;;;;;;; Tao grid
(setq el (entlast)
ss1 (ssadd))
(foreach p plst
(xy p)
)
;;;; Loc grid
(while (setq el (entnext el))
(setq ss1 (ssadd el ss1))
)
(setq ssl1 (acet-ss-to-list ss1))
(setq ppl (list)
par 0
pob (vlax-ename->vla-object pl) )
(while (<= par (vlax-curve-getendparam pob))
(setq pa (vlax-curve-getpointatparam pob par)
ppl (append ppl (list pa))
par (+ par 0.1)
)
)
(setq ssl2 (acet-ss-to-list (ssget "cp" ppl )))
(foreach x ssl1
(if (not (member x ssl2))
(entdel x)
)
)


(setvar "osmode" oldos)
(command "undo" "e")
(Reinit)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;CT chich toa do tren ban do
;;;
(Defun Init()
(setvar "BLIPMODE" 0)
(setvar "CMDECHO" 0)
(setvar "LUPREC" 0)
(setq stl "standard")
(setq k (getint "\n nhap ty le ban do: ") k1 (/ k 10) ) (setq scale k)
(setq hi (* 0.002 scale))
(setq wi 0.9)
)
(Defun Reinit()
(setvar "BLIPMODE" 1)
(setvar "CMDECHO" 1)
(setvar "LUPREC" 4)
(princ)
)
(Defun XY( pt / x y xx yy ptx pty)


(setq y (car pt))
(setq x (cadr pt))
(command "_Line"
(list (- y (* 0.0025 scale)) x 0.0)
(list (+ y (* 0.012 scale)) x 0.0) ""
)
(command "_Line"
(list y (- x (* 0.0025 scale)) 0.0)
(list y (+ x (* 0.0025 scale)) 0.0) ""
)
(setq xx (rtos x 2))
(setq yy (rtos y 2))
(setq pt y)
(setq y x)
(setq x pt)
(setq ptx (list (+ x (* 0.001 scale)) (- y (* 0.0025 scale)) 0.0))
(setq pty (list (+ x (* 0.0025 scale)) (+ y (* 0.001 scale)) 0.0))
(Maketext ptx 0 xx)
(Maketext pty 90 yy)

)
(Defun Maketext( diem ang string / etd)
(setq edt (list (cons 0 "text")
(cons 8 "GhichuTD")
(cons 62 5)
(cons 10 diem)
(cons 1 string)
(cons 7 stl)
(cons 40 hi)
(cons 41 wi)
(cons 50 (/ (* ang PI) 180.0))
)
)
(entmake edt)
)


<<

Filename: 197042_gcoor.lsp
Tác giả: ketxu
Bài viết gốc: 197117
Tên lệnh: test
Lisp insert field file name bỏ đi một số ký tự
Vinh dự nhá ^^
http://www.cadviet.com/forum/index.php?showtopic=15687&view=findpost&p=197113

Về yêu cầu của bạn thì đây :

(defun c:test()(vl-load-com)
(vla-addmtext (vla-get-block (vla-get-activelayout(vla-get-activedocument (vlax-get-acad-object))))
(vlax-3d-point (getpoint "\nDiem chen Field"))
1
(strcat "%<$(substr, $(getvar, dwgname), 1 ,$(-, $(strlen,...
>>
Vinh dự nhá ^^
http://www.cadviet.com/forum/index.php?showtopic=15687&view=findpost&p=197113

Về yêu cầu của bạn thì đây :

(defun c:test()(vl-load-com)
(vla-addmtext (vla-get-block (vla-get-activelayout(vla-get-activedocument (vlax-get-acad-object))))
(vlax-3d-point (getpoint "\nDiem chen Field"))
1
(strcat "%<$(substr, $(getvar, dwgname), 1 ,$(-, $(strlen, $(getvar, dwgname))," (itoa (getint "\nSo ky tu muon cat bot:")) ")) >%")
))

<<

Filename: 197117_test.lsp
Tác giả: Snowman
Bài viết gốc: 24571
Tên lệnh: c m ucd xc
Cho em hỏi chút về lệnh battman
Mình sơ suất một chút nên đã tắt chế độ bắt điểm khi dùng copy (tránh paste nhầm sang vị trí khác). Nhưng có lẽ không cần thiết
Đây là lisp đã sửa

Filename: 24571_c_m_ucd_xc.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 197286
Tên lệnh: gifpr
viết lisp lấy tọa độ điểm và tên điểm

Hề hề hề,
Đây là lisp dùng để lấy danh sách tọa độ các điểm cùng với mã tên điểm như bạn yêu cầu, Tuy nhiên có vẻ như bạn không cần nữa. Dù sao thì cũng đã lỡ mần nên cứ gửi lên đây. Hy vọng sẽ có ích cho ai đó cần quan tâm tới nó.
Mình chả hiểu TOPO nó là cái giống oẳn tà roằn nào nên chả biết lisp này có xài được trên đó hay không.
Còn trên bản vẽ...
>>

Hề hề hề,
Đây là lisp dùng để lấy danh sách tọa độ các điểm cùng với mã tên điểm như bạn yêu cầu, Tuy nhiên có vẻ như bạn không cần nữa. Dù sao thì cũng đã lỡ mần nên cứ gửi lên đây. Hy vọng sẽ có ích cho ai đó cần quan tâm tới nó.
Mình chả hiểu TOPO nó là cái giống oẳn tà roằn nào nên chả biết lisp này có xài được trên đó hay không.
Còn trên bản vẽ CAD như chủ thớt đã gửi thì nó chạy cũng coi được. Sau khi đã có cái danh sách này thì tùy theo yêu cầu mà các bác có thể xử lý thêm giấm thêm ớt cho nó vừa với cái khẩu vị của các bác vậy.
Hề hề hề,...


Vì là chả biết có ai còn quan tâm nữa nên mình cũng chả thèm khử biến nữa. Điều này nếu ai cần có thể tự xử lý được mà, Chỉ nhắc vậy để mọi người lưu ý.
Hề hề hề,..
<<

Filename: 197286_gifpr.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 197296
Tên lệnh: gifpr
viết lisp lấy tọa độ điểm và tên điểm

Hề hề hề,
Chuyện đưa nó ra file csv chả khó khăn gì. Trên diễn đàn đã có rất nhiều file để chguye63n số liệu từ một list (danh sách) sang file csv, txt, xls rồi mà. Chỉ thêm vài dòng code nữa là Ok.
Bạn đã nói vậy thì chờ chút, giờ hết giờ rùi, mình phải chuồn, tối về sẽ post cho bạn.
Chúc bạn vui...

Hề hề hề,
Nó đây bạn ạ:


Bạn...
>>

Hề hề hề,
Chuyện đưa nó ra file csv chả khó khăn gì. Trên diễn đàn đã có rất nhiều file để chguye63n số liệu từ một list (danh sách) sang file csv, txt, xls rồi mà. Chỉ thêm vài dòng code nữa là Ok.
Bạn đã nói vậy thì chờ chút, giờ hết giờ rùi, mình phải chuồn, tối về sẽ post cho bạn.
Chúc bạn vui...

Hề hề hề,
Nó đây bạn ạ:


Bạn hãy thử và nếu cần bổ sung gì thì post lên nhé.
<<

Filename: 197296_gifpr.lsp
Tác giả: gia_bach
Bài viết gốc: 81930
Tên lệnh: mmo
Viết lisp theo yêu cầu [phần 2]

Hạn chế của lệnh MULTIPLE : You cannot use MULTIPLE as an argument to the AutoLISP® command function.

- yêu cầu "move đối tượng theo phương khác cũng với cùng khoảng cách"
Trong yêu cầu này khi sử dụng hàm ACET-SS-DRAG-MOVE vấn đề phát sinh là chặn di chuyển đối tượng theo hướng của dây tóc chuột trong phạm vi bán kính = khoảng cách

Filename: 81930_mmo.lsp
Tác giả: ketxu
Bài viết gốc: 197357
Tên lệnh: gifpr
viết lisp lấy tọa độ điểm và tên điểm
Giảm thao tác Undo và cmdecho thì sẽ giảm được 1 nửa time :)

(defun c:gifpr (/ ss n plst i en el p ma k tmp fw val)
(defun val (a e)(cdr (assoc a (entget e))))
(defun cont(e / tmp)(substr (setq tmp (val 1 e)) (+ 4 (vl-string-search "\\l" tmp))))
(vl-load-com)
(setq Start (getvar "Millisecs"))
(setvar...
>>
Giảm thao tác Undo và cmdecho thì sẽ giảm được 1 nửa time :)

(defun c:gifpr (/ ss n plst i en el p ma k tmp fw val)
(defun val (a e)(cdr (assoc a (entget e))))
(defun cont(e / tmp)(substr (setq tmp (val 1 e)) (+ 4 (vl-string-search "\\l" tmp))))
(vl-load-com)
(setq Start (getvar "Millisecs"))
(setvar 'cmdecho 0)
(command "undo" "Mark")
(setq ss (ssget (list (cons 0 "acad_proxy_entity")))
n (sslength ss)
plst (list)
i -1
tmp (getfiled "Chon file xuat Text goc" (getvar "dwgprefix") "csv" 1)
fw (open tmp "w")
)
(while (< i n)
(setq en (entlast))
(command "explode" (ssname ss (setq i (1+ i))))
(while (setq en (entnext en))
(cond ((= (val 0 en) "CIRCLE") (setq p (val 10 en)))
(T (if (= (val 62 en) 2)(setq num (cont en))(setq nm (cont en))))
)
)
(write-line (strcat num (chr 44) nm (chr 44) (apply 'strcat (mapcar '(lambda(x)(strcat (rtos x 2 2) (chr 44))) p))) fw)

)
(close fw)
(command "undo" "back")
(setq End (getvar "Millisecs"))
(alert (vl-princ-to-string (* (- end start) 0.001)))
(princ)
)

<<

Filename: 197357_gifpr.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 197376
Tên lệnh: ha3
Lisp Ghép Text Cần Giúp Đỡ

Đây bạn!

Filename: 197376_ha3.lsp
Tác giả: Demigod
Bài viết gốc: 197393
Tên lệnh: csum
Lisp lọc các số sau chữ L, rồi tính tổng.
Tặng mọi người Lisp giải bài toán này.
Lệnh: Csum
- Xuất thống kê (txt hoặc excel).
- Có 2 tùy chọn để nhặt đối tượng (TEXT và MTEXT)
M: chọn 1 text mẫu -> trình tự động nhặt tất cả
C: Chọn trên màn hình
- Xuất txt chọn: T
Xuất Excel chọn: E

Good Luck
>>
Tặng mọi người Lisp giải bài toán này.
Lệnh: Csum
- Xuất thống kê (txt hoặc excel).
- Có 2 tùy chọn để nhặt đối tượng (TEXT và MTEXT)
M: chọn 1 text mẫu -> trình tự động nhặt tất cả
C: Chọn trên màn hình
- Xuất txt chọn: T
Xuất Excel chọn: E

Good Luck :D.


(defun CreateDataList(text / i truoc sau)
(vl-load-com)
(setq i (1+ (vl-string-search "," text))
truoc (substr text 1 (1- i))
sau (substr text (1+ i) (- (strlen text) i))
sau (vl-string-subst "" " " sau)
sau (vl-string-subst "" "l" sau)
sau (vl-string-subst "" "L" sau)
)
(list truoc sau)
)
;======================================================================================================
(defun GetObject(/ kw)
(initget "M C")
(if (= key nil)
(progn
(setq kw (getkword (strcat "\nKi\U+1EC3u ch\U+1ECDn <C>: ")))
(if (= kw nil) (setq kw "C"))
)
(progn
(setq kw (getkword (strcat "\nKi\U+1EC3u ch\U+1ECDn <" key ">: ")))
(if (= kw nil) (setq kw key))
)
)
(setq key kw)
(defun Mselect(/ chk mau ssx)
(setq chk T)
(while chk
(setq mau (car (entsel "\nCh\U+1ECDn \U+0111\U+1ED1i t\U+01B0\U+1EE3ng m\U+1EABu: ")))
(if mau (setq chk nil))
)
(setq ssx (ssget "_X" (list
(cons -4 "<OR")
(cons 0 "TEXT")
(cons 0 "MTEXT")
(cons -4 "OR>")
(cons 8 (cdr (assoc 8 (entget mau))))
(cons -4 "<OR")
(cons 1 "*#*`,L#*")
(cons 1 "*#*`, L#*")
(cons -4 "OR>")
)
)
)
)
(defun Cselect(/ ssx)
(setq ssx (ssget (list
(cons -4 "<OR")
(cons 0 "TEXT")
(cons 0 "MTEXT")
(cons -4 "OR>")
(cons -4 "<OR")
(cons 1 "*#*`,L#*")
(cons 1 "*#*`, L#*")
(cons -4 "OR>")
)
)
)
)
(cond
((= kw "C") (setq ssx (Cselect)))
((= kw "M") (setq ssx (Mselect)))
)
ssx
)
;======================================================================================================
(defun Summary(/ ssx DataList di AllType Dtype TypeI xi Tsum ExportData)
(setq ssx (GetObject)
DataList '()
di 0
)
(while (< di (sslength ssx))
(setq DataList (append DataList (list (CreateDataList (cdr (assoc 1 (entget (ssname ssx di))))))))
(setq di (1+ di))
)
(setq AllType (mapcar 'car Datalist) Dtype '())
(while AllType
(setq Dtype (append Dtype (list (car AllType))))
(setq AllType (vl-remove (car AllType) AllType))
)
(setq ExportData '())
(while Dtype
(setq TypeI (car Dtype) xi 0 Tsum 0.0)
(while (< xi (length DataList))
(if (= (car (nth xi DataList)) TypeI) (setq Tsum (+ Tsum (atof (cadr (nth xi DataList))))))
(setq xi (1+ xi))
)
(setq ExportData (append ExportData (list (list TypeI Tsum))))
(setq Dtype (cdr Dtype))
)
ExportData
)
;======================================================================================================
(defun 2excel(ExportData / xlapp ex ex-wb nwb sheet cell exi coci Xchen Ychen)
(VL-LOAD-COM)
(setq xlapp (vlax-create-object "Excel.Application"))
(setq ex (vlax-put-property xlapp "Visible" T))
(setq ex-wb (vlax-get-property xlapp "Workbooks"))
(setq nwb (vlax-invoke-method ex-wb "add"))
(setq sheet (vlax-get-property nwb "ActiveSheet"))
(setq cell (vlax-get-property sheet "Cells"))
(setq exi 0)
(vlax-put-property cell "item" (1+ exi) 1 "LOAI")
(vlax-put-property cell "item" (1+ exi) 2 "TONG DAI")

(while (< exi (length ExportData))
(setq coci (nth exi ExportData))
(setq Xchen (nth 0 coci))
(setq Ychen (nth 1 coci))
(vlax-put-property cell "item" (+ exi 2) 1 Xchen)
(vlax-put-property cell "item" (+ exi 2) 2 ychen)
(setq exi (1+ exi))
)
(princ)
(princ)
)
;======================================================================================================
(defun 2txt(ExportData / Path txtFile file i coci Xchen Ychen)
(setq Path (getvar "DWGPREFIX"))
(setq txtFile (strcat Path "Summary.txt"))
(setq file (Open txtFile "w"))
(setq txi 0)
(write-line (strcat "LOAI" " " "TONG DAI") file)
(while (< txi (length ExportData))
(setq typi (nth txi ExportData))
(setq Xchen (nth 0 typi))
(setq Ychen (nth 1 typi))
(write-line (strcat Xchen " " (rtos Ychen 2 3)) file)
(setq txi (1+ txi))
)
(close file)
(startapp "Notepad" txtFile)
(princ)
(princ)
)
;======================================================================================================
(defun c:Csum(/ kw ExportData)
(setq ExportData (Summary))
(initget "E T")
(if (= keyx nil)
(progn
(setq kw (getkword (strcat "\nXu\U+1EA5t <T>: ")))
(if (= kw nil) (setq kw "T"))
)
(progn
(setq kw (getkword (strcat "\nXu\U+1EA5t <" keyx ">: ")))
(if (= kw nil) (setq kw keyx))
)
)
(setq keyx kw)
(cond
((= kw "T") (setq ssx (2txt ExportData)))
((= kw "E") (setq ssx (2excel ExportData)))
)
(princ)
(princ)
)

<<

Filename: 197393_csum.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 197402
Tên lệnh: gifpr
viết lisp lấy tọa độ điểm và tên điểm
<p></p>
<p>Hề hề hề,</p>
<p>Đây là cái lisp mình chỉnh lại theo hướng các bác Tue_NV và Ketxu đã góp ý. Hy vọng nó sẽ nhanh hơn cái lisp cũ. Rất mong các bác test và cho ý kiến.</p>
<p></div>
<div> </div>
<div>@ bác chủ thớt: Theo ngu ý của mình thì có thể trong cái gọi là TOPO của bác nó không có đối tượng là Acad_proxy_entity...
>>
<p></p>
<p>Hề hề hề,</p>
<p>Đây là cái lisp mình chỉnh lại theo hướng các bác Tue_NV và Ketxu đã góp ý. Hy vọng nó sẽ nhanh hơn cái lisp cũ. Rất mong các bác test và cho ý kiến.</p>
<p></div>
<div> </div>
<div>@ bác chủ thớt: Theo ngu ý của mình thì có thể trong cái gọi là TOPO của bác nó không có đối tượng là Acad_proxy_entity bác ạ. Đối tượng này chỉ khi xuất từ Topo sang Cad nó mới tạo thành. Bởi thế nên cái thằng ssget nó chả nhận được thằng cu tí nào cả.</div>
<div>Do mình chả biết cái chi về thằng Topo này nên chỉ đoán mò theo cái kết quả mà bác đưa ra. Trúng hay trật thì các bác đừng trách.</div>
<div>Nếu quả đúng vậy thì tại sao bác chủ thớt lại cứ nhất thiết phải chạy lisp trên nền Topo nhỉ?? Nếu chạy trong CAD rồi trả cái kết quả về Topo thì không được ư??? Mình cứ thiển nghĩ rằng nếu thằng Topo xuất được sang CAd thì ắt phải có cách xuất ngược từ CAd về Topo để xử lý.</div>
<div>Mặt khác cái đích cuối cùng bác cần là cái chi?? Nếu sử dụng cái kết quả của lisp này thì có vấn đề gì không thỏa mãn cho cái đích cuối cùng ấy. Hay chỉ là vấn đề bác không thích dùng do nó không chạy được với Topo???</div>
<div>Mình thì cho rằng cái cần là cái đích đó, đi bằng cách nào, làm bằng cách chi mà đạt được cái đích đó thì cho dù nó có hơi chậm cũng còn hơn ngồi chờ cách tối ưu thỏa mãn cái ý thích của mình mà chửa biết lúc nào có được.</div>
<div>Chừng nào bác có được cái tối ưu bác cần có thể bác hãy chia sẻ cái đó để anh em được học hỏi thêm chút chút bác nhé.</div>
<div>Chúc bác vui.</div>
<div> </div>
<div> </div>

<<

Filename: 197402_gifpr.lsp
Tác giả: bach1212
Bài viết gốc: 197026
Tên lệnh: knut gn
Lisp xuất thông số của đường ra block thuộc tính

Oki, lisp đã hoàn chỉnh, ae giao thông có thể dùng thoải mái roài. Hí hí e ở Bắc Ninh bác ah. Thank sờ kiu bác nhều :D

;; free lisp from cadviet.com
;;; this lisp was downloaded from
http://www.cadviet.com/forum/index.php?showtopic=47442&pid=196992&st=0&#entry196992
;; free lisp from cadviet.com
;;;...
>>

Oki, lisp đã hoàn chỉnh, ae giao thông có thể dùng thoải mái roài. Hí hí e ở Bắc Ninh bác ah. Thank sờ kiu bác nhều :D

;; free lisp from cadviet.com
;;; this lisp was downloaded from
http://www.cadviet.com/forum/index.php?showtopic=47442&pid=196992&st=0&#entry196992
;; free lisp from cadviet.com
;;; this lisp was downloaded from
http://www.cadviet.com/forum/index.php?showtopic=47442&pid=196822&st=0&#entry196822
;Kh&#235;i t&#185;o m&#233;t s&#232; th&#171;ng s&#232; cho v&#207; n&#243;t
;------------------------------------------------------
(defun C:knut ()
(setq hf (getreal "\nChieu cao text: "))
(command "dimstyle" "s" "Dimn" "dimstyle" "s" "Dran")
(command "-Style" "hoatfon" "hoatfon" hf "" "" "" "" "")
(command "-Layer" "n" "Text" "c" "4" "Text" "")
(command "-Layer" "n" "Dim" "c" "1" "DIm" "")
(command "-Layer" "n" "Khuat" "c" "4" "Khuat" "l" "Dashed" "Khuat" "")
(Princ)
)
;;;Chuong trinh chinh (Ve va thong ke cac yeu to cua duong cong)
(setq tlv (getint "\nNhap ty le ban ve nut 1/... :"))
(defun c:GN ()
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq sttdinh (getint "\nNhap so thu tu dinh :"))
(setq es (entsel "\nChon cung tron can ve:"))
(setq dbang (getpoint "\nChon vi tri dat bang thong ke:"))
(setq osm (getvar "osmode"))
(setvar "osmode" 0)
(setq tdt (car es)
dra (cadr es)
ent (entget tdt)
cen (cdr (assoc 10 ent))
goc1 (cdr (assoc 50 ent))
goc2 (cdr (assoc 51 ent))
bk (cdr (assoc 40 ent))
)
(setq td1 (polar cen goc1 bk)
td2 (polar cen goc2 bk)
)
(setq mid (list (/ (+ (car td1) (car td2)) 2) (/ (+ (cadr td1) (cadr td2)) 2) (caddr td1)))
(setq goc (angle cen mid))
(setq goctam (abs (- goc2 goc1)))
(if (< goctam pi)
(setq goct goctam)
(setq goct (- (* 2 pi) goctam))
)
(setq dtam (/ bk (cos (/ goct 2))))
(setq dinh (polar cen goc dtam))
(setq T (rtos (/ (* (distance dinh td1) tlv) 1000) 2 2)
P (rtos (/ (* (- dtam bk) tlv) 1000) 2 2)
K (rtos (/ (* (* goct bk) tlv) 1000) 2 2)
Ssbk (rtos (/ (* bk tlv) 1000) 2 2)
)
(command "-layer" "s" "khuat" "" ".line" td1 dinh td2 "")
(command "-layer" "s" "DIM" "" "Dimstyle" "" "Dimn")
(setq kckt (* 2.2 (getvar "dimtxt")) dkt1 (polar td1 goc1 kckt))
(command "DIMALIGNED" dinh td1 dkt1)
(setq dkt2 (polar td2 goc2 kckt))
(command "DIMALIGNED" dinh td2 dkt2)
(command "Dimstyle" "" "Dran" "DIMRADIUS" tdt dra "")
;V&#207; khung th&#232;ng k&#170; nut
;--------------------------------
(setq xb (+ (car dbang) (* 11 (getvar "textsize"))) yb (- (cadr dbang) (* 10.25 (getvar
"textsize"))) dbang2 (list xb yb (caddr dbang)) odbang (polar dbang (/ (* 3 pi) 4) (/
(getvar "textsize") 5)) odbang2 (polar dbang2 (- (* 2 pi) (/ pi 4)) (/ (getvar "textsize")
5)))
(command ".layer" "s" "text" "" ".rectang" odbang odbang2 ".rectang" dbang dbang2) (command
"change" "l" "" "p" "c" "1" "")
;X&#246; l&#253; b&#182;ng th&#232;ng k&#170;
;-----------------------------
(setq gockep (angtos (- pi goct) 1 4))
(setq Kiem1 (substr gockep 2 1) kiem2 (substr gockep 3 1) kiem3 (substr gockep 4 1))
(cond ((= kiem1 "d") (setq dau (substr gockep 1 1) cuoi (substr gockep 3))) ((= kiem2 "d")
(setq dau (substr gockep 1 2) cuoi (substr gockep 4))) ((= kiem3 "d") (setq dau (substr
gockep 1 3) cuoi (substr gockep 5)))
)
(setq gockep (strcat (strcat dau "%%d") cuoi))
;----------------------------
(setq nhan (rtos sttdinh 2 0))
(setq chugoc (strcat (strcat "A" nhan) (strcat "=" gockep)))
(setq chubk (strcat (strcat (strcat "R" nhan) (strcat "=" ssbk)) "m"))
(setq chutt (strcat (strcat (strcat "T" nhan) (strcat "=" T)) "m"))
(setq chup (strcat (strcat (strcat "P" nhan) (strcat "=" P)) "m"))
(setq chucd (strcat (strcat (strcat "K" nhan) (strcat "=" K)) "m"))
(setq dong1 (polar dbang (- (* 2 pi) (/ (* 9 pi) 24)) (* 1.75 (getvar "textsize")))
dong2 (polar dong1 (+ pi (/ pi 2)) (* 2 (getvar "textsize")))
dong3 (polar dong2 (+ pi (/ pi 2)) (* 2 (getvar "textsize")))
dong4 (polar dong3 (+ pi (/ pi 2)) (* 2 (getvar "textsize")))
dong5 (polar dong4 (+ pi (/ pi 2)) (* 2 (getvar "textsize")))
)
(command "-layer" "s" "Text" "" ".text" dong1 "" chugoc ".text" dong2 "" chubk ".text"
dong3 "" chutt ".text" dong4 "" chup ".text" dong5 "" chucd)
(setq tendinh (strcat "A" nhan))
(command ".text" dinh "" tendinh)
(command "insert" "nut" dinh "" "" "" )
(setvar "osmode" osm)
(setvar "cmdecho" cmd) (princ)
)


<<

Filename: 197026_knut_gn.lsp
Tác giả: Tue_NV
Bài viết gốc: 197453
Tên lệnh: ha3
Lisp Ghép Text Cần Giúp Đỡ

Không biết code này đúng ý bạn không?

Filename: 197453_ha3.lsp
Tác giả: ketxu
Bài viết gốc: 197457
Tên lệnh: test
Lisp Ghép Text Cần Giúp Đỡ
Ketxu chỉnh 1 tí code của bác Hạ cho dễ nhìn.
Khi dùng rtos đặc biệt chú ý tác dụng của biến DIMZIN

(defun C:test (/ e1 e2 e3 h1 h2 h3 pt ss1 ss2 val blk ssgetT prf) ;ketxu changed
(initget "y Y n N")
(setq prf (getkword "\nDoi dau :")
nm (getint "\nSo dau phay :")
blk (vla-get-block (vla-get-activelayout(vla-get-activedocument (vlax-get-acad-object))))
oDZ (getvar 'DiMZIN)
>>
Ketxu chỉnh 1 tí code của bác Hạ cho dễ nhìn.
Khi dùng rtos đặc biệt chú ý tác dụng của biến DIMZIN

(defun C:test (/ e1 e2 e3 h1 h2 h3 pt ss1 ss2 val blk ssgetT prf) ;ketxu changed
(initget "y Y n N")
(setq prf (getkword "\nDoi dau :")
nm (getint "\nSo dau phay :")
blk (vla-get-block (vla-get-activelayout(vla-get-activedocument (vlax-get-acad-object))))
oDZ (getvar 'DiMZIN)
)
(defun addmtext (blk str pt)(vla-addmtext blk (vlax-3d-point pt) 1 str))
(defun ssgetT (p h rg)
(ssname
(ssget "c" (polar p (* 1.25 pi) rg) (polar p (* 0.25 pi) rg) (list (cons 0 "TEXT") (cons 40 h) (cons 1 "~**"))) 0)
)
(defun val (d e)(cdr (assoc d (entget e))))
(setvar 'DIMZIN 0)
(mapcar '(lambda(x y)(set x (val 40 y)))
'(h1 h2 h3)
(mapcar '(lambda(x y)(set x (car (entsel y)))) '(e1 e2 e3) '("\nText lon mau :" "\nText be:" "\nText cham"))
)

(princ "\nChon tap hop cac Text dau cham...")
(foreach en (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons 0 "TEXT") (cons 40 h3) (cons 1 "."))))))
(vla-put-color
(addmtext blk
(rtos
(distof (setq str (strcat (if (= (strcase prf) "Y") "-")(val 1 (ssgetT (setq p (val 10 en)) h3 h3)) "." (val 1 (ssgetT p h2 h3)))))
2 nm)
(list (car p)(cadr p)(distof str))
)
1) ;So 1 la mau cua doi tuong
)
(setvar 'DIMZIN oDZ)
)

<<

Filename: 197457_test.lsp

Trang 87/330

87