Đến nội dung


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

Viết Lisp theo yêu cầu


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

#2421 conghoan1003

conghoan1003

    biết vẽ point

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

Đã gửi 16 July 2009 - 06:56 PM

Mình đưa lên 3 vấn đề nhờ Tuê_NV sữa giúp, bạn sữa được hai cái còn cái đầu tiên sao mình thấy vẫn chưa được "Đường offet bên dưới đường tự nhiên vẫn là layer tự nhiên, lẽ ra nó và đường mái dốc phải nối với nhau để trở thành đường vét hoàn chỉnh"
Đề lisp này hoàn thiện hơn Tuê_NV có thể thêm cái text 1:1 (hoặc 1:2) vào dưới đường mái dốc được không? Còn nếu mất nhiều thời gian quá thì thôi cũng được.
Có lẽ mình đã yêu cầu hơi nhiều rồi, con người lòng tham vô đáy mà, Tue_NV thông cảm nghe! Khi nào Tuê_NV rãnh sửa giúp mình lần nữa nhé. Cảm ơn Tuệ_NV nhiều!
Tuê_NV xem file cad nè: http://www.cadviet.c...files/MCN_5.dwg

Tue_NV sửa lại giúp mình với! Thank!
  • 0
Học học nữa học mãi.
Đúp học lại!

#2422 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 17 July 2009 - 08:49 AM

"Đường offet bên dưới đường tự nhiên vẫn là layer tự nhiên, lẽ ra nó và đường mái dốc phải nối với nhau để trở thành đường vét hoàn chỉnh"
Đề lisp này hoàn thiện hơn Tuê_NV có thể thêm cái text 1:1 (hoặc 1:2) vào dưới đường mái dốc được không? Còn nếu mất nhiều thời gian quá thì thôi cũng được.
Có lẽ mình đã yêu cầu hơi nhiều rồi, con người lòng tham vô đáy mà, Tue_NV thông cảm nghe! Khi nào Tuê_NV rãnh sửa giúp mình lần nữa nhé. Cảm ơn Tuệ_NV nhiều!

Công hoan chạy thử file Lisp này xem :
http://www.cadviet.c...files/VBUN6.vlx
  • 1

#2423 bach1212

bach1212

    biết lệnh trim

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

Đã gửi 17 July 2009 - 09:20 AM

Mình vẫn đang dùng, bình thường bạn ạ (mình cũng test trên hình của bạn vẫn được mà, cad 2007)

oạch! thế thì cad2007 em bị lỗi rồi bác nhỉ! chứ e dùng nhìu nhìu lần lắm rùi mà có đc đâu ah! huu. :s_dead:
  • 0

Một môn tập luyện mang lại vô vàn lợi ích sức khỏe cho mọi người, nhiều bệnh tật nan y đều được chữa khỏi, hoàn toàn miễn phí. Hiệu quả chữa khỏi bệnh tật của nó lên đến hơn 90%.
Tài liệu tại đây: http://phapluan.org/

Rất vui được làm quen với mọi người trên facebook:
https://www.facebook...67946371&type=1

 

 


#2424 bach1212

bach1212

    biết lệnh trim

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

Đã gửi 17 July 2009 - 10:43 AM

Đây là file .dwg đã xuất cao độ z lên bản vẽ theo các toạ độ có trong file .txt

http://www.cadviet.c...es/Drawing4.dwg

Bạn xem có đúng ý bạn không nhé?

Còn đây là file .xls -> chuyển từ file .txt qua
http://www.cadviet.c...files/Book4.xls

Hy vọng đúng ý của bạn

@bach1212 : Tue_NV kiểm tra lại không có lỗi. Mình sử dụng CAD2004 để Test. Bạn sử dụng CAD2007 để test phải không?
Mình cũng không hiểu tại sao lại có sự khác biệt này nữa. Có 1 lần Tue_NV viết Lisp ra dùng CAD2004 để test thì OK còn bạn xuantran test trên CAD2007 thì lỗi. Không biết tại sao nữa? Có ai biết nguyên nhân này không?
bach1212 dùng CAD2004 để kiẻm tra thử, lạ thật

