Đế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

#2501 duonghung1210

duonghung1210

    biết lệnh offset

  • Members
  • PipPipPip
  • 175 Bài viết
Điểm đánh giá: 61 (tàm tạm)

Đã gửi 26 July 2009 - 01:38 PM

Vậy là độ chế dim rồi.
Bạn thử cái Lisp này Tue_NV viết xem sao :

(defun c:Rdim()
(prompt "\n Moi ban chon cac dim can lam tron :")
(setq ss (ssget '((0 . "DIMENSION")))
i 0)
(while (< i (sslength ss))
(setq ent (entget(ssname ss i)))
(setq content (cdr(assoc 42 ent)))
(setq du (rem content 5))
(if (= du 0) (setq content content))
(if (and (> du 0) (< du 2.5)) (setq content (rtos (- content du) 2 0)))
(if (>= du 2.5) (setq content (rtos (+ content (- 5 du)) 2 0)))
(setq ent (entmod(subst(cons 1 content) (assoc 1 ent) ent)))
(setq i (1+ i))
)
(princ)
)

Cảm ơn bác Tue_NV nhé!!! Lish của bác quá hay, vậy là em sử lý được vụ này roài, hii :s_dead:
  • 0
Nhăn răng ra cười cho đời đỡ khổ!!!

#2502 nh0ckut3t0cv4ngh03

nh0ckut3t0cv4ngh03

    biết pan

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

Đã gửi 26 July 2009 - 07:59 PM

Bạn có thể post yêu cầu về autolisp ở topic này.

Chào các bác ! Giúp em với.
Lỗi này là sao hả các đai ca ơi, các bác sửa cho e nhé :
Command: co
Copy Inteligent...

Select objects: Other corner: 1 found

Select objects:
Select base point:
Select next point: error: null function
(DOITEXT TEN)
(IF (OR (= KIEU "TEXT") (= KIEU "MTEXT")) (DOITEXT TEN) (COPY_DT TEN))
(WHILE (< DEM DODAI) (SETQ TEN (SSNAME CUMDT DEM) DEM (1+ DEM) DOITUONG (ENTGET
TEN) KIEU (CDR (ASSOC 0 DOITUONG))) (IF (OR (= KIEU "TEXT") (= KIEU "MTEXT"))
(DOITEXT TEN) (COPY_DT TEN)))
(WHILE T (SETQ TOI (GETPOINT "\nSelect next point: " GOC) VITRILECH (LIST (-
(CAR TOI) (CAR GOC)) (- (NTH 1 TOI) (NTH 1 GOC))) DEM 0) (WHILE (< DEM DODAI)
(SETQ TEN (SSNAME CUMDT DEM) DEM (1+ DEM) DOITUONG (ENTGET TEN) KIEU (CDR
(ASSOC 0 DOITUONG))) (IF (OR (= KIEU "TEXT") (= KIEU "MTEXT")) (DOITEXT TEN)
(COPY_DT TEN))))
(C:CO)
Làm ơn sửa cho em.
Thanks !
  • 0

#2503 q288

q288

    biết lệnh fillet

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

Đã gửi 27 July 2009 - 07:27 AM

Chào các bác ! Giúp em với.
Lỗi này là sao hả các đai ca ơi, các bác sửa cho e nhé :
Command: co
Copy Inteligent...

Select objects: Other corner: 1 found

Select objects:
Select base point:
Select next point: error: null function
(DOITEXT TEN)
(IF (OR (= KIEU "TEXT") (= KIEU "MTEXT")) (DOITEXT TEN) (COPY_DT TEN))
(WHILE (< DEM DODAI) (SETQ TEN (SSNAME CUMDT DEM) DEM (1+ DEM) DOITUONG (ENTGET
TEN) KIEU (CDR (ASSOC 0 DOITUONG))) (IF (OR (= KIEU "TEXT") (= KIEU "MTEXT"))
(DOITEXT TEN) (COPY_DT TEN)))
(WHILE T (SETQ TOI (GETPOINT "\nSelect next point: " GOC) VITRILECH (LIST (-
(CAR TOI) (CAR GOC)) (- (NTH 1 TOI) (NTH 1 GOC))) DEM 0) (WHILE (< DEM DODAI)
(SETQ TEN (SSNAME CUMDT DEM) DEM (1+ DEM) DOITUONG (ENTGET TEN) KIEU (CDR
(ASSOC 0 DOITUONG))) (IF (OR (= KIEU "TEXT") (= KIEU "MTEXT")) (DOITEXT TEN)
(COPY_DT TEN))))
(C:CO)
Làm ơn sửa cho em.
Thanks !


Do thiếu hàm doitext.
  • 1

#2504 nttu

nttu

    biết zoom

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

Đã gửi 27 July 2009 - 01:38 PM

Tôi có 1 bản vẽ gồm các điểm có (x,y,z) muốn dùng lisp để tão ra các text z bên cạnh các điểm, có số thập phân tùy chọn.
  • 0

#2505 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 27 July 2009 - 03:31 PM

Tôi có 1 bản vẽ gồm các điểm có (x,y,z) muốn dùng lisp để tão ra các text z bên cạnh các điểm, có số thập phân tùy chọn.

Bạn chạy thử Lisp này.
(defun C:MakeText(/ ss sole size dimzin cmd sty pt)
(princ "\nChon Point de ghi gia tri cao do (z) :")
(if (setq ss (ssget (list (cons 0 "POINT")) ))
(progn
(or *sole* (setq *sole* 2))
(initget 4)
(setq sole (getint (strcat "\nNhap so so thap phan <" (itoa *sole*) ">:"))
size (getvar "TextSize")
dimzin (getvar "dimzin")
cmd (getvar "cmdecho")
sty (getvar "textstyle")
)
(if sole (setq *sole* sole)(setq sole *sole*))
(setvar "dimzin" 0)(setvar "cmdecho" 0)
(foreach e (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(entmakex (list (cons 0 "TEXT")
(cons 10 (setq pt(cdr (assoc 10 e))))
(cons 1 (rtos (caddr pt)2 sole))
(cons 7 sty)
(cons 40 size)))
)
(setvar "dimzin" dimzin)(setvar "cmdecho" cmd)
)
(princ "\nKhong co Point nao duoc chon.")
)
(princ)
)

  • 2

#2506 dkkx3a

dkkx3a

    biết lệnh trim

  • Members
  • PipPipPip
  • 190 Bài viết
Điểm đánh giá: 57 (tàm tạm)

Đã gửi 27 July 2009 - 09:14 PM

Bạn thử dùng Lisp này xem sao ?
chuyển các đối tuợng về Layer mới có tên LINETYLE+COLOR

Trước hết xin cảm ơn Bác GiaBach nhưng lisp này vẫn chưa giải quyết được các vấn đề mình gặp phải. Vẫn ngồi chữa từng cái một rất mệt. Bác có thể cải tiến giúp để hàm phát sinh thêm nhiều LAyer giống như mình nhờ được không. Nhiêu layer thì việc ngồi giải quyết việc trộn gộp layer sẽ đỡ phức tạp hơn. Cảm ơn trước.............
Trích bài bạn dẫn.........
"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)"
(Vẫn hạn chế trong việc 'quy hoạch' đối tượng)

Mình đã nhờ: Trích dẫn(dkkx3a @ Jul 25 2009, 20:32)
.............."Xin nhờ các bạn trên diễn đàn viết hộ cho một Lisp, chả là cũng lục đục viết mà kém quá nên chịu.
Mình thường "ngồi" in các bản vẽ của người khác, khi in thì phải chọn nét in: chọn theo màu hoặc độ dày đối tượng. Nhưng kẹt nỗi nhiều bản vẽ bố trí layer lộn xộn, màu hỗn loạn, in xong một bản vẽ cho có hồn muốn lòi con mắt.
Mình nhờ các bạn viết 1 lisp chọn cả bản vẽ, nó sẽ tự lọc màu và đưa vào layer tương ứng, ví dụ như màu đỏ cho vào layer "Color1", vàng vào layer "color2"........., những màu có chỉ số >=10 thì cho vào một layer riêng. Các nét đứt, nét tâm cũng vậy cho vào layer riêng. Còn các ngoại lệ thì mình cố gắng căng mắt vậy (ẩn layer để chỉnh) sợ yêu cầu nhiều mất thời gian của các anh chị em. Mình cảm ơn trước. Đang rất cần cái này........trước mắt là một khối bản vẽ phải in của các "tác gia" không chuyên....Thanks """
  • 0
TỰ SỰ
Biển vào chiều buồn giữa cô liêu
Sóng vỗ bờ bạc đầu con nước
Khi biển động như lòng ta chợt động
Biển ồn ào nhưng thực rất dịu êm.......

#2507 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 28 July 2009 - 07:30 AM

.......................
Mình nhờ các bạn viết 1 lisp chọn cả bản vẽ, nó sẽ tự lọc màu và đưa vào layer tương ứng, ví dụ như màu đỏ cho vào layer "Color1", vàng vào layer "color2"........., những màu có chỉ số >=10 thì cho vào một layer riêng. Các nét đứt, nét tâm cũng vậy cho vào layer riêng. Còn các ngoại lệ thì mình cố gắng căng mắt vậy (ẩn layer để chỉnh) sợ yêu cầu nhiều mất thời gian của các anh chị em. Mình cảm ơn trước. Đang rất cần cái này........trước mắt là một khối bản vẽ phải in của các "tác gia" không chuyên....Thanks """

Vấn đề lọc màu và đưa vào layer tương ứng thì OK.
Tuy nhiên với : Các nét đứt, nét tâm cũng vậy cho vào layer riêng trong truờng hợp đối tuợng có màu đỏ và LineType=center bạn sẽ đưa vào layer nào ?
- layer "Color1" hay layer "center " ?
  • 2

#2508 conghoan1003

conghoan1003

    biết vẽ point

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

Đã gửi 28 July 2009 - 08:06 PM

Cái này mình cũng đã thử rồi nhưng vẫn không có tác dụng gì. Mình đang dùng cad 2007 liệu có ảnh hưởng gì không Tuê_NV. Hình như Tuê_NV dùng lệnh trim để nối nó lại với nhau à? Tuệ_NV có thể chuyển sang dùng lệnh fillet (với R=0) được không? phải thử giải pháp này thế nào chứ Tuê_NV "bó tay" thì mình cũng "bó chân" luôn. Thấy cái này hay thế mà chưa sử dụng được thấy tiết quá. Tuệ cố gắng giúp mình lần nữa nhé. Thank a lot!

Bác Tue_NV ơi chẳng lẽ lại bó tay thật hả?
Tiết thật! Mình cũng chẳng hiểu tại sao Bác test được mà mình làm lại không được nữa!
Dù sao cũng cảm ơn Tuê_NV nhiều đã nhiệt tình giups đỡ cho anh em!
  • 0
Học học nữa học mãi.
Đúp học lại!

#2509 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 28 July 2009 - 08:28 PM

Bác Tue_NV ơi chẳng lẽ lại bó tay thật hả?
Tiết thật! Mình cũng chẳng hiểu tại sao Bác test được mà mình làm lại không được nữa!
Dù sao cũng cảm ơn Tuê_NV nhiều đã nhiệt tình giups đỡ cho anh em!

Conghoan hãy chờ đợi. Tue_NV đang tìm 1 phương án khả thi hơn. Mình đã thử test trên CAD2007 rồi, tại sao lại bị lỗi như vậy
Cong hoan chịu khó chờ nhé. Dạo này Tue_NV hơi bận. Tue_NV đang tìm phương án khác để hoàn thiện nó.
Chào conghoan
  • 0

#2510 dkkx3a

dkkx3a

    biết lệnh trim

  • Members
  • PipPipPip
  • 190 Bài viết
Điểm đánh giá: 57 (tàm tạm)

Đã gửi 30 July 2009 - 11:02 AM

Vấn đề lọc màu và đưa vào layer tương ứng thì OK.
Tuy nhiên với : Các nét đứt, nét tâm cũng vậy cho vào layer riêng trong truờng hợp đối tuợng có màu đỏ và LineType=center bạn sẽ đưa vào layer nào ?
- layer "Color1" hay layer "center " ?



Cảm ơn gia bạch quan tâm, mấy hôm nay công việc bận quá, đi công tác nên không check bài được. Trường hợp bạn nêu mình không nghĩ tới.........., vậy mình chỉ muốn nhờ bạn viết giúp đoạn mã lọc các đối tượng theo màu và đưa vào các layer tương ứng. Cảm ơn bác Giabach nhiều. Mong nhờ bạn giúp đỡ. Mặc dù bây giờ công việc in ấn mình tạm nhờ anh bạn trong phòng (lính mới) nhưng chắc xong công tác mình vẫn phải giải quyết mà............Cảm ơn GiaBach và diễn đàn.)
  • 0
TỰ SỰ
Biển vào chiều buồn giữa cô liêu
Sóng vỗ bờ bạc đầu con nước
Khi biển động như lòng ta chợt động
Biển ồn ào nhưng thực rất dịu êm.......

#2511 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 30 July 2009 - 01:17 PM

Cảm ơn gia bạch quan tâm, mấy hôm nay công việc bận quá, đi công tác nên không check bài được. Trường hợp bạn nêu mình không nghĩ tới.........., vậy mình chỉ muốn nhờ bạn viết giúp đoạn mã lọc các đối tượng theo màu và đưa vào các layer tương ứng. Cảm ơn bác Giabach nhiều. Mong nhờ bạn giúp đỡ. Mặc dù bây giờ công việc in ấn mình tạm nhờ anh bạn trong phòng (lính mới) nhưng chắc xong công tác mình vẫn phải giải quyết mà............Cảm ơn GiaBach và diễn đàn.)

