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

#1181 makhongbietnoi

makhongbietnoi

    biết vẽ point

  • Members
  • PipPip
  • 95 Bài viết
Điểm đánh giá: 21 (tàm tạm)

Đã gửi 15 October 2008 - 10:27 PM

Chưa hiểu câu hỏi của bạn lắm! sao lại text từ Dim sang text thường???
  • 0

#1182 vandoan

vandoan

    biết zoom

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

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

Chưa hiểu câu hỏi của bạn lắm! sao lại text từ Dim sang text thường???

nghĩa là lấy nội dung text trong dim qua một text có sẵn gần đó. giống như lisp ở trang đầu ấy.
  • 0

#1183 khanhduydang

khanhduydang

    biết zoom

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

Đã gửi 16 October 2008 - 12:29 AM

Các bác xin giúp đỡ với.
E đang cần 1 lisp hay gì đó có thể EXPLORE block attribute ra ma vần giữ được giá trị vốn có của nó.
VD:
E có att mặc định là number
Sau khi block lại thì e sửa nó thành d10a200
Khi EXPLORE ra thì vẫn giữ đúng giá trị d10a200 chứ không trở lại number như mặc định

E đã tìm mấy ngày nay trên cadviet mà ko ra nên mới gửi yêu cầu. Mong các bác giúp đở.
Chân thành cám ơn!!!
  • 0

#1184 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

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

Đã gửi 16 October 2008 - 08:05 AM

Các bác xin giúp đỡ với.
E đang cần 1 lisp hay gì đó có thể EXPLORE block attribute ra ma vần giữ được giá trị vốn có của nó.
VD:
E có att mặc định là number
Sau khi block lại thì e sửa nó thành d10a200
Khi EXPLORE ra thì vẫn giữ đúng giá trị d10a200 chứ không trở lại number như mặc định

E đã tìm mấy ngày nay trên cadviet mà ko ra nên mới gửi yêu cầu. Mong các bác giúp đở.
Chân thành cám ơn!!!

bạn dùng lệnh BURST của Express Tool (vào menu Express > Block > Explode Attributes to Text)
  • 0

#1185 tranchan

tranchan

    biết lệnh break

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

Đã gửi 16 October 2008 - 08:12 AM

ai có lisp nào để copy nội dung text từ dim này sang text riêng lẻ khác được cho em xin chút. đôi khi em copy hàng loạt text để đúng vị trí em muốn. nhưng sau đó cứ phải ed rồi Ctrl+C, tiếp tục ed và Ctrl+V như thế mất công quá.


Ra mục download>autolisp., load file ma text về xài.
Hình đã gửi
  • 0

#1186 vandoan

vandoan

    biết zoom

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

Đã gửi 16 October 2008 - 09:24 AM

Ra mục download>autolisp., load file ma text về xài.
Hình đã gửi

không phải rồi :leluoi: không lấy được text trong dim
  • 0

#1187 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 16 October 2008 - 10:59 AM

ai có lisp nào để copy nội dung text từ dim này sang text riêng lẻ khác được cho em xin chút. đôi khi em copy hàng loạt text để đúng vị trí em muốn. nhưng sau đó cứ phải ed rồi Ctrl+C, tiếp tục ed và Ctrl+V như thế mất công quá.mọi người chịu khó giúp em chút nhé. xin cảm ơn!

Bạn dùng thử LISP này :
(defun C:sdkt(/ ent nd ss lst)
(while
(not
(and
(setq ent (car (entsel "\nChon text kich thuoc:")))
(if ent (= (cdr (assoc 0 (entget ent))) "DIMENSION") )
)
)
(princ "\nSelect Again: ")
)
(setq nd (TextDimension ent))
(princ "\nChon text:")
(setq ss (ssget (list (cons 0 "TEXT")))
lst (ss2ent ss))
(repeat (length lst)
(setq ent (entget (car lst))
lst (cdr lst)
ent (subst (cons 1 nd) (assoc 1 ent) ent)
)
(entmod ent)
)
(princ)
)

