Viết Lisp theo yêu cầu

[Nguyen Hoanh 4.663]

Cám ơn anh đã quan tâm, xài lệnh FI thì đưa cùng một màu về layer nhưng nếu muốn xóa thì sao nó sẽ dính theo những màu đi chung nhưng khác layer mà mình đã chọn theo lệnh FI ban đầu. Ý em là như vầy anh xem bản vẽ minh họa:

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

bạn sử dụng lệnh FI,

add tên layer

add màu đối tượng

chắc chắn không dính với đối tượng khác vì chỉ có đối tượng nào có layer đó và màu đó thì mới được chọn.

[smilingman82 2]

cám ơn các bác , mình nghiên cứu kĩ lại rồi.....Vấn đề của mình bây giờ là muốn chèn một BlOCK vạo tại vị trí các đỉnh của đường POLILINE được chọn:

Trình tự như sau:

+ Chạy file lisp

+ Chương trình yêu cầu chọn tên BLOCK cần chèn tại các đỉnh của đường POLILINE

+ Nhập tên BLOCK , tỉ lệ, góc xoay block....càng nh options càng tốt , nếu không thì chỉ cần chọn tên BLOCK cũng được

+ Chọn đường POLINE cần chèn BLOCK - có thể lựa chọn chèn tại tất cả các đỉnh hoặc chèn riêng tại các đỉnh chẵn hay đỉnh lẻ-

>>>ra kết quả.....

Vì mình đang làm phần mặt bằng , phải vẽ các cọc GPMB trên bình đồ, đưòng POLILINE mình tạo ra được rồi, bây giờ chỉ cần chèn block thui vào tại vị trí các đỉnh thui , nếu chèn bằng tay thì lâu mà dễ nhầm ........Mong bác nguyên hoanh giúp hộ cái nhá....thank...bác nào bít thì hộ tớ 1 tay cái nhá

[Flex 22]

cám ơn các bác , mình nghiên cứu kĩ lại rồi.....Vấn đề của mình bây giờ là muốn chèn một BlOCK vạo tại vị trí các đỉnh của đường POLILINE được chọn:

Trình tự như sau:

+ Chạy file lisp

+ Chương trình yêu cầu chọn tên BLOCK cần chèn tại các đỉnh của đường POLILINE

+ Nhập tên BLOCK , tỉ lệ, góc xoay block....càng nh options càng tốt , nếu không thì chỉ cần chọn tên BLOCK cũng được

+ Chọn đường POLINE cần chèn BLOCK - có thể lựa chọn chèn tại tất cả các đỉnh hoặc chèn riêng tại các đỉnh chẵn hay đỉnh lẻ-

>>>ra kết quả.....

Vì mình đang làm phần mặt bằng , phải vẽ các cọc GPMB trên bình đồ, đưòng POLILINE mình tạo ra được rồi, bây giờ chỉ cần chèn block thui vào tại vị trí các đỉnh thui , nếu chèn bằng tay thì lâu mà dễ nhầm ........Mong bác nguyên hoanh giúp hộ cái nhá....thank...bác nào bít thì hộ tớ 1 tay cái nhá

 

Bác có nhu cầu gì cứ alo em, nhưng em tính có phí đèn đóm (sorry các bác nhé, thế cho đơn giản).

[nataca 554]

Bác có nhu cầu gì cứ alo em, nhưng em tính có phí đèn đóm (sorry các bác nhé, thế cho đơn giản).

Ai có nhu cầu mà muốn nhanh thì cứ gọi cho tên này, không phải post bài vào đây để hỏi anh em làm gì để anh em mất công đọc. -_- . Tôi quảng cáo cho ông thế được chưa hả ông Flex. Ai cũng như ông thì cái topic này mốc meo rồi.

Xin lỗi các anh em vì đã spam

[Nguyen Hoanh 4.663]

cám ơn các bác , mình nghiên cứu kĩ lại rồi.....Vấn đề của mình bây giờ là muốn chèn một BlOCK vạo tại vị trí các đỉnh của đường POLILINE được chọn:

Trình tự như sau:

+ Chạy file lisp

+ Chương trình yêu cầu chọn tên BLOCK cần chèn tại các đỉnh của đường POLILINE

+ Nhập tên BLOCK , tỉ lệ, góc xoay block....càng nh options càng tốt , nếu không thì chỉ cần chọn tên BLOCK cũng được

+ Chọn đường POLINE cần chèn BLOCK - có thể lựa chọn chèn tại tất cả các đỉnh hoặc chèn riêng tại các đỉnh chẵn hay đỉnh lẻ-

>>>ra kết quả.....