bạn chạy thử LISP lọc các đối tượng theo màu và đưa vào các layer tương ứng.
(defun C:Clt (/ ss e mau layname)
(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)
(if (setq ss (ssget "_X" (list (cons 410 (getvar "CTAB") ) )))
(foreach e (mapcar 'cadr (ssnamex ss))
(or
(setq mau (dxf 62 e))
(setq mau (cdr(assoc 62 (tblsearch "layer" (dxf 8 e)))) ) )
(setq layname (itoa (abs mau)))
(or (tblsearch "layer" layname)(command "_.LAYER" "N" layname "c" mau layname ""))
(ModEnt 8 layname e)
)
)
(command "_.undo" "_end")
(princ)
)

  • 4

#2512 conghoan1003

conghoan1003

    biết vẽ point

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

Đã gửi 30 July 2009 - 02:04 PM

Conghoan hãy chờ đợi. Tue_NV đang tìm 1 phương án khả thi hơn. Mình đã thử test trên CAD2007 rồi, tại sao lại bị lỗi như vậy
Cong hoan chịu khó chờ nhé. Dạo này Tue_NV hơi bận. Tue_NV đang tìm phương án khác để hoàn thiện nó.
Chào conghoan

Cảm ơn Tue_NV nhiều. Mình rất vui khi biết lisp này vẫn còn hy vọng để hoàn thiện. Mình thấy có một nguyên nhân làm cho mình test không thành công xin được góp ý để Tue sửa lại cho dễ nha. Cad 2004 mình test cũng như cad 2007 chứ không ảnh hưởng gì cả, 2004 vẫn lỗi như thế. Và cùng có chung một nguyên nhân là polyline tự nhiên quá dốc thì xảy ra lỗi này, còn nếu như đường polyline bằng phẳng thì OK. Mình đinh up file cho Tue de nhin nhưng uo hoài không được. mình nói chung là thế này: nếu đường mái dốc cắt đường offset bên dưới thì nó nối lại với nhau còn không thì nó không nối lại với nhau được. Khi nào rãnh Tue_NV nghieng cuu giúp nha!
Thank!
  • 0
Học học nữa học mãi.
Đúp học lại!

#2513 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 01 August 2009 - 09:36 PM

Còn nếu bạn muốn thì Tue_NV sẽ thêm vào Code cho bạn

;; copyright by Tue_NV
(defun c:dstt(/ dau tong po po1 ent i)
(prompt "\n Danh so thu tu dang n/m ")
(setvar "cmdecho" 0)

(setq dau (getint "\n Danh so bat dau (n) :"))
(setq tong (getint "\n Danh so tong (m) :") i 1)

(setq po (getpoint
(strcat "\n Cho diem chen cua so : " (if (< dau 10) (strcat "0" (itoa dau)) (itoa dau)) "/" (itoa tong))))
(wtxt (strcat (if (< dau 10) (strcat "0" (itoa dau)) (itoa dau)) "/" (itoa tong)) po)

(Repeat (- tong dau)
(setq po1 (getpoint po
(strcat "\n Cho diem chen cua so : " (if (< (+ dau i) 10) (strcat "0" (itoa (+ dau i))) (itoa (+ dau i))) "/" (itoa tong))))

(command "copy" "L" "" po po1)
(setq ent (entget(entlast)))
(setq ent
(subst
(cons 1 (strcat (if (< (+ dau i) 10) (strcat "0" (itoa (+ dau i))) (itoa (+ dau i))) "/" (itoa tong))) (assoc 1 ent) ent))
(entmod ent)
(setq i (1+ i))
(setq po po1)
)
(princ)
)
;
(defun wtxt (txt p / sty d h)
(setq sty (getvar "textstyle")
d (tblsearch "style" sty)
h (cdr (assoc 40 d)))
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 11 p)
(cons 72 1) (cons 73 2)
(if (> h 0) (cons 40 h) (assoc 40 d)) (assoc 41 d))
)
)