(defun TextDimension (ent / EntData BlkEnt Str Pos) ; By Tim Willey
(if
(and
(= (cdr (assoc 0 (setq EntData (entget ent)))) "DIMENSION")
(setq BlkEnt (tblobjname "block" (cdr (assoc 2 EntData))))
)
(while (setq BlkEnt (entnext BlkEnt))
(if (= (cdr (assoc 0 (setq EntData (entget BlkEnt)))) "MTEXT")
(progn
(setq Str (cdr (assoc 1 EntData)))
(if (setq Pos (vl-string-search ";" Str))
(setq Str (substr Str (+ 2 Pos)))
)
)
)
)
)
Str
)


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


  • 0

#1188 vandoan

vandoan

    biết zoom

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

Đã gửi 16 October 2008 - 11:33 AM

cảm ơn gia_bach rất nhiều. đúng lúc mình đang cần lấy nó.quý cậu quá. :leluoi:
  • 0

#1189 Sony2007

Sony2007

    biết lệnh copy

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

Đã gửi 16 October 2008 - 01:39 PM

Em nhờ bác viết là 1 lisp như thế này.
- Pick vào 1 điểm sau đó nhập tọa độ của người dùng tự cho vào. Ví dụ điểm 1 tọa độ người dùng nhập vào là (a,b,c). Sau đó pick vào điểm thứ 2. Sẽ ghi tọa độ của điểm thứ 2 so với điểm 1. x2=a+x; y2=b+y; z2=c+z. x, y, z là khoảng cách xác định trong cad theo trục x, y, z.
- Vấn đề cao độ. Píck vào điểm 1, người dùng nhập vào cao độ là a. Pick vào điểm thứ 2 ghi cao độ điểm 2 thông qua điểm 1. Caodộ 2= a+y. Trong đó y là khoảng cách trong autocad giữa điểm 1 và 2 theo phương y.

Có gì các bác giúp em với nhé.

Không thấy ai giúp cả nhỉ ....
  • 0

#1190 nguyenkhoadung98

nguyenkhoadung98

    biết vẽ pline

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

Đã gửi 16 October 2008 - 05:29 PM

Không thấy ai giúp cả nhỉ ....

chào các bạn mình đang rất cần 1 lisp giúp mình làm như sau : mình muốn đánh số thứ tự của các block theo trật tự vúi dụ là T3-L1/1A tiếp theo là T3-L1/2B,T3-L1/3C,T3-L1/4A,T3-L1/5B,T3-L1/6C,T3-L1/7A.....tức là tử số giữ nguyên còn phần mẫu số thì số tăng dần (1,2,3,4,5,6,7,8,9,....)còn chữ thì tuần hoàn theo qui luật A,B,C,A,B,C,A,B,C...rất mong các bạn giúp đỡ,nếu có lisp trên dđ mong cách bạn chỉ cho. mình tìm hoài mà kô thấy....rất rất cảm ơn.
  • 0

#1191 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 16 October 2008 - 10:35 PM

chào các bạn mình đang rất cần 1 lisp giúp mình làm như sau : mình muốn đánh số thứ tự của các block theo trật tự vúi dụ là T3-L1/1A tiếp theo là T3-L1/2B,T3-L1/3C,T3-L1/4A,T3-L1/5B,T3-L1/6C,T3-L1/7A.....tức là tử số giữ nguyên còn phần mẫu số thì số tăng dần (1,2,3,4,5,6,7,8,9,....)còn chữ thì tuần hoàn theo qui luật A,B,C,A,B,C,A,B,C...rất mong các bạn giúp đỡ,nếu có lisp trên dđ mong cách bạn chỉ cho. mình tìm hoài mà kô thấy....rất rất cảm ơn.