Vì mình đang làm phần mặt bằng , phải vẽ các cọc GPMB trên bình đồ, đưòng POLILINE mình tạo ra được rồi, bây giờ chỉ cần chèn block thui vào tại vị trí các đỉnh thui , nếu chèn bằng tay thì lâu mà dễ nhầm ........Mong bác nguyên hoanh giúp hộ cái nhá....thank...bác nào bít thì hộ tớ 1 tay cái nhá

Đọc văn tả cảnh rồi viết lisp rất khó.

 

Bạn hãy thể hiện bằng file dwg (upload lên diễn đàn), trong đó có các trạng thái trước và sau khi chạy lisp.

[smilingman82 2]

Đọc văn tả cảnh rồi viết lisp rất khó.

 

Bạn hãy thể hiện bằng file dwg (upload lên diễn đàn), trong đó có các trạng thái trước và sau khi chạy lisp.

chờ em tí e post ảnh lên nhá . nhân thể mày mò đc cái code này, lấy đỉnh PLine , chắc là dùng đc , các bác nghiên cứu hộ nhá

 

(DEFUN PHANTICHLINE (obj / i dt td ListXY)

(setq ListXY (List))

(setq i 0)

(setq dt (entget obj))

(if (OR (= (TENDOITUONG obj) "LWPOLYLINE" ) (= (TENDOITUONG obj) "MLINE" ) (= (TENDOITUONG obj) "LINE" ))

(progn

(repeat (length dt)

(setq ds (nth i dt))

(if (OR (= (nth 0 ds) 10) (= (nth 0 ds) 11))

(progn

(setq td (cdr ds))

(setq ListXY (append ListXY (List td)))

)

)

(setq i (1+ i))

)

)

)

ListXY

)

 

 

Tặng Bommak đọan code này nè. Cái này mà bây giờ bạn cố nghĩ cũng chẳng biết để làm gì đâu. Nhưng mà dùng được đấy.

Nội dung: lấy tất cả các đỉnh của một LINE, PLINE hoặc MLINE...

 

 

--------------------

cuongvk@daitri.biz

vkcuong.23@gmail.com

Skype: cuong.vokien

Phone: 01689924187

Dreams have come true if you still believe...

cái này của bác VNex...dos

[Nguyen Hoanh 4.663]

chờ em tí e post ảnh lên nhá . nhân thể mày mò đc cái code này, lấy đỉnh PLine , chắc là dùng đc , các bác nghiên cứu hộ nhá

Tôi thực sự buồn vì suy nghĩ của bạn đấy smilingman82 ạ.

 

Nếu bạn tự code được thì đừng có post yêu cầu lên đây. Nếu bạn không code được thì bạn hãy yêu cầu thật cụ thể, sẽ có người code giúp bạn. Những người có thể code được lisp trên diễn đàn này không cần bất cứ một sự trợ giúp lisp nào cả, hoặc giả sử có cần họ cũng sẽ biết search và lấy nó ra từ internet. Bạn spam ở mục này làm người khác khó chịu đấy.

[smilingman82 2]

sao ko upload đ bác ạ, bác nào có mail e gửi nhá

[smilingman82 2]

Tôi thực sự buồn vì suy nghĩ của bạn đấy smilingman82 ạ.

 

Nếu bạn tự code được thì đừng có post yêu cầu lên đây. Nếu bạn không code được thì bạn hãy yêu cầu thật cụ thể, sẽ có người code giúp bạn. Những người có thể code được lisp trên diễn đàn này không cần bất cứ một sự trợ giúp lisp nào cả, hoặc giả sử có cần họ cũng sẽ biết search và lấy nó ra từ internet. Bạn spam ở mục này làm người khác khó chịu đấy.

sorry bác , m ko có ý định spam, mình hoàn toàn nghiêm túc, chỉ vì m cần gấp quá nên mới phải tìm mò thui....chỉ mún nếu các bác có đoạn code này thì sẽ làm nhanh hơn thôi, chứ ko có ý gì khác....mong các bác hiểu cho.......

[smilingman82 2]

Tôi thực sự buồn vì suy nghĩ của bạn đấy smilingman82 ạ.

 

Nếu bạn tự code được thì đừng có post yêu cầu lên đây. Nếu bạn không code được thì bạn hãy yêu cầu thật cụ thể, sẽ có người code giúp bạn. Những người có thể code được lisp trên diễn đàn này không cần bất cứ một sự trợ giúp lisp nào cả, hoặc giả sử có cần họ cũng sẽ biết search và lấy nó ra từ internet. Bạn spam ở mục này làm người khác khó chịu đấy.

mình mới chỉ ở mức độ newbie, chưa viết đc chương trình, mình chỉ mún nhờ các bác sao cho thật nhanh thui....có thể làm bác tự ái thì xin lỗi vậy....mong bác hiểu được thành ý của mình ....mãi mà ko upload đc bản vẽ....bác júp một tay nhá...thank