:cheers: [/b]
[/quote]
Tue_NV giúp mình tý nha.
Mình nhờ bạn viết thêm vào lisp trên cho mình như sau:
1. gán giá trị text là Vni-helve, cao chữ 2.5
2. Vẫn lisp đó nhưng mình muốn thêm vào nội dung ký hiệu bản vẽ trước khi lisp hỏi đánh số bắt đầu và đánh số tổng (cái này mình dùng để đánh ký hiệu bản vẽ), cụ thể như:
Khi thực hiện lệnh:
dstt -> nhập ký hiệu bản vẽ (VD - KC hoặc KT...) -> đánh số bắt đầu -> đánh số tổng -> OK (VD: KC: 01/3...KC: 03/3; KT: 01/3....KT:03/3)
gán giá trị text là Vni-helve, cao chữ 2.5
Nghe bạn nói dạo này bạn rất bận, khi nào rãnh cố gắng xem giúp mình. Cảm ơn bạn nhiều, mình chờ tin bạn
  • 1

#2514 790312

790312

    biết lệnh fillet

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

Đã gửi 01 August 2009 - 10:39 PM

Lệnh là SD (sắp dim)

Chương trình sẽ yêu cầu người sử dụng chọn đường Dim chuẩn. Sau đó, yêu cầu người sử dụng chọn các đường Dim cần sắp xếp. Chương trình sẽ tự động dàn các Dim theo hàng đều.
Hình đã gửi