vâng! em dùng cad2007. bạn hoangson614 nói là dùng vẫn bình thường nhưng em thì...làm chán tay mỏi mắt vẫn báo lỗi như thế. pó toàn thân! hjj. bác pro cũng ko bít tại sao thì em... hix đành phải dùng lisp khác tính tổng dtích xong có kết quả trên command rùi ed lại text thui! hic, lâu lém bác ơi! huu :s_dead:
em ko dùng cad2004 nhưng test trên cad2005 cũng ko đc lun bác ah!
  • 0

Một môn tập luyện mang lại vô vàn lợi ích sức khỏe cho mọi người, nhiều bệnh tật nan y đều được chữa khỏi, hoàn toàn miễn phí. Hiệu quả chữa khỏi bệnh tật của nó lên đến hơn 90%.
Tài liệu tại đây: http://phapluan.org/

Rất vui được làm quen với mọi người trên facebook:
https://www.facebook...67946371&type=1

 

 


#2425 lon ton

lon ton

    biết zoom

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

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

Chào bạn Phiphi, xuantran, truongthanh

Lisp sau Tue_NV đã cải tiến theo ý của bạn Xuantran, truongthanh
Khi chạy Lisp hỏi
1. Chọn các text để chuyển các Text thành Attribute
2. Chon cac doi tuong khac de tao thanh BLOCK ATTRIBUTE

Nếu ở bước 2 nếu bạn không chọn đối tượng thì chỉ có các Text chuyển thành Attribute
Nếu ở bước 2 nếu bạn chọn đối tượng thì các Text và các đối tượng được chọn ở bước 2 chuyển thành Attribute


bác Tuệ ơi, nhờ bác phát triển lên thêm giúp em 1 ý được không?
em muốn các text được chọn trở thành các Att riêng rẽ
vì em phải làm việc với >1000 text = excellink, nếu để >1000 text này
vào chung 1Att thì khi xuất sang excel sẽ không đủ số colum (trong excel chỉ có 256 colum)
còn nếu >1000 text này trở thành >1000 Att riêng rẽ thì số row trong excel sẽ đủ đáp ứng
mong bác để ý giúp em
cảm ơn bác nhiều!
  • 0

#2426 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 17 July 2009 - 11:03 AM

bác Tuệ ơi, nhờ bác phát triển lên thêm giúp em 1 ý được không?
em muốn các text được chọn trở thành các Att riêng rẽ
vì em phải làm việc với >1000 text = excellink, nếu để >1000 text này
vào chung 1Att thì khi xuất sang excel sẽ không đủ số colum (trong excel chỉ có 256 colum)
còn nếu >1000 text này trở thành >1000 Att riêng rẽ thì số row trong excel sẽ đủ đáp ứng
mong bác để ý giúp em
cảm ơn bác nhiều!

muốn các text được chọn trở thành các Att thì dùng lệnh X (EXPLODE) là xong

vâng! em dùng cad2007. bạn hoangson614 nói là dùng vẫn bình thường nhưng em thì...làm chán tay mỏi mắt vẫn báo lỗi như thế. pó toàn thân! hjj. bác pro cũng ko bít tại sao thì em... hix đành phải dùng lisp khác tính tổng dtích xong có kết quả trên command rùi ed lại text thui! hic, lâu lém bác ơi! huu
em ko dùng cad2004 nhưng test trên cad2005 cũng ko đc lun bác ah!

