Viết Lisp theo yêu cầu

Tháng 10 14, 2008

- Bác Hoành ơi, bác có thể bổ sung thêm tính năng: chọn tọa độ gốc thông qua pick điểm, sau đó nhập giá trị điểm toạ độ gốc vào. Tọa độ điểm sẽ xác định trên giá trị tọa độ gốc đã nhập. Chứ không nhất thiết bao giờ giá trị tọa độ gốc là 0,0.
- Trên diễn đàn đã có lisp đánh cốt: khi đánh cốt của 1 điểm nào đó không nhất thiết phải chọn cốt 000, mà chọn giá trị cốt ở vị trí bất kỳ sau đó mới đánh cốt.

Bác giúp em với nhé. Cám ơn nhiều

Những lisp dạng này đều có 2 lệnh. 1 lệnh là để xác định gốc, lệnh còn lại là lệnh vẽ.

Với lisp vẽ text của bạn, bạn gõ TDG để xác định tọa độ gốc.

Với lisp đánh cốt, gõ cot00 để xác định cốt 00.

Bạn nên đọc kỹ hướng dẫn trước khi dùng và hỏi người khác.

Tháng 10 14, 2008

Chào Bác NguyenHoanh
Nhờ bác viết dùm đọan code vẽ mặt cắt ngang theo vết cắt định trước cắt qua các điểm có cao độ là các text 2d

chiều dai mặt cắt ngang được vẽ là chiều dài vết cắt và các điểm cao độ sẽ được pick từ các điểm gần nhất với vết cắt, khoảng cách lẻ trong mặt cắt ngang là khoảng các giữa hình chiếu vuông góc của các điểm trên vết cắt

Xin cám ơn anh Nguyen Hoang!

bạn nên upload 1 file dwg lên diễn đàn, trong đó có các text ví dụ của bạn.

Tháng 10 14, 2008

Tôi cần xác định khối lượng đào đất đá của một khu vực dự kiến bố trí công trình, ví dụ cần làm một cái sân có kích thước 100mx100m, đặt lên một khu đất bất kỳ, cần xác định vị trí đặt cái sân đó để khối lượng phải đào đất đá để đặt cái sân đó là ít nhất, các chuyên gia lisp giúp tôi với!!!!!!! Help meeee

Tháng 10 14, 2008

Những lisp dạng này đều có 2 lệnh. 1 lệnh là để xác định gốc, lệnh còn lại là lệnh vẽ.

Với lisp vẽ text của bạn, bạn gõ TDG để xác định tọa độ gốc.

Với lisp đánh cốt, gõ cot00 để xác định cốt 00.

Bạn nên đọc kỹ hướng dẫn trước khi dùng và hỏi người khác.

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

Tháng 10 15, 2008

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!

Tháng 10 15, 2008

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

Tháng 10 15, 2008

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.

Tháng 10 15, 2008

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

Tháng 10 16, 2008

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)

Tháng 10 16, 2008

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.

Tháng 10 16, 2008

Ra mục download>autolisp., load file ma text về xài.

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

Tháng 10 16, 2008

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

Tháng 10 16, 2008

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:

Tháng 10 16, 2008

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ỉ ....

Tháng 10 16, 2008

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.

Tháng 10 16, 2008

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

Tháng 10 16, 2008

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

Tháng 10 17, 2008

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

Tháng 10 17, 2008

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.

Tháng 10 17, 2008

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

Tháng 10 17, 2008

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!

Tháng 10 17, 2008

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.

Tháng 10 17, 2008

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

Tháng 10 17, 2008

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

Tháng 10 17, 2008

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)

Đăng nhập

Viết Lisp theo yêu cầu

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

Nguyen Hoanh 4.663

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

Nguyen Hoanh 4.663

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

tranhoanpvpe 0

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

Sony2007 86

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

vandoan 0

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

makhongbietnoi 21

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

vandoan 0

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

khanhduydang 8

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

Nguyen Hoanh 4.663

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

tranchan 98

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

vandoan 0

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

gia_bach 1.549

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

vandoan 0

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

Sony2007 86

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

nguyenkhoadung98 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

Snowman 92

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

khanhduydang 8

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

nguyenkhoadung98 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

nguyenkhoadung98 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

gia_bach 1.549