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

#1201 nguyenkhoadung98

nguyenkhoadung98

    biết vẽ pline

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

Đã gửi 18 October 2008 - 10:57 AM

Dùng MText với lisp thì ko nên vì kết quả nhiều khi ko theo ý muốn (như thế này chẳng hạn {\f.VnArialH|b0|i0|c0|p34;T\f.VnArial|b0|i0|c0|p34;B1-L1/13A} )
Bạn có thể dùng lisp với Dtext kết hợp với lệnh convert Dtext sang Mtext (txt2mtxt)

thanks snowmen rất nhiều !!! các bạn cho hỏi thêm là : bây h công việc của mình cần dùng nhiều đến2 lệnh offset (O) và ME và thường phải dùng cùng nhau. Ví dụ như khi mình OFFSET 1 đường thằng thì sau đó là phải ME 1 block lên trên đường vừa OFFSET xong, vậy liệu có lisp nào cho phép kết hợp 2 lệnh trên trong 1 lệnh kô ( tạm gọi là lệnh OM).vừa OFFSET và ME 1 block lên đường vừa OFFSET, rất cảm ơn các bạn
  • 0

#1202 Phiphi-

Phiphi-

    biết lệnh minsert

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

Đã gửi 25 October 2008 - 09:26 AM

Vẽ đường line trong 3D - Vẽ đường line từ một điểm
Xin viết giúp LISP:
http://www.cadviet.c...?showtopic=6690
Thank you
  • 0

#1203 ph168xd

ph168xd

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 779 Bài viết
Điểm đánh giá: 309 (khá)

Đã gửi 25 October 2008 - 07:30 PM

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!
  • 0

#1204 Snowman

Snowman

    biết lệnh mirror

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

Đã gửi 25 October 2008 - 11:45 PM

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





  • 0

. - ' * ' - .. - ... "Sống trong đời sống cần có một tấm lòng..." . - ' * ' - .. -
-----------------------------------------------------------------------------------

Hình đã gửi Hình đã gửi


#1205 nguyenkhoadung98

nguyenkhoadung98

    biết vẽ pline

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

Đã gửi 29 October 2008 - 02:00 PM

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 ????
  • 0

#1206 trinhks

trinhks

    biết vẽ circle

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

Đã gửi 30 October 2008 - 11:15 PM

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é!
  • 0

#1207 yamoto

yamoto

    biết pan

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

Đã gửi 30 October 2008 - 11:49 PM

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é.
  • 0

#1208 romeo1982

romeo1982

    biết lệnh mirror

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

Đã gửi 20 October 2008 - 08:33 AM

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

Bác Hoành ơi em cần 1 cái líp như thế này: khi copy hoặc offset,array thì vật tạo mới được gán layer hiện hành, cám ơn bác
  • 0

#1209 nguyenkhoadung98

nguyenkhoadung98

    biết vẽ pline

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

Đã gửi 20 October 2008 - 11:01 AM

Bác Hoành ơi em cần 1 cái líp như thế này: khi copy hoặc offset,array thì vật tạo mới được gán layer hiện hành, cám ơn bác

ở đấy có rồi này
(defun C:ol ( / ent os od )

(command "_offset" pause "")

(princ "Select object to offset or <Exit>:")
(setq ent(entsel))

(while ent
(setq os(getpoint "\nSpecify point on side to offset:"))
(if(=(getvar "OFFSETDIST")-1)
(setq od "t")
(setq od (getvar "OFFSETDIST"))
)
(command "_offset" od (car ent) os "")
(command "_change" (entlast) "" "p" "la" (getvar "clayer") "c" (getvar "cecolor") "lt" (getvar "celtype") "")
(setq ent(entsel))
)

)
  • 0

#1210 hoanghuy

hoanghuy

    biết pan

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

Đã gửi 20 October 2008 - 11:37 AM

Bác Hoanh giúp mình cách đổi tên block bằng mã lisp được không? Cảm ơn bác nhiều.
  • 0

#1211 nguyenkhoadung98

nguyenkhoadung98

    biết vẽ pline

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

Đã gửi 20 October 2008 - 04:22 PM

snowman cho mình hỏi thêm là cái lisp bạn cho mình để đánh số cột đèn dung rất tốt,mình muốn hỏi thêm là bạn có thể cải tiến nó để sao cho khi mình sửa 1 1 cái ví dụ sửa cái T1-L1/1A thành T1-L1/T4 thì nhữg cái còn lại như T1-L1/2A,T1-L1/3A,T1-L1/4A,T1-L1/5A.....tự sửa thành T1-L1/5A,T1-L1/6A,T1-L1/7A,T1-L1/8A,T1-L1/9A,T1-L1/10A....,nếu đòi hỏi quá đáng mong bạn bỏ wa :leluoi:
  • 0