Bạn cần đánh số cột đèn đúng ko :leluoi:
Cái này tôi đã làm giúp một đồng chí ở cty, nhưng có cái khác là bạn phải ký hiệu dạng T3-L1/4/A hoặc T3-L1/4:A . Tôi ko fải dân chuyên ngành điện nên ko hiểu được cách ký hiệu nào đúng. Tôi đưa lên lisp phục vụ cả 2 cách để bạn lựa chọn :s_dead: )
Cách dùng: tạo một text đầu tiên, đánh lệnh "DSC", chọn text gốc, chọn giá trị bước nhảy, chọn điểm gốc copy -- chọn điểm copy tới ... đến khi muốn dừng thì thôi.
;;;===================================================================
;;; Danh so cot den:
(defun c:dsc (/ ang x y ent tg tg1tg2 num_r
num_c num_inc dis_r dis_c num top idnum
dx dy bottom inc tgnum attr attr_ent
t_base b_base locat value deci stnum loca1 loca2
tt count inctg inctg1 bpoint mx my nx
ny bx by
)
(setq idnum 0)
(while (/= idnum 1)
(setq ent (entsel "\nHay lua chon so ma ban muon copy : "))
(if ent
(progn
(setq e (car ent))
(setq tg (entget e))
(if (= (cdr (assoc 0 tg)) "TEXT")
(setq idnum 1)
)
)
(princ)
)
)

(setq num_inc (getreal "\nHay nhap he so tang giam <1> : "))
(if (= num_inc nil)
(setq num_inc 1)
)

(setq bpoint (getpoint "\nChon diem goc de copy : "))
(setq x (car bpoint))
(setq y (car (cdr bpoint)))

(if (and (= (cdr (assoc 72 tg)) 0) (= (cdr (assoc 73 tg)) 0))
(progn
(setq bx (car (cdr (assoc 10 tg))))
(setq by (car (cdr (cdr (assoc 10 tg)))))
)
(progn
(setq bx (car (cdr (assoc 11 tg))))
(setq by (car (cdr (cdr (assoc 11 tg)))))
)
)

(setq attr (cdr tg))
(setq tg (cdr (assoc 1 tg)))
(setq inc 0)
(setq tg1 "")
(setq t_base "")
(setq b_base "")
(setq idnum 0)
(setq top 0)
(setq bottom 0)
(setq stnum "")
(setq deci 0)
(repeat (strlen tg)
(if
(or (and (> (ascii (setq tgnum (substr tg (- (strlen tg) inc) 1)))
47
) ;(chr 32)
(< (ascii (setq tgnum (substr tg (- (strlen tg) inc) 1)))
58
)
)

(= (ascii (setq tgnum (substr tg (- (strlen tg) inc) 1)))
32
)

(= (ascii (setq tgnum (substr tg (- (strlen tg) inc) 1)))
46
)
)
(progn
(if (= (ascii (setq tgnum (substr tg (- (strlen tg) inc) 1)))
46
)
(setq deci inc)
)
(if (= inc 0)
(progn
(setq idnum 1)
(if
(= (ascii (setq tgnum (substr tg (- (strlen tg) inc) 1)))
46
)
(setq b_base (strcat "." b_base))
)
)
)
(if (= bottom 1)
(progn (setq bottom 0) (setq idnum 1) (setq top 1))
)
(if (and (= idnum 0) (= top 1))
(setq t_base (strcat tgnum t_base))
)
(if (= idnum 1)
(progn
(if (and (= tgnum "0") (> inc 0))
(setq stnum (strcat stnum "0"))
(setq stnum "")
)
(setq tg1 (strcat tgnum tg1))
)
)
)
(if (= inc 0)
(progn
(setq b_base (strcat tgnum b_base))
(setq bottom 1)
)
(if (= bottom 1)
(setq b_base (strcat tgnum b_base))
(progn
(setq top 1)
(setq t_base (strcat tgnum t_base))
(if (= idnum 1)
(setq idnum 0)
)
)
)
)
)
(setq inc (+ inc 1))
)

(if (= tg1 "")
(exit)
)
(setq num (atof tg1))
(setq count 1)

(while (setq bpoint (getpoint "\nChon diem copy tiep theo : "))
(setq num (+ num num_inc))
(if (>= (strlen b_base) 1)
(cond
((or (= "A"
(strcase (substr b_base (strlen b_base) 1))
)
(= "B"
(strcase (substr b_base (strlen b_base) 1))
)
)
(setq b_base
(strcat
(substr b_base 1 (1- (strlen b_base)))
(chr (1+ (ascii (substr b_base (strlen b_base) 1))))
)
)
)
((= "C" (strcase (substr b_base (strlen b_base) 1)))
(setq
b_base (strcat (substr b_base 1 (1- (strlen b_base))) "A")
)
)
)

)
(setq value (strcat t_base (strcat stnum (rtos num 2 deci)) b_base))
(setq nx (car bpoint))
(setq ny (car (cdr bpoint)))
(setq dx (- nx x))
(setq dy (- ny y))
(setq mx (car (getvar "ucsxdir")))
(setq my (car (cdr (getvar "ucsxdir"))))
(setq loca1 (+ bx (* mx dx)))
(setq loca2 (+ by (* my dx)))
(setq mx (car (getvar "ucsydir")))
(setq my (car (cdr (getvar "ucsydir"))))
(setq loca1 (+ loca1 (* mx dy)))
(setq loca2 (+ loca2 (* my dy)))
(setq attr_ent (subst (cons 1 value) (assoc 1 attr) attr))
(if (and (= (cdr (assoc 72 attr_ent)) 0)
(= (cdr (assoc 73 attr_ent)) 0)
)
(setq attr_ent (subst (list 10 loca1 loca2 0)
(assoc 10 attr_ent)
attr_ent
)
)
(setq attr_ent (subst (list 11 loca1 loca2 0)
(assoc 11 attr_ent)
attr_ent
)
)
)
(entmake attr_ent)
(setq count (+ count 1))
) ;end while
(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


#1192 khanhduydang

khanhduydang

    biết zoom

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

Đã gửi 16 October 2008 - 10:41 PM

bạn dùng lệnh BURST của Express Tool (vào menu Express > Block > Explode Attributes to Text)


Cám ơn bác Hoành nhé!
Đơn giản thế mà e cứ mài mò 3 hôm nay.
Cám ơn bác!!!
  • 0

#1193 nguyenkhoadung98

nguyenkhoadung98

    biết vẽ pline

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

Đã gửi 17 October 2008 - 08:30 AM

Bạn cần đánh số cột đèn đúng ko :leluoi:
Cái này tôi đã làm giúp một đồng chí ở cty, nhưng có cái khác là bạn phải ký hiệu dạng T3-L1/4/A hoặc T3-L1/4:A . Tôi ko fải dân chuyên ngành điện nên ko hiểu được cách ký hiệu nào đúng. Tôi đưa lên lisp phục vụ cả 2 cách để bạn lựa chọn :s_dead: )
Cách dùng: tạo một text đầu tiên, đánh lệnh "DSC", chọn text gốc, chọn giá trị bước nhảy, chọn điểm gốc copy -- chọn điểm copy tới ... đến khi muốn dừng thì thôi.

;;;===================================================================
;;; Danh so cot den:
(defun c:dsc (/ ang x y ent tg tg1tg2 num_r
num_c num_inc dis_r dis_c num top idnum
dx dy bottom inc tgnum attr attr_ent
t_base b_base locat value deci stnum loca1 loca2
tt count inctg inctg1 bpoint mx my nx
ny bx by
)
(setq idnum 0)
(while (/= idnum 1)
(setq ent (entsel "\nHay lua chon so ma ban muon copy : "))
(if ent
(progn
(setq e (car ent))
(setq tg (entget e))
(if (= (cdr (assoc 0 tg)) "TEXT")
(setq idnum 1)
)
)
(princ)
)
)

(setq num_inc (getreal "\nHay nhap he so tang giam <1> : "))
(if (= num_inc nil)
(setq num_inc 1)
)

(setq bpoint (getpoint "\nChon diem goc de copy : "))
(setq x (car bpoint))
(setq y (car (cdr bpoint)))

(if (and (= (cdr (assoc 72 tg)) 0) (= (cdr (assoc 73 tg)) 0))
(progn
(setq bx (car (cdr (assoc 10 tg))))
(setq by (car (cdr (cdr (assoc 10 tg)))))
)
(progn
(setq bx (car (cdr (assoc 11 tg))))
(setq by (car (cdr (cdr (assoc 11 tg)))))
)
)

(setq attr (cdr tg))
(setq tg (cdr (assoc 1 tg)))
(setq inc 0)
(setq tg1 "")
(setq t_base "")
(setq b_base "")
(setq idnum 0)
(setq top 0)
(setq bottom 0)
(setq stnum "")
(setq deci 0)
(repeat (strlen tg)
(if
(or (and (> (ascii (setq tgnum (substr tg (- (strlen tg) inc) 1)))
47
) ;(chr 32)
(< (ascii (setq tgnum (substr tg (- (strlen tg) inc) 1)))
58
)
)

(= (ascii (setq tgnum (substr tg (- (strlen tg) inc) 1)))
32
)

(= (ascii (setq tgnum (substr tg (- (strlen tg) inc) 1)))
46
)
)
(progn
(if (= (ascii (setq tgnum (substr tg (- (strlen tg) inc) 1)))
46
)
(setq deci inc)
)
(if (= inc 0)
(progn
(setq idnum 1)
(if
(= (ascii (setq tgnum (substr tg (- (strlen tg) inc) 1)))
46
)
(setq b_base (strcat "." b_base))
)
)
)
(if (= bottom 1)
(progn (setq bottom 0) (setq idnum 1) (setq top 1))
)
(if (and (= idnum 0) (= top 1))
(setq t_base (strcat tgnum t_base))
)
(if (= idnum 1)
(progn
(if (and (= tgnum "0") (> inc 0))
(setq stnum (strcat stnum "0"))
(setq stnum "")
)
(setq tg1 (strcat tgnum tg1))
)
)
)
(if (= inc 0)
(progn
(setq b_base (strcat tgnum b_base))
(setq bottom 1)
)
(if (= bottom 1)
(setq b_base (strcat tgnum b_base))
(progn
(setq top 1)
(setq t_base (strcat tgnum t_base))
(if (= idnum 1)
(setq idnum 0)
)
)
)
)
)
(setq inc (+ inc 1))
)

(if (= tg1 "")
(exit)
)
(setq num (atof tg1))
(setq count 1)

(while (setq bpoint (getpoint "\nChon diem copy tiep theo : "))
(setq num (+ num num_inc))
(if (>= (strlen b_base) 1)
(cond
((or (= "A"
(strcase (substr b_base (strlen b_base) 1))
)
(= "B"
(strcase (substr b_base (strlen b_base) 1))
)
)
(setq b_base
(strcat
(substr b_base 1 (1- (strlen b_base)))
(chr (1+ (ascii (substr b_base (strlen b_base) 1))))
)
)
)
((= "C" (strcase (substr b_base (strlen b_base) 1)))
(setq
b_base (strcat (substr b_base 1 (1- (strlen b_base))) "A")
)
)
)

)
(setq value (strcat t_base (strcat stnum (rtos num 2 deci)) b_base))
(setq nx (car bpoint))
(setq ny (car (cdr bpoint)))
(setq dx (- nx x))
(setq dy (- ny y))
(setq mx (car (getvar "ucsxdir")))
(setq my (car (cdr (getvar "ucsxdir"))))
(setq loca1 (+ bx (* mx dx)))
(setq loca2 (+ by (* my dx)))
(setq mx (car (getvar "ucsydir")))
(setq my (car (cdr (getvar "ucsydir"))))
(setq loca1 (+ loca1 (* mx dy)))
(setq loca2 (+ loca2 (* my dy)))
(setq attr_ent (subst (cons 1 value) (assoc 1 attr) attr))
(if (and (= (cdr (assoc 72 attr_ent)) 0)
(= (cdr (assoc 73 attr_ent)) 0)
)
(setq attr_ent (subst (list 10 loca1 loca2 0)
(assoc 10 attr_ent)
attr_ent
)
)
(setq attr_ent (subst (list 11 loca1 loca2 0)
(assoc 11 attr_ent)
attr_ent
)
)
)
(entmake attr_ent)
(setq count (+ count 1))
) ;end while
(princ)
)



:angry:) Cảm ơn Snowmen rất nhiều, kô bit làm j để cảm ơn bạn đây.cái này giúp mình tiết kiện đc rất nhiều thời gian đấy, 1 lần nữa cảm ơn bạn lắm lắm
  • 0