[smilingman82 2]

cái code trên là m tìm thấy trên này của bác VN...ex...dos nhá.....Ghi chú rõ ở dưới r mà, chứ ko phải m viết đâu.....chưa đủ trình.......

[smilingman82 2]

chắc bác hoanh hiểu nhầm rùi, mình copy nguyên xi phần code của bác VN và cả comment củabác ý nũa

*****

 

Tặng Bommak đọan code này nè. Cái này mà bây giờ bạn cố nghĩ cũng chẳng biết để làm gì đâu. Nhưng mà dùng được đấy.

Nội dung: lấy tất cả các đỉnh của một LINE, PLINE hoặc MLINE...

--------------------

cuongvk@daitri.biz

vkcuong.23@gmail.com

Skype: cuong.vokien

Phone: 01689924187

Dreams have come true if you still believe...

*************

 

cái này của bác VNex...dos >>>m ghi rõ mà

[smilingman82 2]

link file đây các bác ạ>>>

http://www.cadviet.com/upfiles/ddddddddddddddd.bmp

[Phiphi- 176]

Vẽ đường line trong 3D - Vẽ đường line từ một điểm

Xin viết giúp LISP:

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

Thank you

[ph168xd 313]

Mình đang cần lish có nội dung như sau.

 

Trong bản vẽ có rất nhiều cốt khác nhau đc làm bằng Text Attribute

 

Và mình muốn nâng tất cả cốt đó lên 1 khoảng cách nào do thi lam the nao?

 

Thanks rất nhìu!

[Snowman 92]

Mình đang cần lish có nội dung như sau.

 

Trong bản vẽ có rất nhiều cốt khác nhau đc làm bằng Text Attribute

 

Và mình muốn nâng tất cả cốt đó lên 1 khoảng cách nào do thi lam the nao?

 

Thanks rất nhìu!

Làm như thế này đây:

Dùng lệnh IBA với các tính năng: tăng giảm đồng loạt các attribute trong block (Cho fép lựa chọn tăng giảm kiểu số nguyên - với số thứ tự hoặc số thực - với cốt cao độ bằng cách nhập precision, Cho fép giữ lại "tiền tố" và "hậu tố" - bằng cách nhập số ký tự giữ lại fía trước và sau) . Cái này sử dụng hơi bất tiện ở chỗ ...nhấn enter hơi nhiều - nhiều options (nếu chỉ dùng để tăng giảm số) nhưng sẽ có ích khi áp dụng cho các trường hợp tổng quát như đánh số cọc, đánh số cột đèn, tên ga ...

Rõ ràng là dùng block attribute có rất nhiều thuận lợi cho ...công nghiẹp hoá & tự động hoá.

 

;;===================================================================
(DEFUN GetTag (objblock tag / temp1 att_list old attent)
 (setq					;objblock (car (entsel "Chon block khung ten ... "))
   temp1 objblock
				;tag "Tieude2"
 )
 (setq att_list (ENTGET temp1))
 (WHILE (/= (cdr (ASSOC 0 att_list)) "SEQEND")
   (setq temp1 (ENTNEXT temp1))
   (setq att_list (ENTGET temp1))
   (if	(and (/= nil (cdr (ASSOC 2 att_list)))
  (= (strcase tag) (strcase (cdr (ASSOC 2 att_list))))
     )
     (setq attent att_list)
   )
 )
 (setq old (CDR (ASSOC 1 attent)))
)					;End Defun GetTag
;;;=====================================================
(DEFUN GetTaglist (objblock / temp1 att_list old attent)
 (setq					;objblock (ssname (ssget) 0)
   temp1   objblock
   Taglist '()
				;tag "Tieude2"
 )
 (setq att_list (ENTGET temp1))
 (WHILE (/= (cdr (ASSOC 0 att_list)) "SEQEND")
   (setq temp1 (ENTNEXT temp1))
   (setq att_list (ENTGET temp1))
   (if	(/= nil
    (cdr (ASSOC 2 att_list))
)
     (setq Taglist (append Taglist (list (cdr (ASSOC 2 att_list)))))
   )
 )
 (setq Temp1 Taglist)
)					;End Defun GetTag