#1212 Snowman

Snowman

    biết lệnh mirror

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

Đã gửi 20 October 2008 - 11:27 PM

snowman cho mình hỏi thêm là cái lisp bạn cho mình để đánh số cột đèn dung rất tốt,mình muốn hỏi thêm là bạn có thể cải tiến nó để sao cho khi mình sửa 1 1 cái ví dụ sửa cái T1-L1/1A thành T1-L1/T4 thì nhữg cái còn lại như T1-L1/2A,T1-L1/3A,T1-L1/4A,T1-L1/5A.....tự sửa thành T1-L1/5A,T1-L1/6A,T1-L1/7A,T1-L1/8A,T1-L1/9A,T1-L1/10A....,nếu đòi hỏi quá đáng mong bạn bỏ wa :leluoi:

Yêu cầu của bạn có thể đáp ứng được nhưng đòi hỏi trình độ... ISO cao, cần fải có thời gian để viết một "soft" nho nhỏ mới dáp dứng đầy đủ được.
Tôi chỉ có đoạn code đánh số tăng dần trong đó số nằm giữa một text, giữ nguyên x ký tự phía trước và y ký tự phía sau.
Lệnh CIT, bạn hãy làm theo thông báo từ dòng lệnh, chú ý đếm chính xác số ký tự cần giữ lại fía trước và sau text.
Chọn các text tiếp theo để điền số mới (ko thể chọn hàng loạt được)
;;;====================================================================
=====
(defun bocchu (ss1 c)
(setq ob (entget (ssname ss1 c)))
(setq ts (assoc 1 ob))
(setq a (cdr ts))
)
(defun Txtnum (num)
(if (> num 0)
(strcat "+" (rtos num 2 0))
(rtos num 2 0)
)
)
;;;=================================
(defun Txtint (num)
(rtos num 2 0)

)

(defun Txtreal (num) (rtos num 2 2))
(defun Txtreal1 (num) (rtos num 2 0))

(defun thaychu (Ob newstr)
(setq txtstr (assoc 1 Ob))
(setq newstr (cons 1 newstr))
(entmod (subst newstr txtstr Ob))
)
(defun chonchu (dongnhac)
(prompt dongnhac)
(ssget
'((-4 . "<OR") (0 . "text") (0 . "mtext") (-4 . "OR>"))
)
)

