Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Nguyen Hoanh

Viết Lisp theo yêu cầu

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

Nguyen Hoanh    4.524
- 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.

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

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


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

Tôi cầ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

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

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

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!

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

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


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

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

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

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

ma.jpg

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

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

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


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

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


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


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

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


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

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

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
phutthu6    9

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!

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

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

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

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

  • Vote tăng 1

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


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

×