;;;================================================
(DEFUN editTag (objblock tag tag1 newstr / temp1 att_list old testtag
	attent)
 (setq					
   temp1 objblock

 )
 (setq	att_list (ENTGET temp1)
 )

 (WHILE (/= (cdr (ASSOC 0 att_list)) "SEQEND")
   (setq temp1 (ENTNEXT temp1))
   (setq att_list (ENTGET temp1))
   (if	(or (= (strcase tag) (cdr (ASSOC 2 att_list)))
    (= (strcase tag1) (cdr (ASSOC 2 att_list)))
)
     (setq attent att_list)
   )

 )
 (entmod
   (setq attent (subst (cons 1 newstr) (ASSOC 1 attent) attent))
 )
 (entupd objblock)
)					;End Defun GetTag
;;;================================================
(DEFUN editblk
      (objblock tag new_str / temp1 att_list old testtag attent)
 (setq				
   temp1 objblock
 )
 (setq	att_list (ENTGET temp1)
 )

 (WHILE (/= (cdr (ASSOC 0 att_list)) "SEQEND")
   (setq temp1 (ENTNEXT temp1))
   (setq att_list (ENTGET temp1))
   (if	(= (strcase tag) (cdr (ASSOC 2 att_list)))
     (setq attent att_list)
   )

 )
 (entmod
   (setq attent (subst (cons 1 new_str) (ASSOC 1 attent) attent))
 )
 (entupd objblock)
)					;End Defun GetTag


;;;=====================================
;;; Cong them gia tri vao cac attribute text