#1194 nguyenkhoadung98

nguyenkhoadung98

    biết vẽ pline

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

Đã gửi 17 October 2008 - 08:34 AM

Bạn cần đánh số cột đèn đúng ko :leluoi:
Cái này tôi đã làm giúp một đồng chí ở cty, nhưng có cái khác là bạn phải ký hiệu dạng T3-L1/4/A hoặc T3-L1/4:A . Tôi ko fải dân chuyên ngành điện nên ko hiểu được cách ký hiệu nào đúng. Tôi đưa lên lisp phục vụ cả 2 cách để bạn lựa chọn :s_dead: )
Cách dùng: tạo một text đầu tiên, đánh lệnh "DSC", chọn text gốc, chọn giá trị bước nhảy, chọn điểm gốc copy -- chọn điểm copy tới ... đến khi muốn dừng thì thôi.

;;;===================================================================
;;; Danh so cot den:
(defun c:dsc (/ ang x y ent tg tg1tg2 num_r
num_c num_inc dis_r dis_c num top idnum
dx dy bottom inc tgnum attr attr_ent
t_base b_base locat value deci stnum loca1 loca2
tt count inctg inctg1 bpoint mx my nx
ny bx by
)
(setq idnum 0)
(while (/= idnum 1)
(setq ent (entsel "\nHay lua chon so ma ban muon copy : "))
(if ent
(progn
(setq e (car ent))
(setq tg (entget e))
(if (= (cdr (assoc 0 tg)) "TEXT")
(setq idnum 1)
)
)
(princ)
)
)

(setq num_inc (getreal "\nHay nhap he so tang giam <1> : "))
(if (= num_inc nil)
(setq num_inc 1)
)

(setq bpoint (getpoint "\nChon diem goc de copy : "))
(setq x (car bpoint))
(setq y (car (cdr bpoint)))

(if (and (= (cdr (assoc 72 tg)) 0) (= (cdr (assoc 73 tg)) 0))
(progn
(setq bx (car (cdr (assoc 10 tg))))
(setq by (car (cdr (cdr (assoc 10 tg)))))
)
(progn
(setq bx (car (cdr (assoc 11 tg))))
(setq by (car (cdr (cdr (assoc 11 tg)))))
)
)

(setq attr (cdr tg))
(setq tg (cdr (assoc 1 tg)))
(setq inc 0)
(setq tg1 "")
(setq t_base "")
(setq b_base "")
(setq idnum 0)
(setq top 0)
(setq bottom 0)
(setq stnum "")
(setq deci 0)
(repeat (strlen tg)
(if
(or (and (> (ascii (setq tgnum (substr tg (- (strlen tg) inc) 1)))
47
) ;(chr 32)
(< (ascii (setq tgnum (substr tg (- (strlen tg) inc) 1)))
58
)
)

(= (ascii (setq tgnum (substr tg (- (strlen tg) inc) 1)))
32
)

(= (ascii (setq tgnum (substr tg (- (strlen tg) inc) 1)))
46
)
)
(progn
(if (= (ascii (setq tgnum (substr tg (- (strlen tg) inc) 1)))
46
)
(setq deci inc)
)
(if (= inc 0)
(progn
(setq idnum 1)
(if
(= (ascii (setq tgnum (substr tg (- (strlen tg) inc) 1)))
46
)
(setq b_base (strcat "." b_base))
)
)
)
(if (= bottom 1)
(progn (setq bottom 0) (setq idnum 1) (setq top 1))
)
(if (and (= idnum 0) (= top 1))
(setq t_base (strcat tgnum t_base))
)
(if (= idnum 1)
(progn
(if (and (= tgnum "0") (> inc 0))
(setq stnum (strcat stnum "0"))
(setq stnum "")
)
(setq tg1 (strcat tgnum tg1))
)
)
)
(if (= inc 0)
(progn
(setq b_base (strcat tgnum b_base))
(setq bottom 1)
)
(if (= bottom 1)
(setq b_base (strcat tgnum b_base))
(progn
(setq top 1)
(setq t_base (strcat tgnum t_base))
(if (= idnum 1)
(setq idnum 0)
)
)
)
)
)
(setq inc (+ inc 1))
)

(if (= tg1 "")
(exit)
)
(setq num (atof tg1))
(setq count 1)

(while (setq bpoint (getpoint "\nChon diem copy tiep theo : "))
(setq num (+ num num_inc))
(if (>= (strlen b_base) 1)
(cond
((or (= "A"
(strcase (substr b_base (strlen b_base) 1))
)
(= "B"
(strcase (substr b_base (strlen b_base) 1))
)
)
(setq b_base
(strcat
(substr b_base 1 (1- (strlen b_base)))
(chr (1+ (ascii (substr b_base (strlen b_base) 1))))
)
)
)
((= "C" (strcase (substr b_base (strlen b_base) 1)))
(setq
b_base (strcat (substr b_base 1 (1- (strlen b_base))) "A")
)
)
)

)
(setq value (strcat t_base (strcat stnum (rtos num 2 deci)) b_base))
(setq nx (car bpoint))
(setq ny (car (cdr bpoint)))
(setq dx (- nx x))
(setq dy (- ny y))
(setq mx (car (getvar "ucsxdir")))
(setq my (car (cdr (getvar "ucsxdir"))))
(setq loca1 (+ bx (* mx dx)))
(setq loca2 (+ by (* my dx)))
(setq mx (car (getvar "ucsydir")))
(setq my (car (cdr (getvar "ucsydir"))))
(setq loca1 (+ loca1 (* mx dy)))
(setq loca2 (+ loca2 (* my dy)))
(setq attr_ent (subst (cons 1 value) (assoc 1 attr) attr))
(if (and (= (cdr (assoc 72 attr_ent)) 0)
(= (cdr (assoc 73 attr_ent)) 0)
)
(setq attr_ent (subst (list 10 loca1 loca2 0)
(assoc 10 attr_ent)
attr_ent
)
)
(setq attr_ent (subst (list 11 loca1 loca2 0)
(assoc 11 attr_ent)
attr_ent
)
)
)
(entmake attr_ent)
(setq count (+ count 1))
) ;end while
(princ)
)



