Chuyển đến nội dung
Diễn đàn CADViet
Nguyen Hoanh

Viết Lisp theo yêu cầu

Các bài được khuyến nghị

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:

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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 !

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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.

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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)
 )

  • Vote tăng 2

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
.......................

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 " ?

  • Vote tăng 2

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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.)

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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)
 )

  • Vote tăng 4

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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]

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

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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.

sapdim.gif

(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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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 ((wtxt (strcat (if (
(Repeat (- tong dau)
(setq po1 (getpoint po 
(strcat "\n Cho diem chen cua so : " (if (
(command "copy" "L" "" po po1) 
(setq ent (entget(entlast)))
(setq ent 
(subst 
(cons 1 (strcat (if ((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

  • Vote tăng 4

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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.

  • Vote tăng 2

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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.com/upfiles/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:

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
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.com/upfiles/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:

 

 

Do ucs của bản vẽ này không phải là world, trước khi vào lệnh hoặc sau khi mở file, bạn gõ lệnh ucs rồi enter hoặc gõ W rồi enter.

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Chào các bác!

Các bác cho mình hỏi cái này tí: Trong bản vẽ của mình có nhiều text thuộc nhiều style khác nhau. Nhưng mà nó lại chẳng nhận chiều cao của style đó. Mình đang tìm một cái lệnh nào để đưa tấc cả các chiều cao của text về đúng chiều cao trong style của text đó. Nếu không cho mình xin cái lisp để làm việc này.

Cảm ơn nhiều!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Thank Bác q228 nhiều, nhân tiện đây nhờ Bác cải tiến chút ích lệnh KT, tại vì khi làm bản vẽ phân lô thì chạy kích thước chì nên là tròn là 1 số thôi. Còn lisp Bác viết cho em thì khi chạy nó làm tròn 2 số lẻ. Nay em nhờ Bác chỉnh lại 1 chút là sau khi nhập tỷ lệ thì nó sẽ hỏi giá trị làm tròn là 1 hay 2 số lẽ. Cá mơn Bác nhiều.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Chào các bác!

Các bác cho mình hỏi cái này tí: Trong bản vẽ của mình có nhiều text thuộc nhiều style khác nhau. Nhưng mà nó lại chẳng nhận chiều cao của style đó. Mình đang tìm một cái lệnh nào để đưa tấc cả các chiều cao của text về đúng chiều cao trong style của text đó. Nếu không cho mình xin cái lisp để làm việc này.

Cảm ơn nhiều!

Lisp đưa tất cả các text về đúng chiều cao trong style của text đó. (Trừ truờng hợp chiều cao của text khai báo trong TextStyle =0)

Lisp chưa tối ưu về thời gian nhưng kết quả chấp nhận đuợc. :s_dead:

(defun C:Cth (/ ss e txtsize)
 (defun dxf(id entdata) (cdr (assoc id entdata)) )
 (defun ModEnt(id newval ds / ds)
   (setq 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 0 "TEXT" )(cons 410 (getvar "CTAB") ) )))
   (foreach e (mapcar 'entget (mapcar 'cadr (ssnamex ss)))
     (setq txtsize (dxf 40 (tblsearch "style" (dxf 7 e))));ch/cao Text cua TextStyle
     (if (/= txtsize 0)(ModEnt 40 txtsize e));bo qua t/hop ch/cao Text cua TextStyle=0
     )
   )
 (command "_.undo" "_end")
 (princ)
 )

  • Vote tăng 2

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Thank Bác q228 nhiều, nhân tiện đây nhờ Bác cải tiến chút ích lệnh KT, tại vì khi làm bản vẽ phân lô thì chạy kích thước chì nên là tròn là 1 số thôi. Còn lisp Bác viết cho em thì khi chạy nó làm tròn 2 số lẻ. Nay em nhờ Bác chỉnh lại 1 chút là sau khi nhập tỷ lệ thì nó sẽ hỏi giá trị làm tròn là 1 hay 2 số lẽ. Cá mơn Bác nhiều.

 

Sửa theo ý bạn rồi đây.

(defun muiten(pt an)
  (entmakex (append '((0 . "LWPOLYLINE") (100 . "AcDbEntity")  (8 . "Kthuoc") (100 . "AcDbPolyline") (90 . 3)) 
		(list (cons 10 pt)  '(41 . 0.33) '(42 . 0.0)
	      (cons 10 (polar pt an 0.9))  '(41 . 0.0) '(42 . 0.0)
	      (cons 10 (polar pt an 1.8)))))
)

(defun laydinh(plObj / n L)
(setq 	n -1
L nil)
(repeat (fix (1+ (vlax-curve-getEndParam plObj)))
 (setq L (append L (list (vlax-curve-getPointAtParam plObj (setq n (1+ n)))))))
L
)

(defun ghikt(obj k / Ldinh n p1 p2 ndai ang pm dai)
 (if (= k 1)
   (progn 
     (setq  Ldinh (laydinh obj)
     n 0)
     (repeat (1- (length Ldinh))      
       (setq   p1 (nth n Ldinh)
  	p2 (nth (setq n (1+ n)) Ldinh)
         	ndai (/ (setq dai (distance p1 p2)) 2)	  
  	ang  (if (< (car p1) (car p2)) (angle p1 p2) (angle p2 p1))
  	p1   (polar p1 (+ ang (* 0.5 pi)) 0.5)
  	p2   (polar p2 (+ ang (* 0.5 pi)) 0.5)
  	pm   (polar p1 (angle p1 p2)  ndai)
   	)
       (ghichu))
    )
    (progn 
      (setq    p1 (vlax-curve-getStartPoint obj)
  	p2 (vlax-curve-getEndPoint obj)
         	ndai (/ (setq dai (distance p1 p2)) 2)	  
  	ang  (if (< (car p1) (car p2)) (angle p1 p2) (angle p2 p1))
  	p1   (polar p1 (+ ang (* 0.5 pi)) 0.5)
  	p2   (polar p2 (+ ang (* 0.5 pi)) 0.5)
  	pm   (polar p1 (angle p1 p2)  ndai)
   	)
      (ghichu)
    ))
)

(defun ghichu()
 (entmakex (list '(0 . "TEXT") (cons 11 pm) (cons 10 pm) (cons 40 caoc) (cons 50 ang)
	  '(72 . 1) '(73 . 1) (cons 1 (rtos (* scalen dai) 2 ssle))))
   (if (= ck "C")
     (progn (muiten p1 (angle p1 p2))
   	     (muiten p2 (angle p2 p1)))
   )
)

(defun c:kt(/ ck scale1 ss caoc scalen obj)
 (vl-load-com)

 (if (not scale) (setq scale 500))
 (initget "C K")
 (setq ck (getkword "\nCo ve mui ten khong? (C/K):")
scale1 (getreal (strcat "\nTy le <1/" (rtos scale 2 0) ">: 1/"))
ssle (getint "\nSo so le:")
ss (ssget '((0 . "LINE,*POLYLINE"))))

 (if (not ck) (setq ck "C"))
 (if scale1 (setq scale scale1))  
 (setq	scalen (/ scale 500)
caoc 0.85 )  

 (command "-layer" "n" "Kthuoc" "c" 4 "Kthuoc" "l" "continuous" "Kthuoc" "lw" "default" "Kthuoc" "")
 (setvar "clayer" "Kthuoc")

 (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
   (setq obj  (vlax-ename->vla-object ent))
   (if (= (cdr (assoc 0 (entget ent))) "LINE")
     (ghikt obj 0)
     (ghikt obj 1))	  
 )
 (princ)
)

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Khách
Chủ đề này bây giờ đã bị đóng lại để trả lời thêm.

×