(defun C:iab (/ Tagbk numb numod nameoj objbk strname ssblk numkey1 numkey addnum1 Precision Oldstr)
 (setvar "cmdecho" 0)
 (command "undo" "begin")

   (If (not (setq Precision (getint "\nSo chu so phan thap phan <2>: ")))
     (setq Precision 2)
     )
 (if (/= 0 Precision)
   (if (/= Addnum nil)
     (if (setq Addnum1 (getreal (strcat "\nNhap gia tri tang - giam <" (Rtos Addnum 2 Precision) ">: ")))
(setq addnum addnum1)
)
     (setq Addnum (getreal "\nNhap gia tri tang - giam : ")
    )
   )
   (if (/= Addnum nil)
     (if (setq Addnum1 (getint (strcat "\nNhap gia tri tang - giam <" (Itoa (fix Addnum) ) ">: ")))
(setq addnum addnum1)
)
     (setq Addnum (getint "\nNhap gia tri tang - giam : ")
    )
   )
   )



 (if (= nil
 (setq Numkey
	(getint
	  "\nNhap so ky tu phia truoc can giu lai:  "
	)
 )
     )
   (setq Numkey 0)
 )
 (if (= nil
 (setq Numkey1
	(getint
	  "\nNhap so ky tu phia sau can giu lai:  "
	)
 )
     )
   (setq Numkey1 0)
 )

 (if (setq objtmp (nentsel "Click vao doi tuong attribute trong block can thay doi..."))
   (setq objtmp	  (entget (car objtmp))
  objtype (cdr (assoc 0 objtmp))
   )
 )
 (if (= objtype "ATTRIB")
   (setq tagbk (cdr (assoc 2 objtmp)) )
   (if (not (setq tagbk (getstring "\nTen attribute can thay doi :")))
   (setq tagbk "Caodo")
   )
 )

 (princ "\nChon cac block can thay doi...")
 (setq ssblk (ssget '((0 . "insert")))
)


 (setq 
    count  0
 )


 (while (< count (sslength ssblk))
   (setq objbk (ssname ssblk count)
  Oldstr (gettag Objbk tagbk)
  Oldftxt (substr Oldstr 1 Numkey)
  Oldetxt (substr Oldstr (1+ (- (strlen Oldstr) Numkey1)))
  Numtxt (substr Oldstr (1+ numkey) (- (strlen Oldstr) Numkey1))

  count (1+ count)
  )
   (if (/= 0 Precision)

     (setq Num (+ (atof Numtxt) Addnum)
    Newstr (strcat Oldftxt (Rtos num 2 Precision) Oldetxt)
    )
     (setq Num (+ (atoi Numtxt) (fix Addnum))
    Newstr (strcat Oldftxt (itoa num) Oldetxt))

  )
   (editblk Objbk tagbk Newstr)
   )


 (command "undo" "end")
 (setvar "cmdecho" 1)
 (princ)
)

[nguyenkhoadung98 2]

Làm như thế này đây:

Dùng lệnh IBA với các tính năng: tăng giảm đồng loạt các attribute trong block (Cho fép lựa chọn tăng giảm kiểu số nguyên - với số thứ tự hoặc số thực - với cốt cao độ bằng cách nhập precision, Cho fép giữ lại "tiền tố" và "hậu tố" - bằng cách nhập số ký tự giữ lại fía trước và sau) . Cái này sử dụng hơi bất tiện ở chỗ ...nhấn enter hơi nhiều - nhiều options (nếu chỉ dùng để tăng giảm số) nhưng sẽ có ích khi áp dụng cho các trường hợp tổng quát như đánh số cọc, đánh số cột đèn, tên ga ...

Rõ ràng là dùng block attribute có rất nhiều thuận lợi cho ...công nghiẹp hoá & tự động hoá.

 

;;===================================================================
(DEFUN GetTag (objblock tag / temp1 att_list old attent)
 (setq					;objblock (car (entsel "Chon block khung ten ... "))
   temp1 objblock
				;tag "Tieude2"
 )
 (setq att_list (ENTGET temp1))
 (WHILE (/= (cdr (ASSOC 0 att_list)) "SEQEND")
   (setq temp1 (ENTNEXT temp1))
   (setq att_list (ENTGET temp1))
   (if	(and (/= nil (cdr (ASSOC 2 att_list)))
  (= (strcase tag) (strcase (cdr (ASSOC 2 att_list))))
     )
     (setq attent att_list)
   )
 )
 (setq old (CDR (ASSOC 1 attent)))
)					;End Defun GetTag
;;;=====================================================
(DEFUN GetTaglist (objblock / temp1 att_list old attent)
 (setq					;objblock (ssname (ssget) 0)
   temp1   objblock
   Taglist '()
				;tag "Tieude2"
 )
 (setq att_list (ENTGET temp1))
 (WHILE (/= (cdr (ASSOC 0 att_list)) "SEQEND")
   (setq temp1 (ENTNEXT temp1))
   (setq att_list (ENTGET temp1))
   (if	(/= nil
    (cdr (ASSOC 2 att_list))
)
     (setq Taglist (append Taglist (list (cdr (ASSOC 2 att_list)))))
   )
 )
 (setq Temp1 Taglist)
)					;End Defun GetTag
;;;================================================
(DEFUN editTag (objblock tag tag1 newstr / temp1 att_list old testtag
	attent)
 (setq					
   temp1 objblock

 )
 (setq	att_list (ENTGET temp1)
 )

 (WHILE (/= (cdr (ASSOC 0 att_list)) "SEQEND")
   (setq temp1 (ENTNEXT temp1))
   (setq att_list (ENTGET temp1))
   (if	(or (= (strcase tag) (cdr (ASSOC 2 att_list)))
    (= (strcase tag1) (cdr (ASSOC 2 att_list)))
)
     (setq attent att_list)
   )

 )
 (entmod
   (setq attent (subst (cons 1 newstr) (ASSOC 1 attent) attent))
 )
 (entupd objblock)
)					;End Defun GetTag
;;;================================================
(DEFUN editblk
      (objblock tag new_str / temp1 att_list old testtag attent)
 (setq				
   temp1 objblock
 )
 (setq	att_list (ENTGET temp1)
 )

 (WHILE (/= (cdr (ASSOC 0 att_list)) "SEQEND")
   (setq temp1 (ENTNEXT temp1))
   (setq att_list (ENTGET temp1))
   (if	(= (strcase tag) (cdr (ASSOC 2 att_list)))
     (setq attent att_list)
   )

 )
 (entmod
   (setq attent (subst (cons 1 new_str) (ASSOC 1 attent) attent))
 )
 (entupd objblock)
)					;End Defun GetTag
;;;=====================================
;;; Cong them gia tri vao cac attribute text

(defun C:iab (/ Tagbk numb numod nameoj objbk strname ssblk numkey1 numkey addnum1 Precision Oldstr)
 (setvar "cmdecho" 0)
 (command "undo" "begin")

   (If (not (setq Precision (getint "\nSo chu so phan thap phan <2>: ")))
     (setq Precision 2)
     )
 (if (/= 0 Precision)
   (if (/= Addnum nil)
     (if (setq Addnum1 (getreal (strcat "\nNhap gia tri tang - giam <" (Rtos Addnum 2 Precision) ">: ")))
(setq addnum addnum1)
)
     (setq Addnum (getreal "\nNhap gia tri tang - giam : ")
    )
   )
   (if (/= Addnum nil)
     (if (setq Addnum1 (getint (strcat "\nNhap gia tri tang - giam <" (Itoa (fix Addnum) ) ">: ")))
(setq addnum addnum1)
)
     (setq Addnum (getint "\nNhap gia tri tang - giam : ")
    )
   )
   )

 (if (= nil
 (setq Numkey
	(getint
	  "\nNhap so ky tu phia truoc can giu lai:  "
	)
 )
     )
   (setq Numkey 0)
 )
 (if (= nil
 (setq Numkey1
	(getint
	  "\nNhap so ky tu phia sau can giu lai:  "
	)
 )
     )
   (setq Numkey1 0)
 )

 (if (setq objtmp (nentsel "Click vao doi tuong attribute trong block can thay doi..."))
   (setq objtmp	  (entget (car objtmp))
  objtype (cdr (assoc 0 objtmp))
   )
 )
 (if (= objtype "ATTRIB")
   (setq tagbk (cdr (assoc 2 objtmp)) )
   (if (not (setq tagbk (getstring "\nTen attribute can thay doi :")))
   (setq tagbk "Caodo")
   )
 )

 (princ "\nChon cac block can thay doi...")
 (setq ssblk (ssget '((0 . "insert")))
)


 (setq 
    count  0
 )
 (while (< count (sslength ssblk))
   (setq objbk (ssname ssblk count)
  Oldstr (gettag Objbk tagbk)
  Oldftxt (substr Oldstr 1 Numkey)
  Oldetxt (substr Oldstr (1+ (- (strlen Oldstr) Numkey1)))
  Numtxt (substr Oldstr (1+ numkey) (- (strlen Oldstr) Numkey1))

  count (1+ count)
  )
   (if (/= 0 Precision)

     (setq Num (+ (atof Numtxt) Addnum)
    Newstr (strcat Oldftxt (Rtos num 2 Precision) Oldetxt)
    )
     (setq Num (+ (atoi Numtxt) (fix Addnum))
    Newstr (strcat Oldftxt (itoa num) Oldetxt))

  )
   (editblk Objbk tagbk Newstr)
   )


 (command "undo" "end")
 (setvar "cmdecho" 1)
 (princ)
)

làm thế nào để đánh số cột đèn vậy snowman ????

[trinhks 2]

Chào các pro về autolisp,em đang cần 1 lisp có nội dung như thế này:trong 1 bản vẽ cad em làm việc với nhiều tỉ lệ khác nhau(vd:1-1,1-2,1-5...).mỗ lần muốn dùng 1 tỷ lệ thì lại phải di chuột lên hộp thoại chọn rất mất thời gian,em muốn có 1 lisp có thể đặt các tỷ lệ đó là các phím tắt để mỗi lần cần sử dụng tỷ lệ nào chỉ cần gõ phím tắt là sử dụng ngay tỷ lệ đó đc.ko bit trên diễn đàn đã có ai post lisp này lên chưa mà e tìm mãi ko thấy.bác nào có hoặc viết đc giúp em thì post lên diễn đàn cho em với nhá.Cám ơn các bác trước nhé!

[yamoto 0]

Trước đây tôi đã được ssg viết dùm lisp đo chiều dài này:

 

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

(defun getTw();;;Get current text width factor

(cdr (assoc 41 (tblsearch "style" (getvar "textstyle"))))

)

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

(defun getTh( / Th);;;Get current textheight or textsize

(if (= (setq Th (cdr (assoc 40 (tblsearch "style" (getvar "textstyle"))))) 0) (getvar "textsize") Th)

)

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

(defun emkT (S p)

;;;Write text S at point p by entmake function

;;;Text style, heigh and width factor get from current values

(entmake (list (cons 0 "TEXT") (cons 10 p) (cons 40 (getTh))

(cons 41 (getTw)) (cons 1 S) (cons 7 (getvar "textstyle"))))

)

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

(defun calcL (e);;;Calculate length of Line, Pline, 3dPoly, Spline, Circle, Arc, Polygon

(vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))

)

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

(defun C:LL( / Opt S1 S2 e p L)

(vl-load-com)

(if (not preT) (setq preT "L="))

(if (not sufT) (setq sufT ""))

(setq S1 preT S2 sufT)

(prompt (strcat "\nMeasure and write length. Current prefix:[" preT "]\tSuffix:[" sufT "]"))

(initget "Y N")

(setq Opt (getkword "\nChange prefix and suffix? [Yes/No] :"))

(if (not Opt) (setq Opt "N"))

(if (= Opt "Y") (progn

(setq

S1 (getstring "\nPrefix :") preT S1

S2 (getstring "\nSuffix :") sufT S2

)

))

(while (setq e (car (entsel "\nSelect Object or :")))

(setq

p (getpoint "\nBase point: ")

L (calcL e)

)

(emkT S1 p)

(emkT (strcat " " (rtos L) S2) p)

)

(princ)

)

Nếu k thay đổi prefix thì kết quả rất tốt nhưng nếu thay đổi prefix(VD: HDPE DN65-L=) thì sẽ kết quả chiều dài đo được sẽ bị trùng vào vị trí prefix.

Nhờ ai đó có thể giúp chỉnh sửa lisp với yêu cầu sau:

1. Khi thay đổi prefix bất kỳ thì kết quả vẫn được đặt ngay sau prefix:

VD: DN60-L=5m hay PPR-DN34-L=5M

và phù hợp với text đang hiện hành trên bản vẽ.

2. Thay đổi kết cách đưa ra kết quả:

Không chỉ đưa ra kết quả là dòng chữ nằm ngang mà đưa ra bằng cách chọn điểm chèn thứ nhất, điểm chèn thứ 2 và kết quả đưa ra là text có hướng theo hướng đường thẳng nối 2 điểm chèn.

3. Trước khi đưa ra yêu cầu lựa chọn đối tượng thì yêu cầu nhập hệ số an toàn (VD: 1.1) và kết quả đo sẽ là chiều dài thật nhân với hệ hố an toàn.

Ai có thể giúp đỡ thì giúp mình cái,mình đang rất gấp, sắp phải nộp hồ sơ rồi. Phải đo hơn 100.000m ống mà mỗi đoạn chỉ có vài chục mà k thể dùng dim để đo được vì có nhiều đoạn cong.

Ở đây mình tách riêng prefix và suffix vì mình còn phải dùng lệnh để cộng tổng các kết quả có được nhằm phân loại khối lượng. Nếu làm như bạn tien2005 thì mình sẽ k thể cộng tổng các kết quả đo được.

Mình thấy cái này ở mục yêu cầu gấp, và thấy cũng rất cần cho công việc của mình. Nếu ai có thể giúp thì giúp mình nhé.

[trinhks 2]

chào bác Hoành và tất cả các bác.em đang cần 1 lisp mà em post từ rất lâu rùi mà ko thấy ai giúp đỡ cả,phải chăng em yêu cầu hơi quá hay là ko có lisp như vầy.Em post lại yêu cầu về lisp nhé:'Chào các pro về autolisp,em đang cần 1 lisp có nội dung như thế này:trong 1 bản vẽ cad em làm việc với nhiều tỉ lệ khác nhau(vd:1-1,1-2,1-5...).mỗ lần muốn dùng 1 tỷ lệ thì lại phải di chuột lên hộp thoại dim style cotrol chọn rất mất thời gian,em muốn có 1 lisp có thể đặt các tỷ lệ đó là các phím tắt để mỗi lần cần sử dụng tỷ lệ nào chỉ cần gõ phím tắt là sử dụng ngay tỷ lệ đó đc.ko bit trên diễn đàn đã có ai post lisp này lên chưa mà e tìm mãi ko thấy.bác nào có hoặc viết đc giúp em thì post lên diễn đàn cho em với nhá.Cám ơn các bác trước nhé!' Vì em đang rất cần nên em tìm kiếm rất nhiều mà chưa đc.các bác đọc yc của em nếu ko thể có lisp nào như vậy thì các báo cho e bit 1 tiếng để em đỡ mất công tìm kiếm.Thanks các bác nhiều!!

Chỉnh sửa Tháng 11 1, 2008 theo trinhks

[Nguyen Hoanh 4.663]

chào bác Hoành và tất cả các bác.em đang cần 1 lisp mà em post từ rất lâu rùi mà ko thấy ai giúp đỡ cả,phải chăng em yêu cầu hơi quá hay là ko có lisp như vầy.Em post lại yêu cầu về lisp nhé:'Chào các pro về autolisp,em đang cần 1 lisp có nội dung như thế này:trong 1 bản vẽ cad em làm việc với nhiều tỉ lệ khác nhau(vd:1-1,1-2,1-5...).mỗ lần muốn dùng 1 tỷ lệ thì lại phải di chuột lên hộp thoại dim style cotrol chọn rất mất thời gian,em muốn có 1 lisp có thể đặt các tỷ lệ đó là các phím tắt để mỗi lần cần sử dụng tỷ lệ nào chỉ cần gõ phím tắt là sử dụng ngay tỷ lệ đó đc.ko bit trên diễn đàn đã có ai post lisp này lên chưa mà e tìm mãi ko thấy.bác nào có hoặc viết đc giúp em thì post lên diễn đàn cho em với nhá.Cám ơn các bác trước nhé!' Vì em đang rất cần nên em tìm kiếm rất nhiều mà chưa đc.các bác đọc yc của em nếu ko thể có lisp nào như vậy thì các báo cho e bit 1 tiếng để em đỡ mất công tìm kiếm.Thanks các bác nhiều!!

Bạn muốn có 1 lệnh:

Gõ tyle,

Lisp sẽ yêu cầu bạn nhập vào tỷ lệ bạn cần vẽ tiếp theo.

Và set current dimstyle về tên của tỷ lệ, ví dụ Dim1, Dim2, Dim5, Dim20, Dim25, Dim50,....?

[trinhks 2]

Bạn muốn có 1 lệnh:

Gõ tyle,

Lisp sẽ yêu cầu bạn nhập vào tỷ lệ bạn cần vẽ tiếp theo.

Và set current dimstyle về tên của tỷ lệ, ví dụ Dim1, Dim2, Dim5, Dim20, Dim25, Dim50,....?

Lần trước tìm trên cadviet.com em có tìm thấy 1 lisp chuyển layer rất nhanh, em ko nhớ của tác giả nào.về em đã sửa lại theo ý em và chạy rất tốt

 

(defun layer_style ()

(if (not (tblsearch "layer" "5.NHA" ))

(command "-layer" "new" "5.NHA" "color" 5 "5.NHA" ""))

(if (not (tblsearch "layer" "8.TEXT" ))

(command "-layer" "new" "8.TEXT" "color" 3 "8.TEXT" ""))

(if (not (tblsearch "layer" "6.DIM" ))

(command "-layer" "new" "6.DIM" "color" 92 "6.DIM" ""))

(if (not (tblsearch "layer" "7.DUONG" ))

(command "-layer" "new" "7.DUONG" "color" 1 "7.DUONG" ""))

 

)

;;; ===========================================================================

;;; ===========================================================================

; ====================== Tao & dat mau layer hien hanh ================

(defun taolop (mau lop / a) (setq a (tblsearch "layer" lop))

(if (null a) (command "layer" "n" lop "c" mau lop "")) (setvar "clayer" lop)

(princ "\n Layer_ hien hanh la: ") (princ lop)

(princ "\n Color layer_ hien hanh la: ") (princ mau) (princ) )

;;;===========================Chon layer hien hanh===============

(defun c:5 () (Command "clayer" "5.NHA"))

(defun c:6 () (Command "clayer" "6.DIM"))

(defun c:7 () (Command "clayer" "7.DUONG"))

(defun c:8 () (Command "clayer" "8.TEXT"))

 

;;; ====================== Setting Text Style =================================

(defun text_style ()

(if (not (tblsearch "style" "Times New Roman" ))

(command "-style" "Times New Roman" "Times New Roman" 0 0.8 0 "no" "no" "no"))

(if (not (tblsearch "style" "Times New Roman" ))

(command "-style" "Times New Roman" "Times New Roman" 0 0.8 0 "no" "no" "no"))

(if (not (tblsearch "style" "romant" ))

(command "-style" "Times New Roman" "Times New Roman" 0 0.8 0 "no" "no" "no"))

)

em ko bit nhiều về lissp,ko biết đã copy đủ dòng lệnh chưa vì trong lisp đó rất dài em chưa tìm hết đc tác dụng của từng đoạn code.nhưng cái lisp e đang cần nó cũng dạng như thế này đó.bác Hoành giúp em sớm nhé.cám ơn bác nhiều!!!

[Nguyen Hoanh 4.663]

Lần trước tìm trên cadviet.com em có tìm thấy 1 lisp chuyển layer rất nhanh, em ko nhớ của tác giả nào.về em đã sửa lại theo ý em và chạy rất tốt

....

em ko bit nhiều về lissp,ko biết đã copy đủ dòng lệnh chưa vì trong lisp đó rất dài em chưa tìm hết đc tác dụng của từng đoạn code.nhưng cái lisp e đang cần nó cũng dạng như thế này đó.bác Hoành giúp em sớm nhé.cám ơn bác nhiều!!!

Khổ quá, nói mãi. Lisp bạn cần mà bạn tìm được rồi thì thôi khỏi cần viết lisp khác nữa đúng không?

 

Còn không, cụ thể bạn muốn gì bạn cứ gạch đầu dòng ra.

[trinhks 2]

Khổ quá, nói mãi. Lisp bạn cần mà bạn tìm được rồi thì thôi khỏi cần viết lisp khác nữa đúng không?

 

Còn không, cụ thể bạn muốn gì bạn cứ gạch đầu dòng ra.

Khó nói cho bác hiểu quá nhỉ.lisp e pót lên là lisp chuyển layer nhanh.bây h em muốn líp chuyển đổi giữa các tỷ lệ.bác hiểu rồi chứ

[trinhks 2]

Khổ quá, nói mãi. Lisp bạn cần mà bạn tìm được rồi thì thôi khỏi cần viết lisp khác nữa đúng không?

 

Còn không, cụ thể bạn muốn gì bạn cứ gạch đầu dòng ra.

trong bản vẽ của e có các tỷ lệ 1-1;1-2;góc

lisp e yc cụ thể là thế này

đặt tỷ lệ 1-1 là phím tắt 11 trên bàn phím

đặt tỷ lệ 1-2 là phím tắt 12 trên bàn phím

đặt tỷ lệ góc là phím tắt 22 trên bàn phím

 

Để khi em đang làm việc ở tỷ lệ 1-1,muốn chuyển sang tỷ lệ 1-2 thì em x\chỉ cần gõ phím 12 là tự động bản vẽ đc vẽ ở tỷ lệ 1-2;hoặc với góc cũng vậy

(bản vẽ e đang làm theo tỷ lệ tiêu chuẩn iso 25 trong hệ metric)