Ah bạn cho mình hỏi thêm 1 câu.mình thấy cái này chỉ xử lý đc với DTEXT thế nếu mà là MTEXT thì có làm đc kô vậy bạn.
  • 0

#1195 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 17 October 2008 - 09:06 AM

Em nhờ bác viết là 1 lisp như thế này.
- Pick vào 1 điểm sau đó nhập tọa độ của người dùng tự cho vào. Ví dụ điểm 1 tọa độ người dùng nhập vào là (a,b,c). Sau đó pick vào điểm thứ 2. Sẽ ghi tọa độ của điểm thứ 2 so với điểm 1. x2=a+x; y2=b+y; z2=c+z. x, y, z là khoảng cách xác định trong cad theo trục x, y, z.
..........................

Theo yêu cầu của Sony2007, mạn phép bác Hoành cho tui sử dụng lại "LISP nhập tọa độ" của Bác.

- Vấn đề cao độ. Píck vào điểm 1, người dùng nhập vào cao độ là a. Pick vào điểm thứ 2 ghi cao độ điểm 2 thông qua điểm 1. Caodộ 2= a+y. Trong đó y là khoảng cách trong autocad giữa điểm 1 và 2 theo phương y.

Từ LISP nhập tọa độ (x,y), bác xóa phần tọa độ theo phương x -> LISP nhập cao độ.
(defun c:tdd(/ dgoc_x dgoc_y caodo_x caodo_y k)
(setq dgoc_x (getvar "userr1")
dgoc_y (getvar "userr2")
caodo_x (getvar "userr3")
caodo_y (getvar "userr4"))
(princ (strcat "\nDiem goc: " (rtos dgoc_x) "," (rtos dgoc_y)) )
(princ (strcat "\nToa do tuong ung: " (rtos caodo_x) "," (rtos caodo_y)) )
(setq k (getstring "\nThay doi diem & toa do goc ?(N)"))
(if (or (= k "y")(= k "Y") )
(c:tdg)
(setq dgoc (list dgoc_x dgoc_y 0.0)
caodo (list caodo_x caodo_y 0.0) )
)
(while (and caodo dgoc (setq p (getpoint "\nVao diem: ")) )
(ctxt p)
)
(princ)
)