Có thể Lisp gdt trùng tên lệnh với 1 file Lisp nào đó trong máy của bạn chăng?
Bạn thử đổi tên lệnh gdt trong file Lisp thành 1 tên khác xem sao
cụ thể ở dòng đầu tiên :
(defun c:gdt(/ oldim p1 frome cur toe ss ss2 tt S ans po cao te ente)

Bạn thay chữ gdt thành 1 tên khác thử xem . Tue_NV test OK mà
  • 1

#2427 HoangSon614

HoangSon614

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 254 Bài viết
Điểm đánh giá: 66 (tàm tạm)

Đã gửi 17 July 2009 - 11:46 AM

[quote name='Tue_NV' date='Jul 17 2009, 11:03' post='67554']
Mình thường sử dụng nhiều, nhưng vẽ bằng lệnh Spline thì lâu quá nhưng lại không chuẩn. Mình nhờ Tue_NV viết giúp mình cái lisp với nội dung sau:
Tên lệnh: DC (dấu cắt)
Pick điểm thứ nhất
Pick điểm thứ hai
OK
Mình gửi kèm file mẫu, bạn xem giúp mình. Cảm ơn bạn, chúc bạn khoẻ và hạnh phúc.
File đây bạn: http://www.cadviet.c...s/Dau_cat_1.dwg
  • 0

#2428 lon ton

lon ton

    biết zoom

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

Đã gửi 17 July 2009 - 11:46 AM

muốn các text được chọn trở thành các Att thì dùng lệnh X (EXPLODE) là xong


em làm phiền bác thêm 1 chút:
ý của em là mỗi text sẽ là 1 block thuộc tính cơ (vì excellink chỉ làm việc với các block)
nên mỗi text khi được chuyển thành 1 Att rùi thì sẽ phải block lại luôn cơ
bác giúp em thêm 1chút nữa nhé!
  • 0

#2429 bach1212

bach1212

    biết lệnh trim

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

Đã gửi 17 July 2009 - 01:03 PM

muốn các text được chọn trở thành các Att thì dùng lệnh X (EXPLODE) là xong
Có thể Lisp gdt trùng tên lệnh với 1 file Lisp nào đó trong máy của bạn chăng?
Bạn thử đổi tên lệnh gdt trong file Lisp thành 1 tên khác xem sao
cụ thể ở dòng đầu tiên :
(defun c:gdt(/ oldim p1 frome cur toe ss ss2 tt S ans po cao te ente)

Bạn thay chữ gdt thành 1 tên khác thử xem . Tue_NV test OK mà

hjjj, em làm các bác khó chịu thiệt đó nhơ`. hjj. em đã thay tên lệnh, đổi mọi loại, cả thành "123" lun. vậy mà vẫn báo lỗi "; error: too many arguments" . thử cả sang máy của đồng nghiệp bên cạnh dùng cad2005 cũng vậy, lại báo 1 câu lỗi khác. hjj em pó tay thôi bác à!
  • 0

Một môn tập luyện mang lại vô vàn lợi ích sức khỏe cho mọi người, nhiều bệnh tật nan y đều được chữa khỏi, hoàn toàn miễn phí. Hiệu quả chữa khỏi bệnh tật của nó lên đến hơn 90%.
Tài liệu tại đây: http://phapluan.org/

Rất vui được làm quen với mọi người trên facebook:
https://www.facebook...67946371&type=1

 

 


#2430 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 17 July 2009 - 02:25 PM

Mình thường sử dụng nhiều, nhưng vẽ bằng lệnh Spline thì lâu quá nhưng lại không chuẩn. Mình nhờ Tue_NV viết giúp mình cái lisp với nội dung sau:
Tên lệnh: DC (dấu cắt)
Pick điểm thứ nhất
Pick điểm thứ hai
OK
Mình gửi kèm file mẫu, bạn xem giúp mình. Cảm ơn bạn, chúc bạn khoẻ và hạnh phúc.
File đây bạn: http://www.cadviet.c...s/Dau_cat_1.dwg

Bạn lưu file daucat.dwg này vào trong ổ C: của bạn thì nó mới chạy nhé :
file đây : http://www.cadviet.c...iles/daucat.dwg
Và chạy file Lisp này nữa :

;copyright by Tue_NV
(defun c:ttoa(/ dt n i ss1 ent tval L kytunoi kytu j tname cao po10 po11 styl LA
mau dxf71 dxf72 dxf73 ang wid)
(command "undo" "be")
(setq dt (ssget '((0 . "TEXT"))) n (sslength dt) i 0 ss1 (ssadd))
(while (< i n)
(if dt
(progn
(setq ent (ssname dt i))
(setq tval (cdr(assoc 1 (entget ent))))

(setq L (strlen tval) j 1)
(setq kytunoi "")
(Repeat L
(setq kytu (substr tval j 1))
(if (= kytu " ")
(setq kytu "_")
(setq kytu (substr tval j 1))
)
(setq kytunoi (strcat kytunoi kytu))

(setq j (1+ j))
)

(setq tname kytunoi)
(setq cao (cdr(assoc 40 (entget ent))))
(setq po10 (cdr(assoc 10 (entget ent))))
(setq po11 (cdr(assoc 11 (entget ent))))
(setq styl (cdr(assoc 7 (entget ent))))
(setq LA (cdr(assoc 8 (entget ent))))
(if (= (cdr(assoc 62 (entget ent))) nil)
(setq mau (cdr(assoc 62 (tblsearch "layer" LA))))
(setq mau (cdr(assoc 62 (entget ent))))
)
(setq ang (cdr(assoc 50 (entget ent))))
(setq wid (cdr(assoc 41 (entget ent))))
(setq dxf71 (cdr(assoc 71 (entget ent))))
(setq dxf72 (cdr(assoc 72 (entget ent))))
(setq dxf73 (cdr(assoc 73 (entget ent))))

(watt tname tval po10 po11 dxf71 dxf72 dxf73 cao styl mau ang wid)
(setq ss1 (ssadd (entlast) ss1))
(entdel ent)
)
)
(command "copybase" po10 ss1 "")
(Command "pasteblock" po10)
(Command "erase" ss1 "")
(setq i (1+ i))
)
(sssetfirst ss1 ss1)

(command "undo" "end")
(princ)
)
;
;
;
(defun watt (tagname tagval p1 p2 d71 d72 d73 h sty col goc rong / promp)
(setq promp tagname)
(entmake (list (cons 0 "ATTDEF") (cons 7 sty) (cons 62 col) (cons 2 Tagname) (cons 3 promp)
(cons 1 tagval) (cons 71 d71) (cons 72 d72) (cons 74 d73) (cons 10 p1) (cons 11 p2) (cons 40 h)
(cons 50 goc) (cons 41 rong)
'(70 . 8)
)
)
)

@bach1212 : Bạn apload file này chạy thử xem sao. Lệnh là gdt
http://www.cadviet.com/upfiles/gdt.lsp
  • 1

#2431 conghoan1003

conghoan1003

    biết vẽ point

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

Đã gửi 17 July 2009 - 03:20 PM

Công hoan chạy thử file Lisp này xem :
http://www.cadviet.c...files/VBUN6.vlx

Tuê_NV xem lại giúp mình tí, sao cái đường offet bên dưới đường tự nhiên vẫn là layer tự nhiên và đường này chưa nối với đường mái dốc. Tuê_NV xem file cad mình upload lên nhé. Cảm ơn Tuê_Nv đã giúp đỡ! http://www.cadviet.c...NGCHITIET_1.dwg
  • 0
Học học nữa học mãi.
Đúp học lại!

#2432 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1435 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 17 July 2009 - 03:32 PM

..........bổ sung thêm phần cho phép chọn được cả COLOR, LINETYLE, bởi vì rất nhiều Drafters sử dụng Color, Linetype để đặt tên cho các Layers trong việc in ấn ra bản vẽ.
...................................

Chào Phiphi-
Gửi bạn lisp chuyển các đối tuợng về Layer mới có tên LINETYLE+COLOR
ex :
- các đối tuợng có LineType= Center và Color=5 sẽ chuyển sang Layer Center5
- các đối tuợng có LineType= Hidden và Color=3 sẽ chuyển sang Layer Hidden3
- các đối tuợng có LineType=ByLayer hay ByBlock giữ nguyên (không thay đổi)
(defun C:Clt (/ tbl ltype_lst tbl_name ss ss_lst ltype ss_ltype)
(defun dxf(id ent) (cdr (assoc id (entget ent))) )
(defun ModEnt(id newval ent / ds)
(setq ds (entget ent)
ds (subst (cons id newval) (assoc id ds) ds))
(entmod ds) (princ)
)
; main
(command "_.undo" "_begin")
(setvar "cmdecho" 0)
(setq lay (getvar "clayer" ))
(setq ltype_lst (list (cdr (assoc 2 (tblnext "LTYPE" T)))))
(while (setq tbl (tblnext "LTYPE"))
(setq ltype_lst (cons (cdr (assoc 2 tbl))ltype_lst)) )
(princ "\nChon doi tuong : ")
(if (setq ss (ssget))
(progn
(setq ss_lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
ss_lst (vl-remove-if '(lambda(x) (or (not (dxf 6 x))
(equal (dxf 6 x) "ByBlock")
) ) ss_lst))
(foreach ltype ltype_lst
(if (setq ss_ltype (vl-remove-if-not '(lambda(x) (equal (dxf 6 x) ltype)) ss_lst))
(foreach e ss_ltype
(or
(setq mau (dxf 62 e))
(setq mau (cdr(assoc 62 (tblsearch "layer" (dxf 8 e)))) ) )
(setq layname (strcat ltype (itoa mau)))
(or (tblsearch "layer" layname)(if (= mau 0)
(command "_.LAYER" "N" layname "")
(command "_.LAYER" "N" layname "c" mau layname "")) )
(ModEnt 8 layname e)
(setq ss_lst (vl-remove e ss_lst ))
)
)
)
(setvar "clayer" lay)
)
(prompt "\nKhong co doi tuong duoc chon.")
)
(command "_.undo" "_end")
(princ)
)

  • 1

#2433 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 17 July 2009 - 03:37 PM

Tuê_NV xem lại giúp mình tí, sao cái đường offet bên dưới đường tự nhiên vẫn là layer tự nhiên và đường này chưa nối với đường mái dốc. Tuê_NV xem file cad mình upload lên nhé. Cảm ơn Tuê_Nv đã giúp đỡ! http://www.cadviet.c...NGCHITIET_1.dwg

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

#2434 HoangSon614

HoangSon614

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 254 Bài viết
Điểm đánh giá: 66 (tàm tạm)

Đã gửi 17 July 2009 - 06:06 PM

[quote name='Tue_NV' date='Jul 17 2009, 14:25' post='67579']
Bạn lưu file daucat.dwg này vào trong ổ C: của bạn thì nó mới chạy nhé :
file đây : http://www.cadviet.c...iles/daucat.dwg
Và chạy file Lisp này nữa :

(defun c:stext (/ sst lstent egoc pgoc xgoc yht zgoc linespc ee tt)
(if (not tyledong)
(setq tyledong 1.5)
)
(princ "\nSap xep text © CADViet.com")
(setq sst (ssget '((0 . "TEXT,MTEXT")))
lstent (ss2ent sst)
tmp (getreal (strcat "\nVao ty le dong khoang cach dong <"
(rtos tyledong 2 2)
">: "
)
)
tyledong (cond
(tmp tmp)
(t tyledong)
)
lstent (vl-sort lstent
'(lambda (e1 e2)
(> (cadr (cdr (assoc 10 (entget e1))))
(cadr (cdr (assoc 10 (entget e2))))
)
)
)
egoc (car lstent)
lstent (cdr lstent)
pgoc (cdr (assoc 10 (entget egoc)))
xgoc (car pgoc)
yht (cadr pgoc)
zgoc (caddr pgoc)
hgoc (cdr (assoc 40 (entget egoc)))
linespc (* hgoc (+ 1.0 tyledong))

)
(foreach ee lstent
(setq tt (entget ee)
tt (subst (list 10
xgoc
(setq yht (- yht linespc))
zgoc
)
(assoc 10 tt)
tt
)
)
(entmod tt)
(entupd ee)
)
(princ)
)
(defun ss2ent (ss / sodt index lstent)
(setq
sodt (cond
(ss (sslength ss))
(t 0)
)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)
(princ
"\nSTEXT - Sap xep text - free lisp from www.cadviet.com"
)
(vl-load-com)

Làm phiền bạn tý nha. Cảm ơn bạn nhiều
  • 0

#2435 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 17 July 2009 - 07:27 PM

Mình muốn nhờ bạn tý nữa, lisp này mình đã tìm thấy trên Cadviet (Sắp xếp thẳng hàng và đều các text nhưng là canh lề trái), chạy rất tốt nhưng mình muốn bạn chỉnh lại giúp mình (Sắp xếp thẳng hàng và đều các text, nhưng mình muốn là thẳng hàng, đều text nhưng canh giữa)
Làm phiền bạn tý nha. Cảm ơn bạn nhiều

Tue_NV đã từng cải tiến code này cho phép user nhập vàp khoảng cách dòng (chứ không phải là tỉ lệ dòng)
Và Lisp này Tue_NV viết lại 1 chút bổ sung theo ý của HoangSon
Bạn nhớ rằng Lisp lấy dòng Text đầu tiên làm điểm canh chỉnh đấy nhé

(defun c:sxtext()
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq ss (ssget '((0 . "TEXT")))
lst (ss2ent ss)
lst (vl-sort lst
'(lambda (e1 e2)
(>
(caddr (assoc 10 (entget e1)))
(caddr (assoc 10 (entget e2)))
)
)
)
)
(command "justifytext" ss "" "TC")
(setq kc (getdist "\n Nhap khoang cach giua cac Text :"))
(setq ddau (cdr(assoc 11 (entget(car lst))))
i 0)

(foreach e lst
(setq ent (entget e))
(setq dcuoi (cdr(assoc 11 ent)))
(setq ddauu (list (car ddau) (- (cadr ddau) (* i kc)) 0))
(command "move" e "" dcuoi ddauu)
(setq i (1+ i))
)
(setvar "osmode" oldos)
(Princ)
)

(defun ss2ent (ss / sodt index lstent)
(setq
sodt (if ss (sslength ss) 0)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)

  • 2

#2436 HoangSon614

HoangSon614

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 254 Bài viết
Điểm đánh giá: 66 (tàm tạm)

Đã gửi 17 July 2009 - 09:17 PM

Tue_NV đã từng cải tiến code này cho phép user nhập vàp khoảng cách dòng (chứ không phải là tỉ lệ dòng)
Và Lisp này Tue_NV viết lại 1 chút bổ sung theo ý của HoangSon
Bạn nhớ rằng Lisp lấy dòng Text đầu tiên làm điểm canh chỉnh đấy nhé


(defun c:sxtext()
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq ss (ssget '((0 . "TEXT")))
lst (ss2ent ss)
lst (vl-sort lst
'(lambda (e1 e2)
(>
(caddr (assoc 10 (entget e1)))
(caddr (assoc 10 (entget e2)))
)
)
)
)
(command "justifytext" ss "" "TC")
(setq kc (getdist "\n Nhap khoang cach giua cac Text :"))
(setq ddau (cdr(assoc 11 (entget(car lst))))
i 0)

(foreach e lst
(setq ent (entget e))
(setq dcuoi (cdr(assoc 11 ent)))
(setq ddauu (list (car ddau) (- (cadr ddau) (* i kc)) 0))
(command "move" e "" dcuoi ddauu)
(setq i (1+ i))
)
(setvar "osmode" oldos)
(Princ)
)

(defun ss2ent (ss / sodt index lstent)
(setq
sodt (if ss (sslength ss) 0)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)

Lisp chạy tốt rồi, rất đúng ý mình. Cảm ơn bạn nhiều, (nhưng cho mình hỏi nếu thêm đối tượng text là MTEXT có được không? nhiều lúc DTEXT cũng bất tiện), có thể chỉnh giúp mình tý nữa là OK luôn. Cảm ơn bạn vì sự nhiệt tình. Chúc bạn sức khoẻ.
  • 0

#2437 vanthanhfpt

vanthanhfpt

    biết vẽ line

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

Đã gửi 17 July 2009 - 11:54 PM

Pác NGUYEN HOANH ơi! Tại sao cai lisp này lại không ap được vào cad nhỉ. Nó báo là "; error: string too long on input"
Pác xem có thể sửa giúp em được không nhá.
Thanks pác rất nhiều!
http://www.cadviet.c.../Ban_ve_mau.lsp
  • 0

-*-TO BE OR NOT TO BE-*-


#2438 kid112

kid112

    Chưa sử dụng CAD

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

Đã gửi 18 July 2009 - 12:03 AM

Em làm bên trắc địa, gặp trường hợp như thế này: trong công tác trích đo địa chính thửa đất dùng để vẽ các khu đất đã "Tách thửa" thì phải căn cứ vào toạ độ trắc địa theo bản đồ VN2000 từ đó suy ra khoảng cách rồi dán những toạ độ tại bản đồ VN2000 vào bản vẽ của mình. Trình tự thực hiện như sau: (Ví dụ minh hoạ)

1. Đo hiện trạng khu đất
2. Vẽ lại mặt bằng tổng thể khu đất (căn cứ vào bản đồ VN2000 và số liệu đo dc.

Hình đã gửi

3. Tiếp tục vẽ kích thước các thửa sẽ tách vào bản vẽ đó (đánh dấu toạ độ 1, 2, 3, 4 . .. trên thửa đất)

Hình đã gửi

4. Copy qua file bản đồ VN2000 vào đúng vị trí của thửa đất đó. và lấy toạ độ của từng điểm vừa vẽ bằng lệnh ID:

Hình đã gửi

5. Copy các toạ độ đó qua Excel

Hình đã gửi

6. Copy lại bảng tính vào trong file CAD:

Hình đã gửi


Vậy các anh có thể giúp em viết 1 cái Lisp có thể làm tắt các giai đoạn trên được ko a? không quan trọng phải thông qua excel, có thể lấy trực tiếp text toạ độ từ bản dồ VN2000 qua cũng được.

Đây là file bản đồ VN2000 và file Excel kèm công thức tính của em.

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

Mong các anh giúp đỡ.

Xin chân thành cảm ơn.
  • 0

#2439 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 18 July 2009 - 05:47 AM

Pác NGUYEN HOANH ơi! Tại sao cai lisp này lại không ap được vào cad nhỉ. Nó báo là "; error: string too long on input"
Pác xem có thể sửa giúp em được không nhá.
Thanks pác rất nhiều!
http://www.cadviet.c.../Ban_ve_mau.lsp

Dịch nghĩa : error: string too long on input"[/b]
Lỗi : Kí tự nhập vào quá dài trong 1 hàm -> phát sinh lỗi
Cụ thể ở dòng này trong Code bạn bị lỗi

(command "Layer" "n" "Net manh" "c" "170" "Net manh" "lt" "continuous" "Net manh" "lw" "0.15" "Net manh" "" "Layer" "n" "Net khuat" "c" "6" "Net khuat" "lt" "Hidden" "Net khuat" "lw" "0.2" "Net khuat" "" "Layer" "n" "Duong truc" "c" "2" "Duong truc" "lt" "Acad_iso04w100" "Duong truc" "lw" "0.15" "Duong truc" "" "Layer" "n" "Kich thuoc" "c" "110" "Kich thuoc" "lt" "continuous" "Kich thuoc" "lw" "0.2" "Kich thuoc" "" "Layer" "n" "Van ban" "c" "4" "Van ban" "lt" "continuous" "Van ban" "lw" "0.25" "Van ban" "" "Layer" "n" "Mat cat" "c" "3" "Mat cat" "lt" "continuous" "Mat cat" "lw" "0.15" "Mat cat" "" "layer" "n" "Day dien" "c" "230" "Day dien" "lt" "continuous" "Day dien" "lw" "0.2" "Day dien" "" "layer" "n" "Ong nuoc" "c" "60" "Ong nuoc" "lt" "continuous" "Ong nuoc" "lw" "0.2" "Ong nuoc" "" "layer" "n" "Thep CL" "c" "240" "Thep CL" "lt" "continuous" "Thep CL" "lw" "0.6" "Thep CL" "" "layer" "n" "Thep dai" "c" "30" "Thep dai" "lt" "continuous" "Thep dai" "lw" "0.35" "Thep dai" "" "layer" "n" "Net dam" "c" "1" "Net dam" "lt" "continuous" "Net dam" "lw" "0.4" "Net dam" "" "layer" "s" "Net dam" ""
)

-> giải pháp : Tách 1 dòng trên thành các hàm (command) ngắn hơn là OK

Lisp chạy tốt rồi, rất đúng ý mình. Cảm ơn bạn nhiều, (nhưng cho mình hỏi nếu thêm đối tượng text là MTEXT có được không? nhiều lúc DTEXT cũng bất tiện), có thể chỉnh giúp mình tý nữa là OK luôn. Cảm ơn bạn vì sự nhiệt tình. Chúc bạn sức khoẻ.

Lisp này sẽ sắp xếp cả Text lẫn MTEXT

(defun c:sxtext()
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq ss (ssget '((0 . "TEXT,MTEXT")))
lst (ss2ent ss)
lst (vl-sort lst
'(lambda (e1 e2)
(>
(caddr (assoc 10 (entget e1)))
(caddr (assoc 10 (entget e2)))
)
)
)
)
(command "justifytext" ss "" "TC")
(setq kc (getdist "\n Nhap khoang cach giua cac Text :") i 0)
(if (= (cdr(assoc 0 (entget(car lst)))) "TEXT")
(setq ddau (cdr(assoc 11 (entget(car lst)))))
(setq ddau (cdr(assoc 10 (entget(car lst)))))
)

(foreach e lst
(setq ent (entget e))
(if (= (cdr(assoc 0 ent)) "TEXT")
(setq dcuoi (cdr(assoc 11 ent)))
(setq dcuoi (cdr(assoc 10 ent)))
)
(setq ddauu (list (car ddau) (- (cadr ddau) (* i kc)) 0))
(command "move" e "" dcuoi ddauu)
(setq i (1+ i))
)
(setvar "osmode" oldos)
(Princ)
)

(defun ss2ent (ss / sodt index lstent)
(setq
sodt (if ss (sslength ss) 0)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)
:s_dead:
@conghoan : Bạn hãy thử chạy file Lisp này. Nếu không được nữa thì Tue_NV đành .... bó tay. Vì mình đã test file của bạn rất OK
File đây conghoan test thử nhé. http://www.cadviet.c...files/VBUN7.vlx
Conghoan nhớ rằng Lisp sẽ hiện sáng đối tượng và bạn phải chọn điểm đầu và điểm cuối trên đối tượng hiện sáng đó nhé.
  • 2

#2440 HoangSon614

HoangSon614

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 254 Bài viết
Điểm đánh giá: 66 (tàm tạm)

Đã gửi 18 July 2009 - 06:29 AM

Dịch nghĩa : error: string too long on input"[/b]
Lỗi : Kí tự nhập vào quá dài trong 1 hàm -> phát sinh lỗi
Cụ thể ở dòng này trong Code bạn bị lỗi

-> giải pháp : Tách 1 dòng trên thành các hàm (command) ngắn hơn là OK
Tue_NV nhớ đọc ở đâu đó nói rằng trong một hàm có quy định là số kí tự không được vượt quá bao nhiêu kí tự đó, nhưng giờ quên rồi. Có ai nhắc cho mình nhớ được không> Thanks
Lisp này sẽ sắp xếp cả Text lẫn MTEXT


(defun c:sxtext()
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq ss (ssget '((0 . "TEXT,MTEXT")))
lst (ss2ent ss)
lst (vl-sort lst
'(lambda (e1 e2)
(>
(caddr (assoc 10 (entget e1)))
(caddr (assoc 10 (entget e2)))
)
)
)
)
(command "justifytext" ss "" "TC")
(setq kc (getdist "\n Nhap khoang cach giua cac Text :") i 0)
(if (= (cdr(assoc 0 (entget(car lst)))) "TEXT")
(setq ddau (cdr(assoc 11 (entget(car lst)))))
(setq ddau (cdr(assoc 10 (entget(car lst)))))
)

(foreach e lst
(setq ent (entget e))
(if (= (cdr(assoc 0 ent)) "TEXT")
(setq dcuoi (cdr(assoc 11 ent)))
(setq dcuoi (cdr(assoc 10 ent)))
)
(setq ddauu (list (car ddau) (- (cadr ddau) (* i kc)) 0))
(command "move" e "" dcuoi ddauu)
(setq i (1+ i))
)
(setvar "osmode" oldos)
(Princ)
)

(defun ss2ent (ss / sodt index lstent)
(setq
sodt (if ss (sslength ss) 0)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)
:cheers:

Cảm ơn Tue_NV nhiều lắm, bạn thật là nhiệt tình.
  • 0