(defun c:sd ()
(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)
)
(defun hoanh_newerror (msg)
(if (and (/= msg "Function cancelled")
(/= msg "quit / exit abort")
)
(princ (strcat "\n" msg))
)
(done)
)
;;----------
(defun init ()
(setq
HOANH_CMD (getvar "CMDECHO")
HOANH_OLDERROR *error*
*error* hoanh_newerror

)
(setvar "CMDECHO" 0)
(command ".undo" "BE")
)
;;----------
(defun done ()
(command ".redraw")
(command ".undo" "E")
(if HOANH_CMD
(setvar "CMDECHO" HOANH_CMD)
)
(if HOANH_OLDERROR
(setq *error* HOANH_OLDERROR)
)
(princ)
)
;;----------

(defun cdim (entdt pchan pduong / tt old10
old13 old14 new10 new13 new14 p10n
p13n p14n p10o p13o p14o gocduong
gocchan pchanb pduongb loaidim
)
(defun chanvuonggoc (ph p1 p2 / ptemp pkq goc)
(setq
goc (+ (angle p1 p2) (/ pi 2.0))
ptemp (polar ph goc 1000.0)
pkq (inters ph ptemp p1 p2 nil)
)
pkq
)
(setq
tt (entget entdt)
old10 (assoc '10 tt)
old13 (assoc '13 tt)
old14 (assoc '14 tt)
p10o (cdr old10)
p13o (cdr old13)
p14o (cdr old14)
loaidim (logand (cdr (assoc '70 tt)) 7)
gocduong (cond
((= loaidim 1) (angle p13o p14o))
((= loaidim 0) (cdr (assoc '50 tt)))
(t nil)
)
pchan (cond
(pchan (list (car pchan) (cadr pchan) 0.0))
(t pchan)
)
pduong (cond
(pduong (list (car pduong) (cadr pduong) 0.0))
(t pduong)
)

)
(if gocduong
(progn
(if pchan
(setq
pchanb (polar pchan gocduong 1000.0)
p13n (chanvuonggoc
(list (car p13o) (cadr p13o) 0.0)
pchan
pchanb
)
p14n (chanvuonggoc
(list (car p14o) (cadr p14o) 0.0)
pchan
pchanb
)
new13 (cons 13 p13n)
new14 (cons 14 p14n)
tt (subst new13 old13 tt)
tt (subst new14 old14 tt)
)
)
(if pduong
(setq
pduongb (polar pduong gocduong 1000.0)
p10n (chanvuonggoc
(list (car p10o) (cadr p10o) 0.0)
pduong
pduongb
)
new10 (cons 10 p10n)
tt (subst new10 old10 tt)
)
)
(entmod tt)
)
)
gocduong
)

(defun textdimheight (ent / tmp)
(command ".copy" ent "" (list 0.0 0.0 0.0) "@")
(command ".explode" (entlast) "")
(setq tmp (cdr (assoc 40 (entget (entlast)))))
(command ".erase" "p" "")
tmp
)
(defun phia (p1 p2 p3 / x1 y1 z1 x2 y2 z2 x3 y3 z3)
(setq
x1 (car p1)
y1 (cadr p1)
z1 (caddr p1)
x2 (car p2)
y2 (cadr p2)
z2 (caddr p2)
x3 (car p3)
y3 (cadr p3)
z3 (caddr p3)
tmp (+ (* (- x1 x2) x3)
(* (- y1 y2) y3)
(* (- z1 z2) z3)
)
)
(cond
((= tmp 0.0) 0.0)
(t (/ tmp (abs tmp)))
)
)
(defun khoangcachdim (p1 ent goc / tt p2 A B D)
(setq tt (entget ent)
p2 (cdr (assoc 10 tt))
B (cdr (assoc 50 tt))
A (angle p1 p2)
D (distance p1 p2)
)
(* (* D (sin (- A [b]B )[/b])) (phia p1 (polar p1 goc 1.0) p2))
)

(defun phanloai (ent)
(setq
kc (khoangcachdim pgoc ent goc)
loai (fix (/ kc heightdimgoc 0.93))
)
(cons loai ent)
)

(init)
(princ "\nSap xep dim © CADViet.com")
(while (not (setq entgoc (car (entsel "\nChon duong dim goc: "))))
)
(setq
ttgoc (entget entgoc)
p13goc (cdr (assoc 13 ttgoc))
pgoc (cdr (assoc 10 ttgoc))
goc (cdr (assoc 50 ttgoc))
heightdimgoc (textdimheight entgoc)
ssd (ssget (list
(cons 0 "DIMENSION")
(cons -4 " (cons 70 32)
(cons 70 64)
(cons 70 96)
(cons 70 128)
(cons 70 160)
(cons 70 196)
(cons 70 224)
(cons -4 "OR>")
(cons -4 " (cons 50 goc)
(cons 50 (+ goc pi))
(cons 50 (- goc pi))
(cons -4 "OR>")
)
)
lstd (ss2ent ssd)
lstd (mapcar 'phanloai lstd)
lstlevel nil
)
(foreach pp lstd
(if (not (member (car pp) lstlevel))
(setq lstlevel (append lstlevel (list (car pp))))
)
)
(setq lstlevel (vl-sort lstlevel '(lambda (x1 x2) (< x1 x2)))
lstam nil
lstduong nil
lstamtmp nil
lstduongtmp nil
)
(foreach pp lstlevel
(if (< pp 0.0)
(setq lstam (append lstam (list pp)))
)
(if (> pp 0.0)
(setq lstduong (append lstduong (list pp)))
)
)
(setq index 0)
(foreach pp (reverse lstam)
(setq
index (1+ index)
lstamtmp (append lstamtmp (list (cons pp index)))
)
)
(setq
lstam lstamtmp
index 0
)
(foreach pp lstduong
(setq
index (1+ index)
lstduongtmp (append lstduongtmp (list (cons pp index)))
)
)
(setq lstduong lstduongtmp)
(setq lstlevel (append lstduong lstam (list (cons 0.0 0))))

(setq kcdimstandard (* 3.0 heightdimgoc))
(foreach pp lstd
(setq plht (car pp))
(progn
(setq
kcdimht (khoangcachdim pgoc (cdr pp) goc)
duongthu (cdr (assoc plht lstlevel))
heso (cond
((/= 0 kcdimht)
(abs (* (/ kcdimstandard kcdimht) duongthu))
)
(t 0.0)
)
diemchenht (cdr (assoc 10 (entget (cdr pp))))
pmoi (polar pgoc
(angle pgoc diemchenht)
(* heso (distance pgoc diemchenht))
)
)

(cdim (cdr pp) p13goc pmoi)
)
)
(done)
)
(princ "\nSap xep dim, SD - free lisp from www.cadviet.com")
(princ)

Bác Hoành ơi,sau khi e đánh chữ SD vào nó kêu chọn đường dim goc,sau đó kêu chọn đối tượng,sau khi thực hiện thì cuối cùng báo lỗi là:
bad argument type: numberp: nil.Mong bác giúp em.Thanks
  • 0

#2515 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 01 August 2009 - 10:52 PM

Tue_NV giúp mình tý nha.
Mình nhờ bạn viết thêm vào lisp trên cho mình như sau:
1. gán giá trị text là Vni-helve, cao chữ 2.5
2. Vẫn lisp đó nhưng mình muốn thêm vào nội dung ký hiệu bản vẽ trước khi lisp hỏi đánh số bắt đầu và đánh số tổng (cái này mình dùng để đánh ký hiệu bản vẽ), cụ thể như:
Khi thực hiện lệnh:
dstt -> nhập ký hiệu bản vẽ (VD - KC hoặc KT...) -> đánh số bắt đầu -> đánh số tổng -> OK (VD: KC: 01/3...KC: 03/3; KT: 01/3....KT:03/3)
gán giá trị text là Vni-helve, cao chữ 2.5
Nghe bạn nói dạo này bạn rất bận, khi nào rãnh cố gắng xem giúp mình. Cảm ơn bạn nhiều, mình chờ tin bạn

Hy vọng Code này sẽ làm hài lòng HoangSon :

;; copyright by Tue_NV
(defun c:dstt(/ dau tong po po1 ent i pre cao)
(prompt "\n Danh so thu tu dang n/m ")
(setvar "cmdecho" 0)

(command "style" "CADVIET" "Vhelven.TTF" "0" "1" "0" "n" "n")


(setq cao (getreal "\n Nhap chieu cao chu :"))
(setq pre (getstring 5"\n Nhap chuoi truoc so ban ve : "))
(setq dau (getint "\n Danh so bat dau (n) :"))
(setq tong (getint "\n Danh so tong (m) :") i 1)

(setq po (getpoint
(strcat "\n Cho diem chen cua so : " (if (< dau 10) (strcat pre "0" (itoa dau)) (itoa dau)) "/" (itoa tong))))
(wtxt (strcat (if (< dau 10) (strcat pre "0" (itoa dau)) (itoa dau)) "/" (itoa tong)) po)

(Repeat (- tong dau)
(setq po1 (getpoint po
(strcat "\n Cho diem chen cua so : " (if (< (+ dau i) 10) (strcat pre "0" (itoa (+ dau i))) (itoa (+ dau i))) "/" (itoa tong))))

(command "copy" "L" "" po po1)
(setq ent (entget(entlast)))
(setq ent
(subst
(cons 1 (strcat (if (< (+ dau i) 10) (strcat pre "0" (itoa (+ dau i))) (itoa (+ dau i))) "/" (itoa tong))) (assoc 1 ent) ent))
(entmod ent)
(setq i (1+ i))
(setq po po1)
)
(princ)
)
;
(defun wtxt (txt p / sty d h)
(setq sty (getvar "textstyle")
d (tblsearch "style" sty)
h (cdr (assoc 40 d)))
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 11 p)
(cons 72 1) (cons 73 2)
(if (> h 0) (cons 40 h) (assoc 40 d)) (assoc 41 d))
)
)
:s_dead:

@790312 : Đề nghị bạn đọc từ đầu đến cuối những bài viết liên quan đến Lisp sắp dim của bác Hoành .
Bạn đọc bài mà bỏ dở giữa chừng thì bạn làm không được đó cũng là điều dễ hiểu và chẳng có ai có thể giúp bạn được trong trường hợp này cả
Khi làm việc thì nên làm đến nơi đến chốn đừng bao giờ bỏ dở giữa chừng. Điều đó là không nên.
Thứ nữa là bạn không nên post bài cùng 1 nội dung mà ở 2 chủ đề khác nhau là điều không nên và làm khó cho người đọc và theo dõi. Bạn nên sử dụng chức năng tìm kiếm của diễn đàn trước khi lập 1 topic mới

Vài lời khuyên và góp ý cùng bạn
  • 4

#2516 790312

790312

    biết lệnh fillet

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

Đã gửi 02 August 2009 - 06:56 AM

Hy vọng Code này sẽ làm hài lòng HoangSon :


;; copyright by Tue_NV
(defun c:dstt(/ dau tong po po1 ent i pre cao)
(prompt "\n Danh so thu tu dang n/m ")
(setvar "cmdecho" 0)

(command "style" "CADVIET" "Vhelven.TTF" "0" "1" "0" "n" "n")
(setq cao (getreal "\n Nhap chieu cao chu :"))
(setq pre (getstring 5"\n Nhap chuoi truoc so ban ve : "))
(setq dau (getint "\n Danh so bat dau (n) :"))
(setq tong (getint "\n Danh so tong (m) :") i 1)

(setq po (getpoint
(strcat "\n Cho diem chen cua so : " (if (< dau 10) (strcat pre "0" (itoa dau)) (itoa dau)) "/" (itoa tong))))
(wtxt (strcat (if (< dau 10) (strcat pre "0" (itoa dau)) (itoa dau)) "/" (itoa tong)) po)
(Repeat (- tong dau)
(setq po1 (getpoint po
(strcat "\n Cho diem chen cua so : " (if (< (+ dau i) 10) (strcat pre "0" (itoa (+ dau i))) (itoa (+ dau i))) "/" (itoa tong))))

(command "copy" "L" "" po po1)
(setq ent (entget(entlast)))
(setq ent
(subst
(cons 1 (strcat (if (< (+ dau i) 10) (strcat pre "0" (itoa (+ dau i))) (itoa (+ dau i))) "/" (itoa tong))) (assoc 1 ent) ent))
(entmod ent)
(setq i (1+ i))
(setq po po1)
)
(princ)
)
;
(defun wtxt (txt p / sty d h)
(setq sty (getvar "textstyle")
d (tblsearch "style" sty)
h (cdr (assoc 40 d)))
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 11 p)
(cons 72 1) (cons 73 2)
(if (> h 0) (cons 40 h) (assoc 40 d)) (assoc 41 d))
)
)
:s_dead:

@790312 : Đề nghị bạn đọc từ đầu đến cuối những bài viết liên quan đến Lisp sắp dim của bác Hoành .
Bạn đọc bài mà bỏ dở giữa chừng thì bạn làm không được đó cũng là điều dễ hiểu và chẳng có ai có thể giúp bạn được trong trường hợp này cả
Khi làm việc thì nên làm đến nơi đến chốn đừng bao giờ bỏ dở giữa chừng. Điều đó là không nên.
Thứ nữa là bạn không nên post bài cùng 1 nội dung mà ở 2 chủ đề khác nhau là điều không nên và làm khó cho người đọc và theo dõi. Bạn nên sử dụng chức năng tìm kiếm của diễn đàn trước khi lập 1 topic mới

Vài lời khuyên và góp ý cùng bạn

Xin lỗi diễn đàn,mình viết bài kia trước và phát hiện mục này sau.Thanks
  • 0

#2517 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 02 August 2009 - 07:29 AM

Hy vọng Code này sẽ làm hài lòng HoangSon :


;; copyright by Tue_NV
(defun c:dstt(/ dau tong po po1 ent i pre cao)
(prompt "\n Danh so thu tu dang n/m ")
(setvar "cmdecho" 0)

(command "style" "CADVIET" "Vhelven.TTF" "0" "1" "0" "n" "n")
(setq cao (getreal "\n Nhap chieu cao chu :"))
(setq pre (getstring 5"\n Nhap chuoi truoc so ban ve : "))
(setq dau (getint "\n Danh so bat dau (n) :"))
(setq tong (getint "\n Danh so tong (m) :") i 1)

(setq po (getpoint
(strcat "\n Cho diem chen cua so : " (if (< dau 10) (strcat pre "0" (itoa dau)) (itoa dau)) "/" (itoa tong))))
(wtxt (strcat (if (< dau 10) (strcat pre "0" (itoa dau)) (itoa dau)) "/" (itoa tong)) po)

(Repeat (- tong dau)
(setq po1 (getpoint po
(strcat "\n Cho diem chen cua so : " (if (< (+ dau i) 10) (strcat pre "0" (itoa (+ dau i))) (itoa (+ dau i))) "/" (itoa tong))))

(command "copy" "L" "" po po1)
(setq ent (entget(entlast)))
(setq ent
(subst
(cons 1 (strcat (if (< (+ dau i) 10) (strcat pre "0" (itoa (+ dau i))) (itoa (+ dau i))) "/" (itoa tong))) (assoc 1 ent) ent))
(entmod ent)
(setq i (1+ i))
(setq po po1)
)
(princ)
)
;
(defun wtxt (txt p / sty d h)
(setq sty (getvar "textstyle")
d (tblsearch "style" sty)
h (cdr (assoc 40 d)))
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 11 p)
(cons 72 1) (cons 73 2)
(if (> h 0) (cons 40 h) (assoc 40 d)) (assoc 41 d))
)
)
:cheers:

Rất cảm ơn sự nhiệt tình của bạn (cho mình hỏi riêng tư tý nha, mình thấy bạn thường vào mạng vào những thời điểm mọi người đã ngủ hoặc chưa dậy vậy là do công việc của bạn hay sao)
Một lần nữa cảm ơn bạn nhiều.
  • 2

#2518 dkkx3a

dkkx3a

    biết lệnh trim

  • Members
  • PipPipPip
  • 190 Bài viết
Điểm đánh giá: 57 (tàm tạm)

Đã gửi 03 August 2009 - 10:47 PM

bạn chạy thử LISP lọc các đối tượng theo màu và đưa vào các layer tương ứng.

(defun C:Clt (/ ss e mau layname)
(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)
(if (setq ss (ssget "_X" (list (cons 410 (getvar "CTAB") ) )))
(foreach e (mapcar 'cadr (ssnamex ss))
(or
(setq mau (dxf 62 e))
(setq mau (cdr(assoc 62 (tblsearch "layer" (dxf 8 e)))) ) )
(setq layname (itoa (abs mau)))
(or (tblsearch "layer" layname)(command "_.LAYER" "N" layname "c" mau layname ""))
(ModEnt 8 layname e)
)
)
(command "_.undo" "_end")
(princ)
)

Thanks, Gia bach. Đúng như mình mong muốn, và đã thanks cho bạn rồi..........rất tiếc chỉ thanks được 1 lần. hihi
  • 0
TỰ SỰ
Biển vào chiều buồn giữa cô liêu
Sóng vỗ bờ bạc đầu con nước
Khi biển động như lòng ta chợt động
Biển ồn ào nhưng thực rất dịu êm.......

#2519 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 04 August 2009 - 12:56 AM

Thanks, Gia bach. Đúng như mình mong muốn, và đã thanks cho bạn rồi..........rất tiếc chỉ thanks được 1 lần. hihi

Spam ngoài lề: hihi...Gia Bach đã post đc 195 bài, vậy là bạn có thể thank tối đa 195 lần cho Gia Bach đó. có lần mình đã thank 100 lần cho một anh. xét cho cùng thì thời gian mình bấm thank chả đáng bao nhiêu so với thời gian ai đó bỏ ra viết lisp cho mình. trong quá trính thank mình còn tổng hợp được vô khối lisp hay của anh ấy.
  • 0

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#2520 xuandao0708

xuandao0708

    biết lệnh scale

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

Đã gửi 04 August 2009 - 02:08 PM

Nhờ Bác q288 coi lại dùm em tại sao bản vẽ này không thể chạy bảng tạo độ bởi lisp VC được, mặc dù em đã chạy thử nhiều thửa khác nhau nhưng vẫn không được.
Dưới đây là bản vẽ của em.
http://www.cadviet.c...les/2/mau_4.dwg
Không biết bác nào có lisp xóa line trùng của Bác SSG giới thiệu không vậy? Nếu có thì cho em xin với. Thank các Bác nhiều. :s_dead:
  • 0