(defun c:tdg(/ caodo_x caodo_y)
(setq dgoc (getpoint "\nVao diem goc: ")
caodo_x (getreal "\nToa do phuong X tuong ung:")
caodo_y (getreal "\nToa do phuong Y tuong ung:")
)
(if (and dgoc caodo_x caodo_y)
(progn
(setvar "userr1" (car dgoc)) (setvar "userr2" (cadr dgoc))
(setvar "userr3" caodo_x) (setvar "userr4" caodo_y)
(setq caodo (list caodo_x caodo_y 0.0) )
(ctxt dgoc )
)
(princ "\nDiem & toa do goc sai !")
)
(princ)
)
(defun ctxt(p)
(setq lst (mapcar 'rtos (mapcar '+ caodo (mapcar '- p dgoc)))
gt (strcat (car lst)","(cadr lst))
)
(entmake (list (cons 0 "TEXT") (cons 10 (trans p 1 0)) (cons 1 gt) (cons 40 175)))
)


  • 0

#1196 phutthu6

phutthu6

    biết vẽ arc

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

Đã gửi 17 October 2008 - 09:12 AM

Các bác ơi chỉ giúp em cái lisp coppy ''thông minh'' tự nhảy số thứ tự 1, 2, 3, ... và chữ cái A, B, C, D, ... để đánh trục với ạ.Em search mãi chả được.
Em cám ơn Ạ!
Chúc cả nhà ngày mới vui khoẻ nhiều tiền!
  • 0

#1197 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 17 October 2008 - 12:58 PM

Ah bạn cho mình hỏi thêm 1 câu.mình thấy cái này chỉ xử lý đc với DTEXT thế nếu mà là MTEXT thì có làm đc kô vậy bạn.

Đoạn code trên chỉ cho fép chọn DText thôi, với Mtext thì ko ổn lắm vì trong chuỗi nội dung còn có kiểu chữ, định dạng loằng ngoằng lắm. Tốt nhất là bạn chỉ dùng với Dtext thôi.
  • 0

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

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


#1198 Sony2007

Sony2007

    biết lệnh copy

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

Đã gửi 17 October 2008 - 01:37 PM

Theo yêu cầu của Sony2007, mạn phép bác Hoành cho tui sử dụng lại "LISP nhập tọa độ" của Bác.


Từ LISP nhập tọa độ (x,y), bác xóa phần tọa độ theo phương x -> LISP nhập cao độ.

(defun c:tdd(/ dgoc_x dgoc_y caodo_x caodo_y k)
(setq dgoc_x (getvar "userr1")
dgoc_y (getvar "userr2")
caodo_x (getvar "userr3")
caodo_y (getvar "userr4"))
(princ (strcat "\nDiem goc: " (rtos dgoc_x) "," (rtos dgoc_y)) )
(princ (strcat "\nToa do tuong ung: " (rtos caodo_x) "," (rtos caodo_y)) )
(setq k (getstring "\nThay doi diem & toa do goc ?(N)"))
(if (or (= k "y")(= k "Y") )
(c:tdg)
(setq dgoc (list dgoc_x dgoc_y 0.0)
caodo (list caodo_x caodo_y 0.0) )
)
(while (and caodo dgoc (setq p (getpoint "\nVao diem: ")) )
(ctxt p)
)
(princ)
)

(defun c:tdg(/ caodo_x caodo_y)
(setq dgoc (getpoint "\nVao diem goc: ")
caodo_x (getreal "\nToa do phuong X tuong ung:")
caodo_y (getreal "\nToa do phuong Y tuong ung:")
)
(if (and dgoc caodo_x caodo_y)
(progn
(setvar "userr1" (car dgoc)) (setvar "userr2" (cadr dgoc))
(setvar "userr3" caodo_x) (setvar "userr4" caodo_y)
(setq caodo (list caodo_x caodo_y 0.0) )
(ctxt dgoc )
)
(princ "\nDiem & toa do goc sai !")
)
(princ)
)
(defun ctxt(p)
(setq lst (mapcar 'rtos (mapcar '+ caodo (mapcar '- p dgoc)))
gt (strcat (car lst)","(cadr lst))
)
(entmake (list (cons 0 "TEXT") (cons 10 (trans p 1 0)) (cons 1 gt) (cons 40 175)))
)

Dù đã bấm thanhks rồi, nhưng vẫn muốn gửi đến 'gia_bach' một lời cám ơn rất nhiều
  • 0

#1199 nguyenkhoadung98

nguyenkhoadung98

    biết vẽ pline

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

Đã gửi 17 October 2008 - 04:13 PM

Đoạn code trên chỉ cho fép chọn DText thôi, với Mtext thì ko ổn lắm vì trong chuỗi nội dung còn có kiểu chữ, định dạng loằng ngoằng lắm. Tốt nhất là bạn chỉ dùng với Dtext thôi.

Cảm ơn bạn, mình muốn dùng cho MT thì phải làm thế nào. bạn có thể cho mình cái lisp dùng cho MT đc kô,cảm ơn nhiều :leluoi:
  • 0

#1200 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 17 October 2008 - 10:35 PM

Cảm ơn bạn, mình muốn dùng cho MT thì phải làm thế nào. bạn có thể cho mình cái lisp dùng cho MT đc kô,cảm ơn nhiều :leluoi:

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

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

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