(defun chon1chu (dongnhac / obj objtype)
(if (setq obj (nentsel dongnhac))
(setq obj (entget (car obj))
objtype (cdr (assoc 0 obj))
)
)
(if (member objtype '("ATTRIB" "MTEXT" "TEXT"))
(setq obj obj)
)
)


(defun chon (str) (ssget '((cons (0 str)))))
(defun bamchon (st) (entget (car (entsel st))))
(defun bocdt (ss1 c) (entget (ssname ss1 c)))

(defun boc1chu (ob)
(setq ts (assoc 1 ob))
(setq a (cdr ts))
)


;;;=============================================================================
====================
(defun c:cit (/ sstxt)
(command "undo" "mark")

(if (= Ostr nil)
(setq Ostr "\nNhap So thu tu bat dau <>...: "
)
)
(if (= nil
(setq Numkey
(getint
"\nNhap so ky tu phia truoc can giu lai: <enter for 0> "
)
)
)
(setq Numkey 0)
)
(if (= nil
(setq Numkey1
(getint
"\nNhap so ky tu phia sau can giu lai: <enter for 0> "
)
)
)
(setq Numkey1 0)
)
(while (/= (setq ss1 (chon1chu "\nChon 1 text can thay doi so thu tu ..."))
nil
)
(progn
(setq sstxt (boc1chu ss1)
Oldftxt (substr sstxt 1 Numkey)
Oldetxt (substr sstxt (1+ (- (strlen sstxt) Numkey1)))

)
(if (/= (setq num2 (getint Ostr)) nil)
(setq
numadd num2
Ostr (strcat "\nNhap so thu tu bat dau <"
(rtos (1+ numadd) 2 0)
"> : "
)
)
(setq numadd (1+ numadd)
Ostr (strcat "\nNhap so thu tu bat dau <"
(rtos (1+ numadd) 2 0)
"> : "
)
)
)
(setq num numadd)

(setq st (txtint num))

(thaychu ss1 (strcat oldftxt st oldetxt))
(princ)
)
)
)
;;;============================================

  • 1

. - ' * ' - .. - ... "Sống trong đời sống cần có một tấm lòng..." . - ' * ' - .. -
-----------------------------------------------------------------------------------

Hình đã gửi Hình đã gửi


#1213 nguyenkhoadung98

nguyenkhoadung98

    biết vẽ pline

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

Đã gửi 21 October 2008 - 08:14 AM

Yêu cầu của bạn có thể đáp ứng được nhưng đòi hỏi trình độ... ISO cao, cần fải có thời gian để viết một "soft" nho nhỏ mới dáp dứng đầy đủ được.
Tôi chỉ có đoạn code đánh số tăng dần trong đó số nằm giữa một text, giữ nguyên x ký tự phía trước và y ký tự phía sau.
Lệnh CIT, bạn hãy làm theo thông báo từ dòng lệnh, chú ý đếm chính xác số ký tự cần giữ lại fía trước và sau text.
Chọn các text tiếp theo để điền số mới (ko thể chọn hàng loạt được)

;;;====================================================================
=====
(defun bocchu (ss1 c)
(setq ob (entget (ssname ss1 c)))
(setq ts (assoc 1 ob))
(setq a (cdr ts))
)
(defun Txtnum (num)
(if (> num 0)
(strcat "+" (rtos num 2 0))
(rtos num 2 0)
)
)
;;;=================================
(defun Txtint (num)
(rtos num 2 0)

)

(defun Txtreal (num) (rtos num 2 2))
(defun Txtreal1 (num) (rtos num 2 0))

(defun thaychu (Ob newstr)
(setq txtstr (assoc 1 Ob))
(setq newstr (cons 1 newstr))
(entmod (subst newstr txtstr Ob))
)
(defun chonchu (dongnhac)
(prompt dongnhac)
(ssget
'((-4 . "<OR") (0 . "text") (0 . "mtext") (-4 . "OR>"))
)
)

(defun chon1chu (dongnhac / obj objtype)
(if (setq obj (nentsel dongnhac))
(setq obj (entget (car obj))
objtype (cdr (assoc 0 obj))
)
)
(if (member objtype '("ATTRIB" "MTEXT" "TEXT"))
(setq obj obj)
)
)


(defun chon (str) (ssget '((cons (0 str)))))
(defun bamchon (st) (entget (car (entsel st))))
(defun bocdt (ss1 c) (entget (ssname ss1 c)))

(defun boc1chu (ob)
(setq ts (assoc 1 ob))
(setq a (cdr ts))
)


;;;=============================================================================
====================
(defun c:cit (/ sstxt)
(command "undo" "mark")

(if (= Ostr nil)
(setq Ostr "\nNhap So thu tu bat dau <>...: "
)
)
(if (= nil
(setq Numkey
(getint
"\nNhap so ky tu phia truoc can giu lai: <enter for 0> "
)
)
)
(setq Numkey 0)
)
(if (= nil
(setq Numkey1
(getint
"\nNhap so ky tu phia sau can giu lai: <enter for 0> "
)
)
)
(setq Numkey1 0)
)
(while (/= (setq ss1 (chon1chu "\nChon 1 text can thay doi so thu tu ..."))
nil
)
(progn
(setq sstxt (boc1chu ss1)
Oldftxt (substr sstxt 1 Numkey)
Oldetxt (substr sstxt (1+ (- (strlen sstxt) Numkey1)))

)
(if (/= (setq num2 (getint Ostr)) nil)
(setq
numadd num2
Ostr (strcat "\nNhap so thu tu bat dau <"
(rtos (1+ numadd) 2 0)
"> : "
)
)
(setq numadd (1+ numadd)
Ostr (strcat "\nNhap so thu tu bat dau <"
(rtos (1+ numadd) 2 0)
"> : "
)
)
)
(setq num numadd)

(setq st (txtint num))

(thaychu ss1 (strcat oldftxt st oldetxt))
(princ)
)
)
)
;;;============================================

thanks kiu snowmen
  • 0

#1214 connaivang

connaivang

    biết vẽ arc

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

Đã gửi 21 October 2008 - 03:11 PM

Bác Hoành hay bác nào đó trên diễn đàn giúp em việc này với. Em đang rất cần mà. Cảm ơn các bác nhiều.



Bác Hoành và các bác khác trên diễn đàn ơi. Sao không có ai quan tâm đến em vậy. Thật là buồn quá!!!
Có ai giúp em với!!!
  • 0

#1215 MANHHUNGXDA

MANHHUNGXDA

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 926 Bài viết
Điểm đánh giá: 458 (tốt)

Đã gửi 21 October 2008 - 03:17 PM

Bác Hoành và các bác khác trên diễn đàn ơi. Sao không có ai quan tâm đến em vậy. Thật là buồn quá!!!
Có ai giúp em với!!!

Bài viết của bạn nó tản mạn quá
Bạn có thể nói lại yêu cầu của bạn
Mình sẽ giúp!
  • 0
Hãy ước cho trọn 1 ước mơ!

#1216 connaivang

connaivang

    biết vẽ arc

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

Đã gửi 21 October 2008 - 03:22 PM

Chào bác Nguyễn Hoành.
Rất cảm ơn bác về sự giúp đỡ nhiệt tình của bác. Như người ta vẫn bảo "được voi đòi tiên". Không biết bác có nghĩ như vậy và có cảm thấy khó chịu không nếu em có thêm một yêu cầu giúp đỡ như thế này.
Cái lệnh TCHU của bác em dùng đã cảm thấy rất tốt. Nhưng lệnh này em dùng khá thường xuyên. Em muốn cắt giảm một số thao tác của nó cho phù hợp với công việc của mình nhưng lại không biết chỉnh sửa ở đâu. Em muốn bác sửa lại lệnh trên thành một autolisp nhỏ với những thay đổi như sau:
Lệnh t1 tương tự như lệnh trên nhưng mặc định ở dòng T/S là viết thêm text ở phía trước dòng text.
Lênh t2 tương tự như lệnh t1, chỉ khác là ta chỉ cần insert thêm một kí tự duy nhất vào phía trước dòng text (Có nghĩa là sau khi nhập một kí tự,ta gõ space sẽ tương đương gõ enter)
Bác cố gắng giúp đỡ kẻ ngu muội này nhé.
Xin cảm ơn bác trước.


Cảm ơn bác MANHHUNG đã có ý muốn giúp đỡ. Yêu cầu của em đã được nêu ra khá lâu, xin được trích lại. nếu có gì chưa rõ nghĩa, xin được bác chỉ giáo.
Cảm ơn bác rất, rất nhiều.
  • 0

#1217 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

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

Đã gửi 21 October 2008 - 03:29 PM

Cảm ơn bác MANHHUNG đã có ý muốn giúp đỡ. Yêu cầu của em đã được nêu ra khá lâu, xin được trích lại. nếu có gì chưa rõ nghĩa, xin được bác chỉ giáo.
Cảm ơn bác rất, rất nhiều.

Lệnh T1 và T2 của bạn đây:
(defun c:t1() (Themchu t))
(defun c:t2() (Themchu nil))

(defun Themchu (enter / ss truoc chuthem)
(defun them1 (ent / tt old1 new1 gt)
(setq
tt (entget ent)
old1 (assoc 1 tt)
gt (cdr old1)
gt (cond
(truoc (strcat chuthem gt))
(t (strcat gt chuthem))
)

new1
(cons 1 gt)
tt
(subst new1 old1 tt)
)
(entmod tt)
(entupd ent)
)
(setq ss (ssget '((0 . "TEXT")))
truoc t
chuthem (getstring enter "\nChu them: ")
)
(sudung them1 ss)
(princ)
)

(defun sudung (ham ss / sodt index entdt soapp)
(setq sodt (cond
(ss (sslength ss))
(t 0)
)
soapp 0
index 0
)
(repeat sodt
(setq entdt (ssname ss index)
index (1+ index)
)
(if (ham entdt)
(setq soapp (1+ soapp))
)
)
soapp
)

  • 0

#1218 connaivang

connaivang

    biết vẽ arc

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

Đã gửi 21 October 2008 - 03:57 PM

Cảm ơn sự giúp đỡ nhiệt tình của bác. Em sẽ thử hai lệnh này ngay bây giờ.
  • 0

#1219 connaivang

connaivang

    biết vẽ arc

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

Đã gửi 21 October 2008 - 04:01 PM

Lệnh T1 và T2 của bạn đây:


Em thực hiện được rồi. Nó rất có ích cho công việc của em. Em không biết nói gì hơn, chỉ biết cảm ơn bác rất nhiều.
  • 0

#1220 smilingman82

smilingman82

    biết vẽ arc

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

Đã gửi 22 October 2008 - 12:13 AM

nhờ các bác PRO 1 tí nhá ,,, mình cần 1 lisp xuất ra toạ độ các đỉnh của 1 đường poline >>xuất ra tệp *.txt.....trình tự thế này:
- Chọn đuờng Poliline (có thể là line , poligonal thì càng tốt...)
- Líp sẽ tự động xuất ra toạ độ các đỉnh của đường Poliline dưới dạng tệp TXT ( Ví dụ tệp TXT có dạng:
12,5,6
13,2,7
trong đó 12;13là toạ độ X - 5;2 là toạ độ Y - 6;7 là toạ độ Z; toạ độ so với Gốc 0,0,0)
Cám ơn các bác
  • 0