Jump to content
InfoFile
Tác giả: phamthanhbinh
Bài viết gốc: 406871
Tên lệnh: vpl
(Nhờ Viết Lisp) Vẽ Polyline Qua Các Điểm Khi Biết Tọa Độ Tương Đối Với Điểm Gốc

Cám ơn bác ạ, đúng ý em rồi!

Hề hề hề,

Bạn có thể dùng cái này. Nó khác với cái của bạn tien2005 ở chỗ nó vẽ lần lượt từng đoạn khi bạn nhập số liệu rồi mới jonit, còn của bạn tien2005 thì nhập hết số liệu và nó vẽ một lần. Tùy bạn chọn lựa...

>>

Cám ơn bác ạ, đúng ý em rồi!

Hề hề hề,

Bạn có thể dùng cái này. Nó khác với cái của bạn tien2005 ở chỗ nó vẽ lần lượt từng đoạn khi bạn nhập số liệu rồi mới jonit, còn của bạn tien2005 thì nhập hết số liệu và nó vẽ một lần. Tùy bạn chọn lựa nhé.

 

http://www.cadviet.com/upfiles/6/5194_veduongtimthucte_1.lsp

 

(Defun c:vpl (/ p0 x0 y0 p1 x y p2 lst)
(setq p0 (getpoint "\n Chon diem tim tuyen")
         x0 (car p0)
         y0 (cadr p0) 
         p1 (list (+ x0 (getreal "\n Nhap ly do diem dau: ")) (+ y0 (getreal "\n Nhap chenh cao diem dau: "))) )
(while (and (setq x (getreal "\n Nhap ly do diem tiep theo: ")) (setq y (getreal "\n Nhap chenh cao diem tiep theo : ")))
        (setq p2 (list (+ x0 x) (+ y0 y)))
        (command "pline" p1 p2 "")
        (setq lst (cons (entlast) lst))
        (setq p1 p2)
)
(command "pedit" (entlast) "j" (acet-list-to-ss lst) "" "")
)

<<

Filename: 406871_vpl.lsp
Tác giả: lp_hai
Bài viết gốc: 419509
Tên lệnh: cld
Lisp Tự Động Revcloud Các Đối Tượng Cùng 1 Layer

Không có ai giúp hết nhỉ :)

(defun c:cld (/ dt bl sdt id en)
  (command "Undo" "be")
  (setq osm (getvar "osmode")
	bl (cdr (assoc 2 (entget(car (entsel "\nSelect Revision block: ")))))
	dt (ssget "_X" (list (assoc 8 (entget (car(entsel"\nSelect layer: "))))))
	sdt (sslength dt)
	id 0
	)
  (setvar "osmode" 0)
  (repeat...
>>

Không có ai giúp hết nhỉ :)

(defun c:cld (/ dt bl sdt id en)
  (command "Undo" "be")
  (setq osm (getvar "osmode")
	bl (cdr (assoc 2 (entget(car (entsel "\nSelect Revision block: ")))))
	dt (ssget "_X" (list (assoc 8 (entget (car(entsel"\nSelect layer: "))))))
	sdt (sslength dt)
	id 0
	)
  (setvar "osmode" 0)
  (repeat sdt
    (while
      (setq en (ssname dt id)
	    id (1+ id)
	    )
      (cloud en)
      )
    )
  (setvar "osmode" osm)
  (command "undo" "end")
  (princ)
  )
    
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;	
(defun cloud (en / p0 p1 pm)
  (setq p0 (vlax-curve-getPointAtParam en 0)
	p1 (vlax-curve-getPointAtParam en 1)
	pm (list (/(+(car p0)(car p1))2) (+(/(+(cadr p0)(cadr p1 ))2)8))
	)
  (command "revcloud" "o" en "")
  (entmake (list  (cons 0 "insert")  (cons 2 bl) (cons 10 pm)))
  )

Cái này là cho layer. Sau khi đánh lệnh pick chọn block rev, tiếp theo pick chọn đối tượng có layer bạn muốn thực hiện


<<

Filename: 419509_cld.lsp
Tác giả: quansla
Bài viết gốc: 419628
Tên lệnh: test
Nhờ Sửa Giúp File Dcl Và File Lisp Chèn Block Được Chọn

TapperBlockSets : dialog { label = "Tapper Block Sets 45";
 : column {
 : boxed_column {
 : button {
 key = "but1";
 label = "Tapper Block Sets 45-40";
 is_default = false;
 }
 : button {
 key = "but2";
 label = "Tapper Block Sets 45-50";
 is_default = false;
 }
 : button...

>>

TapperBlockSets : dialog { label = "Tapper Block Sets 45";
 : column {
 : boxed_column {
 : button {
 key = "but1";
 label = "Tapper Block Sets 45-40";
 is_default = false;
 }
 : button {
 key = "but2";
 label = "Tapper Block Sets 45-50";
 is_default = false;
 }
 : button {
 key = "but3";
 label = "Tapper Block Sets 45-75";
 is_default = false;
 }
 }
 : boxed_row {
 : button {
 key = "cancel";
 label = "Close";
 is_default = true;
 is_cancel = true;
 }
 }
 }
 
Đây là cấu trúc trong file DCL của mình. bạn xem hộ xem. Còn các file dwg đã đc để trong support của cad rồi. Mình mới học nên chưa có đọc đến các hàm của Lee sử dụng. :P



Okie vậy bạn hãy xem cấu trúc file lsp và thử suy nghĩ nhé

(defun c:test (/)
  (setq dcl_id (load_dialog "TapperBlockSets.dcl"))
  (if (not (new_dialog "TapperBlockSets" dcl_id))
    (progn
      (alert "TapperBlockSets.dcl file could not be loaded!")
      (exit)
      )
    )
  (setq str "asasdfa"
	flag nil)
  (action_tile "but1" "(done_dialog) (setq flag 1)")
  (action_tile "but2" "(done_dialog)(setq flag 2)")
  (action_tile "but3" "(done_dialog)(alert str)")
  (action_tile "cancel" "(done_dialog)")
  (start_dialog)
  (unload_dialog dcl_id)
  (if (= 1 flag) (tbs4540))
  (princ)
  )

 
 kksaldljkfjaslkdflkaklsf
 
Hãy chú ý các dòng sau:
(setq str "asasdfa"
flag nil)
 
Với dòng này mình đã gán cho biến str giá trị "asasdfa" để kiểm tra, flag = nil
 
 
tiếp theo 
 
(action_tile "but3" "(done_dialog)(alert str)")
 

 
Bạn thấy rằng Nếu bạn thực hiện test Lệnh trong Cad, thì dù bạn đã cho (done_dialog), sau đó mới cho hiện alert (tức chủ ý là đóng hết Dialog , rồi mới cho hiện alert)
nhưng cad vẫn chưa thoát mà lại cho hiện đồng thời cả 2 hộp thoại: 1 của DCL (do bạn viết) và 1 của dòng Alert (đây CŨNG CHÍNH LÀ NGUYÊN NHÂN CODE BAN ĐẦU BẠN VIẾT KHÔNG HOẠT ĐỘNG MÀ TREO MÁY) cad chưa thoát được hộp thoại DCL thì đối với dòng (getpoint) Cad không thực thi được -> treo
(so sánh với Code cũ: (action_tile "but3" "(done_dialog)(tbs4575)")
 
Vậy tính sao đây, bạn có thể sử dụng như mình bằng cách không cho thực hiện (tbs4575) mà chỉ gán giá trị cho biến Flag = 1 sau khi hộp thoại kết thúc (unload_dialog) thì sẽ kiểm tra giá trị Flag để thực hiện lệnh cần dùng (chú ý với cách này, done_dialog không cần nhé)
bạn chạy lại code mới như mình sửa và nghiên cứu nhé


<<

Filename: 419628_test.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 419668
Tên lệnh: tl
Nhờ Các Bác Sửa Lại Cái Lips Ghi Độ Dài Cho Em Với

http://www.cadviet.com/upfiles/7/135455_new_text_document_1.txt

Em có cái lips ghi độ dài của đoạn thẳng ở trên. Khi click vào 1 đoạn thẳng và 1 text có sẵn nó sẽ ghi ra ví dụ là "D00 HDPE - L40,354M". Trong đó D là đường kính, HDPE là...

>>

http://www.cadviet.com/upfiles/7/135455_new_text_document_1.txt

Em có cái lips ghi độ dài của đoạn thẳng ở trên. Khi click vào 1 đoạn thẳng và 1 text có sẵn nó sẽ ghi ra ví dụ là "D00 HDPE - L40,354M". Trong đó D là đường kính, HDPE là vật liệu, L40.354m là chiều dài đoạn thẳng.

Giờ em muốn các bác sửa lại cho em như sau:

Khi click vào text để nó ghi ra sẽ là text nào đó có sẵn như D32 HDPE - L50M, hoặc D40 HDPE - L60M. Giờ em muốn nó chỉ thay đổi giá trị L60M thành giá trị của đoạn thẳng cần ghi. D32 HDPE hoặc D40 HDPE giữ nguyên. Bình thường nó sẽ có giá trị sau dấu phẩy, em muốn nó làm tròn và cộng thêm 2M nữa. Ví dụ 40,435m sẽ thành 42m, 40,624m sẽ thành 43m

Hề hề hề,

Chưa hiểu rõ yêu cầu của bạn lắm. Có phải tất cả các text mà bạn muốn thay thế đều có chữ L hay không??? Trong trường hợp bạn chọn điểm để ghi text chứ không phải thay thế text mới thì sao??? 

Mình sửa thử như vầy không biết có trúng ý bạn không????

(defun C:TL( / ss L e #h)
 
(vl-load-com)
 
(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
 
(or ans (setq ans 1))
 
(setq
 
    #h 3
 
    L (strcat ;;;"D00 HDPE - L";;;
 
    ;;; (vl-princ-to-string 
 
   (rtos (+ (* (getvar "dimlfac") (apply '+
 
     (mapcar 'Length1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))))))
 
    )) 2) 2 0)" m"
 
    )
 
    ans (cond ((getint (strcat "\nPhuong an nhap ket qua < " (itoa ans) " > :")))(ans))
 
    txtObj (cond     ((= ans 1) (vlax-ename->vla-object (car (entsel "\nChon text ghi ket qua :"))))
 
     (T (vla-addtext (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) L (vlax-3d-point (getpoint "\n Chon diem nhap ket qua" )) #h ))
 
     )
 
)
 
(setq nd (vlax-get-property txtobj 'TextString)
 
       k (vl-string-position (ascii "L") nd)
 
       txt1 (cond 
                 ( k (substr nd 1 (1+ k )))
                 (T "")     )
) 
 
(setq L (strcat txt1 L))
 
(vla-put-TextString txtObj L)
 
(vla-put-Height txtObj #h)
 
(princ)
 
)
 

<<

Filename: 419668_tl.lsp
Tác giả: VUVUZELA
Bài viết gốc: 105778
Tên lệnh: aboutvld vld
Xem giúp đoạn lisp của mình vẽ pline có nhập chiều dài và góc
Vậy chú bẫy lỗi ngay từ đầu luôn xem thử



Nếu không đựoc thì bẫy (đặt phím F9) ngay từ khi vô dialog luôn thử
Còn không thì bấm tổ hợp phím Ctrl+Shift+I khi con trỏ ở trước dấu ( của từng biến xem kết quả là biết liền

Filename: 105778_aboutvld_vld.lsp
Tác giả: hungdlcm
Bài viết gốc: 105781
Tên lệnh: avld
Xem giúp đoạn lisp của mình vẽ pline có nhập chiều dài và góc


Cảm ơn bác đã nhiệt tình júp đỡ em ạ! Em đang vẫn dùng Lisp ban đầu của em và đã thử sửa lại nó như sau:



Thì đã khắc phục được vấn đề chèn điểm sai vị trí. Bây jờ em chèn block vào điểm đầu hay điểm cuối đều OK cả. Nhưng cái dở là sau khi vẽ xong Pline phải thêm 1 dialog để chọn điểm chèn sau đó mới chèn block vào điểm chọn của PLine.
>>


Cảm ơn bác đã nhiệt tình júp đỡ em ạ! Em đang vẫn dùng Lisp ban đầu của em và đã thử sửa lại nó như sau:



Thì đã khắc phục được vấn đề chèn điểm sai vị trí. Bây jờ em chèn block vào điểm đầu hay điểm cuối đều OK cả. Nhưng cái dở là sau khi vẽ xong Pline phải thêm 1 dialog để chọn điểm chèn sau đó mới chèn block vào điểm chọn của PLine.

Em đoán lỗi của đoạn lisp ban đầu của em là ở chỗ này:



Vì lúc diễn ra hàm get_tile thì điểm P1 và P2 vẫn chưa được xác định (ta chưa click chọn điểm P1) mà ta đã gán biến A là P1.

Em chỉ đoán vấn đề nằm ở chỗ này nhưng không bít fân tích nó ra sao. Mong các bác cao thủ xem lại Lisp ban đầu và Lisp sau khi sửa của em một lần nữa và tìm ra nguyên nhân phân tích jùm cho em hỉu rõ nguyên nhân của lỗi này do đâu nhé!!

Cảm ơn các bác đã hỗ trợ em nhìu ạ!!
<<

Filename: 105781_avld.lsp
Tác giả: Tue_NV
Bài viết gốc: 419937
Tên lệnh: cpt
Nhờ Viết Lisp Rải Text Dạng Số

Cám ơn anh Mèo Mun đã quan tâm và trả lời.

Chính xác thì em vẫn đang làm như cách anh nói, nhưng do công việc phải làm cần copy text mẫu > đặt đúng vị trí > sửa text lặp đi lặp lại đến hàng chục nghìn lần trên 1 bản vẽ nên nếu có lisp như vậy bản thân em thấy rút ngắn được khá nhiều thời...

>>

Cám ơn anh Mèo Mun đã quan tâm và trả lời.

Chính xác thì em vẫn đang làm như cách anh nói, nhưng do công việc phải làm cần copy text mẫu > đặt đúng vị trí > sửa text lặp đi lặp lại đến hàng chục nghìn lần trên 1 bản vẽ nên nếu có lisp như vậy bản thân em thấy rút ngắn được khá nhiều thời gian, đẩy nhanh tốc độ thực hiện công việc. 

Em đã search trên diễn đàn mà không thấy có lisp tương tự hay cách làm ngắn hơn.

Mong được các anh chị giúp đỡ, nếu e có gì sai sót mong các anh chị chỉ bảo thêm.

Em xin cảm ơn.

Quick code 

(defun c:cpt(/ ss pt1)
  (setq pt1 (getpoint "\nChon diem goc copy : "))
  (setq ss (car (entsel "\n Chon Text:")))
 
  (while (and ss pt1)
    (command "._copy" ss "" pt1 (setq pt1 (getpoint pt1 "\n diem dich copy :")  ))
    (setq ss (entlast))
    (command "_.ddedit" "L" "") 
  )
)

<<

Filename: 419937_cpt.lsp
Tác giả: dinhvantrang
Bài viết gốc: 420009
Tên lệnh: cps
Xin Lisp Setup Muilti-Plot Trong Layout
;; Copy current layout page setup to all layout tabs
(vl-load-com)
(defun c:CPS (/ Adoc Layts clyt)
  (setq aDoc  (vla-get-activedocument (vlax-get-acad-object))
 Layts (vla-get-layouts aDoc)
 clyt  (vla-get-activelayout aDoc)
  )
  (foreach
     itm
        (vl-remove (vla-get-name clyt) (layoutlist))
    (vla-copyfrom (vla-item Layts itm) clyt)
  )
  (princ)
)

Lượm lặt được, copy từ Page Setup trong Layout hiện hành tới tất cả...

>>
;; Copy current layout page setup to all layout tabs
(vl-load-com)
(defun c:CPS (/ Adoc Layts clyt)
  (setq aDoc  (vla-get-activedocument (vlax-get-acad-object))
 Layts (vla-get-layouts aDoc)
 clyt  (vla-get-activelayout aDoc)
  )
  (foreach
     itm
        (vl-remove (vla-get-name clyt) (layoutlist))
    (vla-copyfrom (vla-item Layts itm) clyt)
  )
  (princ)
)

Lượm lặt được, copy từ Page Setup trong Layout hiện hành tới tất cả Layout.


<<

Filename: 420009_cps.lsp
Tác giả: gia_bach
Bài viết gốc: 420067
Tên lệnh: doit
Code Lấy Danh Sách Layout Theo Thứ Tự Có Sẵn

Dùng thử lisp này : 

(defun c:doit ( / vlayouts layouts)
  (vlax-map-collection
    (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)))
    '(lambda (x) (setq vlayouts (cons x vlayouts)))    )
  (setq vlayouts (cdr (vl-sort vlayouts
			       '(lambda (x y)
				  (< (vla-get-taborder x) (vla-get-taborder y))  )  ) ) )
  (setq layouts (mapcar '(lambda (x) (vla-get-name x)) vlayouts))    )

Filename: 420067_doit.lsp
Tác giả: hiepttr
Bài viết gốc: 420100
Tên lệnh: cct
Thay Đổi Hàng Loạt Text Theo Hàng Cột

Của bạn đây ^^

 

p/s:

Code chạy đúng với BV mẫu bạn đưa lên.

Khi k/c giữa các cột thay đổi thì "có thể" phải sửa một chút (đã đánh dấu trong code)

 

Con số trong code nhỏ hơn k/c tối thiểu giữa các cột

;Copy content of texts 
(defun c:CCT( / ss lst ss2 lst2 len cmd)
(setq...
>>

Của bạn đây ^^

 

p/s:

Code chạy đúng với BV mẫu bạn đưa lên.

Khi k/c giữa các cột thay đổi thì "có thể" phải sửa một chút (đã đánh dấu trong code)

 

Con số trong code nhỏ hơn k/c tối thiểu giữa các cột

;Copy content of texts 
(defun c:CCT( / ss lst ss2 lst2 len cmd)
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(prompt "\nChon cac doi tuong *TEXT mau !")
(setq ss (ssget '((0 . "*TEXT"))))
(if ss
	(progn
		(setq lst (H:sort_<x_>y ss))
		(setq len (length lst))
		;;;=====
		(prompt "\nChon cac doi tuong *TEXT dich !")
		(setq ss2 (ssget '((0 . "*TEXT"))))
		(if (and ss2 (= (sslength ss2) len))
			(progn
				(setq lst2 (H:sort_<x_>y ss2))
				(mapcar 'Put_content lst lst2)
			)
			(princ "*** Tap cac text dich ko cung form voi text mau ***")
		)
	)
	(princ "Khong chon duoc text mau !")
)
(setvar "cmdecho" cmd)
(princ)
)
;======================

;;;====================
(defun H:sort_>y(lst_ename_text)
	(if (> (length lst_ename_text) 1) (vl-sort lst_ename_text '(lambda (x y) (> (caddr (assoc 10 (entget x))) (caddr (assoc 10 (entget y)))))) lst_ename_text)
)
;;;====================
(defun H:sort_<x_>y(ss_text / lst hot lst1)
(setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss_text)))
	  lst (vl-sort lst '(lambda (x y) (< (cadr (assoc 10 (entget x))) (cadr (assoc 10 (entget y)))))))
(setq hot (car lst)
	  lst1 (cdr lst)
	  lst (list (list hot))
)
(foreach elem lst1
	(if (equal (cadr (assoc 10 (entget elem))) (cadr (assoc 10 (entget hot))) 30) 	;Thay doi k/c cot o so (30) hang nay
		(setq lst (append (reverse (cdr (reverse lst))) (list(append (last lst) (list elem)))))
		(setq lst (append lst (list (list elem)))
			  hot elem)
	)	  ;if
)	  ;for
(apply 'append (mapcar 'H:sort_>y lst))
)
;;;======================================
(defun Put_content(ename_get_cont ename_put_cont / info)
(setq info (entget ename_put_cont))
(entmod (subst (assoc 1 (entget ename_get_cont)) (assoc 1 info) info))
)

<<

Filename: 420100_cct.lsp
Tác giả: dinhvantrang
Bài viết gốc: 420082
Tên lệnh: cpt
Nhờ Viết Lisp Rải Text Dạng Số

Qua sử dụng em gặp tình huống là khi copy text e chọn điểm gốc copy là điểm màu xanh (đó là ô vuông nhỏ khi click vào text hiện ra), và lúc đó điểm ô màu xanh trùng với end line. Em chọn điểm đích copy là các điểm nằm rải rác trên đoạn line đó ( em sử dụng osnap nên chắc chắn sẽ bắt trúng line) nhưng sau...

>>

Qua sử dụng em gặp tình huống là khi copy text e chọn điểm gốc copy là điểm màu xanh (đó là ô vuông nhỏ khi click vào text hiện ra), và lúc đó điểm ô màu xanh trùng với end line. Em chọn điểm đích copy là các điểm nằm rải rác trên đoạn line đó ( em sử dụng osnap nên chắc chắn sẽ bắt trúng line) nhưng sau vài line em phát hiện điểm ô màu xanh không còn nằm trên line với các text em rải sau này nữa. Điểm ô màu xanh phải nằm trên line là yếu tố quan trọng mà e cần.

Nhờ anh xem lại giúp em. Cảm ơn anh

Chắc bạn cần là truy bắt điểm Nearest (OSMODE = 512)

(defun c:cpt(/ ss pt1)
 (seqt oldosmode (getvar "OSMODE"));Lay che do truy bat hien tai
;Gan truy bat diem Nearest
(setvar "OSMODE" 512)
(setq pt1 (getpoint "\nChon diem goc copy : "))
  (setq ss (car (entsel "\n Chon Text:")))
 
  (while (and ss pt1)
    (command "._copy" ss "" pt1 (setq pt1 (getpoint pt1 "\n diem dich copy :")))
    (setq ss (entlast))
    (command "_.ddedit" "L" "") 
  )
;Tra lai che do truy bat ban dau
(setvar "OSMODE" oldosmode )
)

<<

Filename: 420082_cpt.lsp
Tác giả: danhyks
Bài viết gốc: 420208
Tên lệnh: pm
Code Lấy Tọa Độ 2 Góc Trong Block Khung Tên

Bạn tìm hiểu hàm : vla-GetBoundingBox, trên diễn đàn có nhiếu người sử dụng rồi.

Thank gia_bach nhé. Mình đã làm được tuy nhiên trong model có nhiều bản vẽ nên mình muốn sắp xếp theo thứ tự từ trái sang phải,     từ trên xuống dưới thì dùng hàm nào vậy...

>>

Bạn tìm hiểu hàm : vla-GetBoundingBox, trên diễn đàn có nhiếu người sử dụng rồi.

Thank gia_bach nhé. Mình đã làm được tuy nhiên trong model có nhiều bản vẽ nên mình muốn sắp xếp theo thứ tự từ trái sang phải,     từ trên xuống dưới thì dùng hàm nào vậy bạn.

Nếu mình sử dụng hàm chọn tất cả các block "KhungTen" sau đó mình cho chạy hàm Repeat nhưng lại không sắp theo thứ tự được.

Bạn vui lòng xem đoạn code này giúp mình nhé.

 

223334444555.png

;-----In pdf ben model-----------------

;^^^^^^^^^^Dinh nghia lay gia tri 2 goc cua block ^^^^^^^^^^^^
(defun mma (entnm)
  (vl-load-com)  
(vla-getboundingbox entnm 'minpoint 'maxpoint)
(setq mp1 (vlax-safearray->list minpoint)
      mp2 (vlax-safearray->list maxpoint)
)
  )


(defun c:pm ()
  (setq ob (ssget ())
	obj (ssname ob 0)
	fn (vl-filename-base (getvar "dwgname"))  ;;;;get file name
	)

  (setq ob (ssget (command "selectsimilar" obj ""))
	n (sslength ob)
	j 1
	i 0
	)
  (repeat n
    (setq objvl (vlax-ename->vla-object (ssname ob i))
	  nu (itoa j)
	  sn (strcat fn "-" nu)
	  )
 (mma objvl)

   (command "-plot" "y" "Model" "DWG to PDF.pc3" "ISO full bleed A1 (594.00 x 841.00 MM)" "m" "l" "n" "w" mp1 mp2 "fit" "center" "" "monochrome.ctb"
	    "y" "" sn "" "" "" "y")
    (setq  i (1+ i)
	  j (1+ j)
	   )
    )
    
  )

<<

Filename: 420208_pm.lsp
Tác giả: vodoifx
Bài viết gốc: 415941
Tên lệnh: stt
Cộng, Trừ, Nhân, Chia Hàng Loạt Att Cùng Tagname Trong Block Với Cùng 1 Số

Em có tham khảo lisp đánh số thứ tự bản vẽ để viết Cộng, trừ, nhân, chia hàng loạt Att cùng tagName trong Block với 1 số, nhưng khả năng có hạn nên chưa thể viết được. Mong các bác giúp em 
Lisp đánh sốt thứ tự Block

;; free lisp from cadviet.com
;;; this lisp was downloaded from...

>>

Em có tham khảo lisp đánh số thứ tự bản vẽ để viết Cộng, trừ, nhân, chia hàng loạt Att cùng tagName trong Block với 1 số, nhưng khả năng có hạn nên chưa thể viết được. Mong các bác giúp em 
Lisp đánh sốt thứ tự Block

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=38369&st=0&p=139366&hl=esport113&fromsearch=1&#entry139366
(defun c:stt (/ ans ins lst blkName tagName ent);Block Order
;; By : Gia_Bach, www.CadViet.com ;;
(vl-load-com)
(while (not (and
(setq ent (car (nentsel "\n Chon thuoc tinh can danh so: ")))
(if ent (eq (cdr (assoc 0 (entget ent))) "ATTRIB") ) ) )
(princ "\n Ban chon nham roi! ") )
(setq blkName (cdr (assoc 2 (entget (cdr (assoc 330 (entget ent))))))
tagName (cdr (assoc 2 (entget ent))) )

(initget 1 "Yes No")
(setq x (getkword "\nBan co muon nhap Tien to ? (Yes or No) "))
(if (= x "Yes")
(progn
(or prefix (setq prefix "KC-"))
(setq ans (getstring t (strcat "\n Nhap tien to <<"prefix ">> :")))
(if (/= ans "")(setq prefix ans)) )
(setq prefix ""))

(or stt (setq stt 1))
(initget 6)
(setq ans (getint (strcat "\n Nhap so bat dau <<"(itoa stt) ">> :")))
(if ans (setq stt ans))
(if (> stt 9)
(setq str (strcat prefix (itoa stt)))
(setq str (strcat prefix "0" (itoa stt))) )

(princ "\nChon Khung ten can danh so thu tu :")
(if (ssget(list (cons 0 "INSERT")(cons 66 1)(cons 2 blkName)))
(progn
(vlax-for e (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(setq ins (vlax-safearray->list (variant-value (vla-get-InsertionPoint e)))
lst (cons (list e ins)lst)) )
(setq lst (vl-sort lst '(lambda (x y) (or (> (cadr (cadr x)) (cadr (cadr y)))
(and (< (car (cadr x)) (car (cadr y)))
(= (cadr (cadr x)) (cadr (cadr y))) ) ) ) ))
(foreach e (append (mapcar 'car lst) )
(foreach Att (vlax-invoke e 'GetAttributes)
(if (= (vla-get-TagString att) tagName)
(vla-put-TextString att str) ))
(setq stt (+ 1 stt))
(if (> stt 9)
(setq str (strcat prefix (itoa stt)))
(setq str (strcat prefix "0" (itoa stt))) ) ) ) )
(princ))

 

 

Lisp cộng trừ nhân chia ATT với 1 số 

 

(defun c:at (/ goc cal e1 en numb Kieudoc)
(setq Kieudoc (cond (Kieudoc) ("Cong")))
(initget "1 2 3 4")
(setq Kieudoc (cond ((getkword (strcat "\Chon kieu can text <" Kieudoc ">"))) (Kieudoc)))
(setq goc1 (car (nentsel "\n Chon ATT can tinh")))
(redraw goc1 3)
(setq goc (atof (cdr (assoc 1 (entget goc1 )))))
(setq numb (getreal "\nNhap so Or bo qua de chon so: "))
(if (or (= numb nil) (= numb ""))
(setq numb (atof (cdr (assoc 1 (entget (car (entsel "\nChon so : "))))))))
(cond
((eq Kieudoc "1") (setq goc (+ goc numb)))
((eq Kieudoc "2") (setq goc (- goc numb)))
((eq Kieudoc "3") (setq goc (* goc numb)))
((eq Kieudoc "4") (setq goc (/ goc numb))))
(entmod (subst (cons 1 (rtos goc 2 2)) (assoc 1 (entget goc1)) (entget goc1)))
(entupd goc1))


<<

Filename: 415941_stt.lsp
Tác giả: hiepttr
Bài viết gốc: 421886
Tên lệnh: hh
Nhờ viết lisp: Tạo dim vuông góc giữa hai đường Polyline

Bạn thử xem ^^

(defun c:HH(/ lst_va old mcat tenMC plDo plXanh lst_ver fn pw p2 i LastObj lst_data)
	(setq lst_va '("osmode" "cmdecho"))
	(setq old (mapcar 'getvar lst_va))
	(mapcar 'setvar lst_va '(0 0))
	(vl-load-com)
	;-----------------------
(prompt "\n Chon ten mat cat!")
(setq mcat (ssget "+.:E:S" (list (cons 0 "TEXT,MTEXT"))))
(while mcat 
	(setq tenMC (cdr (assoc 1 (entget (ssname mcat...
>>

Bạn thử xem ^^

(defun c:HH(/ lst_va old mcat tenMC plDo plXanh lst_ver fn pw p2 i LastObj lst_data)
	(setq lst_va '("osmode" "cmdecho"))
	(setq old (mapcar 'getvar lst_va))
	(mapcar 'setvar lst_va '(0 0))
	(vl-load-com)
	;-----------------------
(prompt "\n Chon ten mat cat!")
(setq mcat (ssget "+.:E:S" (list (cons 0 "TEXT,MTEXT"))))
(while mcat 
	(setq tenMC (cdr (assoc 1 (entget (ssname mcat 0)))))
	(setq plDo (car(entsel "\n Chon duong mau do: ")))
	(setq plXanh (car(entsel "\n Chon duong mau xanh: ")))
	(if (and tenMC plDo plXanh)
		(progn
			(setq lst_ver (acet-geom-vertex-list plDo))
			(if (< (car (last lst_ver)) (car (car lst_ver))) (setq lst_ver (reverse lst_ver)) )
			(setq i 1)
			(foreach p1 lst_ver
				(setq p2 (vlax-curve-getClosestPointTo plXanh p1))
				(MakeText p1 (itoa i) 0.12 0 "L" nil "stt" nil nil)
				(command ".dimaligned" p1 p2 p2)
				(setq LastObj (vlax-ename->vla-object (entlast)))
				(setq lst_data (cons (strcat tenMC "," (itoa i) "," (rtos(vla-get-Measurement LastObj) 2 4) "," (rtos (car p1) 2 4) "," (rtos (cadr p1) 2 4) "," (rtos (last p1) 2 4)) lst_data))
				(setq i (1+ i))
			)
		)
		(princ "*** Chon lung tung roi! Lam lai nhe! ***")
	)	;if
	(prompt "\n Chon ten mat cat! <Enter de xuat so lieu>")
	(setq mcat (ssget "+.:E:S" (list (cons 0 "TEXT,MTEXT"))))
)	;while
(if lst_data
	(progn
		(setq lst_data (reverse lst_data))
		(setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
 		(setq pw (open fn "w"))
		(write-line (strcat "Mat cat, STT, K/cach, X, Y, Z") pw)
		(foreach elem lst_data
			(write-line elem pw)
		)
		(close pw)
	)
)
	(mapcar 'setvar lst_va old)
	(princ)
)
;;==================================================
(defun MakeText (point string Height Ang justify Style Layer Color xdata / Lst)
; Ang: Radial	
(setq Lst (list '(0 . "TEXT")
				(cons 8 (if Layer Layer (getvar "Clayer")))									
				(cons 62 (if Color Color 256))									
				(cons 10 point)									
				(cons 40 Height)									
				(cons 1 string)									
				(if Ang (cons 50 Ang))									
				(cons 7 (if Style Style (getvar "Textstyle")))									
				(cons -3 (if xdata (list xdata) nil)))				
				justify (strcase justify))	
				(cond ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))				
					  ((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))				
					  ((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))				
					  ((= justify "TL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 3)))))				
					  ((= justify "TC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 3)))))				
					  ((= justify "TR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 3)))))					
					  ((= justify "ML") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 2)))))				
					  ((= justify "MC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 2)))))				
					  ((= justify "MR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 2)))))				
					  ((= justify "BL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 1)))))				
					  ((= justify "BC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 1)))))				
					  ((= justify "BR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 1)))))
					  )	
					  (entmakex Lst)
)	;end

 


<<

Filename: 421886_hh.lsp
Tác giả: Mêlisp
Bài viết gốc: 349345
Tên lệnh: nm
Vẽ ống mềm kiểu ruột gà

Chương trình vẽ ống nối mềm. Xem giải thích chi tiết trong code:

 

>>

Chương trình vẽ ống nối mềm. Xem giải thích chi tiết trong code:

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;CHUONG TRINH VE ONG NOI MEM - FLEXIBLE TUBE
;;;Yeu cau: AutoCAD 2000 tro len
;;;Lenh: NM, nhap duong kinh ong va pick chon duong tam
;;;Chap nhan cac loai: line, pline, spline, arc, circle, ellipse
;;;Chuong trinh bat dau ve tu dau mut gan hon so voi diem pick
;;;Tri so duong kinh D cua lan chay truoc duoc tu dong luu lai
;;;Neu khong muon thay doi D, Enter khong can nhap so
;;;Gia tri mac dinh ban dau D = 100
;;;Ket qua ve la 1 duong pline duy nhat
;;;Written by ssg - June 2008 - www.cadviet.com
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun C:NM( / D chon e pC pM xM L ps pe n S
p01 x flag p02 a p1 p2 p3 p4 i oldos p03 p5 p6)
(vl-load-com)
(if (not D0) (setq D0 100))
(setq D (getreal (strcat "\nNhap duong kinh ong <" (rtos D0) ">:")))
(if (not D) (setq D D0) (setq D0 D))
(setq
chon (entsel "\nPick chon duong tam:")
e (car chon)
pC (cadr chon)
pM (vlax-curve-getClosestPointTo e pc)
xM (vlax-curve-getDistAtPoint e pM)
L (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))
ps (vlax-curve-getPointAtDist e 0)
pe (vlax-curve-getPointAtDist e L)
n (fix (/ (* 4 L) D))
S (/ L n)
)
(if (<= xM (/ L 2)) (setq p01 ps x 0 flag 1) (setq p01 pe x L flag -1))
(setq
p02 (vlax-curve-getPointAtDist e (+ x (* S flag)))
a (angle p01 p02)
p1 (polar p01 (- a (/ pi 2)) (/ D 2))
p2 (polar p1 (+ a (/ pi 2)) D)
p3 (polar p1 a S)
p4 (polar p2 a S)
i 2
oldos (getvar "osmode")
)
(setvar "osmode" 0)
(command "pline" p3 p4 p2 p1 p3)
(repeat (- n 1)
(setq
p03 (vlax-curve-getPointAtDist e (+ x (* i S flag)))
a (angle p02 p03)
p5 (polar p03 (- a (/ pi 2)) (/ D 2))
p6 (polar p5 (+ a (/ pi 2)) D)
)
(if (= i 2) (command "a"))
(command "a" -90 p5 "L" p6 "a" "a" -90 p4 "L" p3 "a" "a" -90 p5)
(setq p02 p03 p3 p5 p4 p6 i (1+ i))
)
(command "a" 90 p6 "a" 180 p5 "a" 180 p6 "")
(setvar "osmode" oldos)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Đăng ký ngay 1 Account để cảm ơn bác, nhưng hơi tiếc chút là mình đang vẽ ống xoắn HDPE rãnh ống sít nhau quá.


<<

Filename: 349345_nm.lsp
Tác giả: hiepttr
Bài viết gốc: 421918
Tên lệnh: dg
Nhờ Anh Em Tạo Lisp Vẽ Đường Giao 2 Đường Thẳng

Mì ăn liền cho bạn đây ^^

(defun c:DG( / lst_va old d1 d2 int_p sta_p end_p sta_p2 end_p2)
(setq lst_va '("osmode" "cmdecho"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(0 0))
;-------------
(setq d1 (entsel "\n Pick chon D1: ")
	  d2 (entsel "\n Pick chon D2: ")
	  )
(if (and d1 d2)
	(progn
		(setq d1 (car d1)
			  d2 (car d2)
		)
		(if (setq int_p (H:inter-group3 d1...
>>

Mì ăn liền cho bạn đây ^^

(defun c:DG( / lst_va old d1 d2 int_p sta_p end_p sta_p2 end_p2)
(setq lst_va '("osmode" "cmdecho"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(0 0))
;-------------
(setq d1 (entsel "\n Pick chon D1: ")
	  d2 (entsel "\n Pick chon D2: ")
	  )
(if (and d1 d2)
	(progn
		(setq d1 (car d1)
			  d2 (car d2)
		)
		(if (setq int_p (H:inter-group3 d1 d2))
			(progn
				(setq int_p (car int_p)
					  sta_p (vlax-curve-getPointAtParam d1 0)
					  end_p (vlax-curve-getPointAtParam d1 (vlax-curve-getEndParam d1))
					  sta_p2 (vlax-curve-getPointAtParam d2 0)
					  end_p2 (vlax-curve-getPointAtParam d2 (vlax-curve-getEndParam d2))
					  ;sta_p (vlax-safearray->list (variant-value (vla-get-StartPoint d1)))
					  ;end_p (vlax-safearray->list (variant-value (vla-get-EndPoint d1)))
				)
				(if (< (distance int_p sta_p) (distance int_p end_p)) (setq end_p sta_p))
				(if (< (distance int_p sta_p2) (distance int_p end_p2)) (setq end_p2 sta_p2))
				(MakeLine int_p (mid int_p end_p) "4")
				(MakeLine int_p (mid int_p end_p2) "4")
			)
			(princ "\n 02 thang nay khong giao nhau ma ^|^ ***")
		)
	)
	(princ "\n Pick truot roi ^|^ ***")
)
;;xong tra ve:
(mapcar 'setvar lst_va old)
(princ)
)
;;;;==============================================================
(defun H:inter-group3(ob1 ob2 / modul res)
(setq ob1 (vlax-ename->vla-object ob1)
	  ob2 (vlax-ename->vla-object ob2)
)
(cond 
	((null (setq modul (vlax-invoke ob1 'intersectwith ob2 acExtendBoth))) nil)
	((= (length modul) 3) (list modul))
	(t 
		(while (> (length modul) 0)
			(setq	res (cons (list (car modul) (cadr modul) (caddr modul)) res)
					modul (cdddr modul)
			)
		)
		(reverse res)
	)
)
)
;================
(defun MakeLine (PT1 PT2 Layer)	
(entmakex (list '(0 . "LINE")									
				(cons 8 (if Layer Layer (getvar "Clayer")))								  								
				(cons 10 PT1)	(cons 11 PT2)									
			)
)
)
;=======
(defun mid (p1 p2) (mapcar '* (mapcar '+ p1 p2) '(0.5 0.5 0.5)))

 


<<

Filename: 421918_dg.lsp
Tác giả: ketxu
Bài viết gốc: 420475
Tên lệnh: foo
lisp gán giá trị khoảng cách cho attribute
57 phút ago, colombus cho biết:

load được nhưng gọi lệnh...

>>
57 phút ago, colombus cho biết:

load được nhưng gọi lệnh thì không thấy gì bạn à. đang dùng winxp sp3 32bit. không biết điều  này có phải liên quan đến hệ điều hành hay không?

À, tại ketxu code trực tiếp trên nền web lúc reply, nên đánh sai vị trí dấu ).
Nó là như vầy ^^
 

(defun c:foo(/ s e)
 	(setvar 'dimzin 8)
	(setq s (rtos (distance (setq p1 (getpoint "\nP1 :")) (getpoint p1 "\nP2 :")) 2 2)) 
	(while  (setq e (nentsel "\nPick Att :")) (vla-put-textstring (vlax-ename->vla-object (car e)) s))
)

 


<<

Filename: 420475_foo.lsp
Tác giả: dinhvantrang
Bài viết gốc: 421706
Tên lệnh: vername
ĐÁNH SỐ STT THEO ĐƯỜNG DẪN
(defun c:vername (/ e i j m n p s)
  (if (and (setq s (ssget '((0 . "LWPOLYLINE"))))
	   )
    (repeat (setq i (sslength s))
      (setq e (ssname s (setq i (1- i)))
	    n (cdr (assoc 210 (entget e)))
	    m (vlax-curve-getendparam e)
	    j -1
      )
      (while (<= (setq j (1+ j)) m)
	(setq p (trans (vlax-curve-getpointatparam e j) 0 e))
	(entmakex
	  (list
	    (cons 0 "TEXT")
	    (cons 7 (getvar...
>>
(defun c:vername (/ e i j m n p s)
  (if (and (setq s (ssget '((0 . "LWPOLYLINE"))))
	   )
    (repeat (setq i (sslength s))
      (setq e (ssname s (setq i (1- i)))
	    n (cdr (assoc 210 (entget e)))
	    m (vlax-curve-getendparam e)
	    j -1
      )
      (while (<= (setq j (1+ j)) m)
	(setq p (trans (vlax-curve-getpointatparam e j) 0 e))
	(entmakex
	  (list
	    (cons 0 "TEXT")
	    (cons 7 (getvar 'TEXTSTYLE))
	    (cons 40 (getvar 'TEXTSIZE))
	    (cons 10 p)
	    (cons 11 p)
	    (cons 72 1)
	    (cons 73 2)
	    (cons 1 (itoa (1+ j)))
	    (cons 210 n)
	  )
	)
      )
    )
  )
  (princ)
)

Gửi bạn nhé


<<

Filename: 421706_vername.lsp
Tác giả: nguyenbac_cd
Bài viết gốc: 323792
Tên lệnh: ha3
nhờ viết lisp vẽ đồ thị trên cad số liệu được lấy từ file excel

Tặng chủ topic cái này, mới viết xong. Hy vọng hài lòng.

 

;Doan Van Ha - CADViet.com - Ngay...
>>

Tặng chủ topic cái này, mới viết xong. Hy vọng hài lòng.

 

;Doan Van Ha - CADViet.com - Ngay 24/11/2014
;Muc dich: Ve Spline qua cac diem duoc ghi trong file txt (moi hang la 1 diem, X va Y cach nhau boi 1 ky tu tab; ve duong dong; ghi text cao do duong duoi am tren).
(defun C:HA3( / fn ss pr rl txt pt pd lst)
 (command "ucs" "w") (command "undo" "be")
 (setq fn (getfiled "Chon file de lay so lieu" "" "txt" 8))
 (or (and tlx (or (= (type tlx) 'int) (= (type tlx) 'real))) (setq tlx 200))
 (setq tlx (cond ((getreal (strcat "\nTi le theo phuong X <" (rtos tlx 2 0) ">: "))) (tlx)))
 (or (and tly (or (= (type tly) 'int) (= (type tly) 'real))) (setq tly 5000))
 (setq tly (cond ((getreal (strcat "\nTi le theo phuong Y <" (rtos tly 2 0) ">: "))) (tly)))
 (or (and hei (or (= (type hei) 'int) (= (type hei) 'real))) (setq hei 0.10))
 (setq hei (cond ((getreal (strcat "\nChieu cao chu <" (rtos hei 2 2) ">: "))) (hei)))
 (setq ss (ssadd))
 (setq pr (open fn "r"))
 (while (setq rl (read-line pr))
  (setq txt (HA:str->lst rl (chr 9)))
  (setq pt (list (/ (car txt) tlx) (/ (cadr txt) tly)))
  (setq pd (list (/ (car txt) tlx) 0))
  (MakeLine pd pt 5)
  (ssadd (entlast) ss)
  (if (>= (cadr txt) 0)
   (MakeText (polar pd (/ pi -2) hei) (rtos (cadr txt) 2 0) hei 2 "MR")
   (MakeText (polar pd (/ pi 2) hei) (rtos (cadr txt) 2 0) hei 2 "ML"))
  (ssadd (entlast) ss)
  (setq lst (cons pt lst)))
 (close pr)
 (MakeSpline (reverse lst) 1)
 (ssadd (entlast) ss)
 (MakeLine (list (cadr (last lst)) 0) (list (caar lst) 0) 3)
 (ssadd (entlast) ss)
 (command "move" ss "" (list (cadr (last lst)) 0) pause)
 (command "undo" "e") (princ))
;----- String to List, EX: (HA:str->lst "1,2,3,4,5" ",") => (1 2 3 4 5)
(defun HA:str->lst ( str del / pos )
 (if (setq pos (vl-string-search del str))
  (cons (atof (substr str 1 pos)) (HA:str->lst (substr str (+ pos 1 (strlen del))) del)) 
  (list (atof str))))
(defun MakeSpline (lst col)
 (entmake (append (list '(0 . "SPLINE") '(100 . "AcDbEntity") (cons 62 col) '(100 . "AcDbSpline") (cons 71 3) (cons 74 (length lst))) (mapcar '(lambda (p) (cons 11 p)) lst))))
(defun MakeLine (p1 p2 col)
 (entmake (list (cons 0 "LINE") (cons 62 col) (cons 10 p1) (cons 11 p2))))
(defun MakeText (pt str hei col jus / lst)
 (setq lst (list '(0 . "TEXT") (cons 62 col) (cons 10 pt) (cons 40 hei) (cons 1 str) (cons 50 (/ pi 2))))
 (cond
  ((= jus "ML") (setq lst (append lst (list (cons 72 0) (cons 11 pt) (cons 73 2)))))
  ((= jus "MR") (setq lst (append lst (list (cons 72 2) (cons 11 pt) (cons 73 2))))))
 (entmake lst))
 

không còn gì tuyệt vời hơn!

cảm ơn bác nhiều nhiều !122241_ok_men.png


<<

Filename: 323792_ha3.lsp
Tác giả: mtrgnuce
Bài viết gốc: 339169
Tên lệnh: ha3
nhờ viết lisp vẽ đồ thị trên cad số liệu được lấy từ file excel

 

Tặng chủ topic cái này, mới viết xong. Hy vọng hài lòng.

;Doan Van Ha - CADViet.com - Ngay...
>>

 

Tặng chủ topic cái này, mới viết xong. Hy vọng hài lòng.

;Doan Van Ha - CADViet.com - Ngay 24/11/2014
;Muc dich: Ve Spline qua cac diem duoc ghi trong file txt (moi hang la 1 diem, X va Y cach nhau boi 1 ky tu tab; ve duong dong; ghi text cao do duong duoi am tren).
(defun C:HA3( / fn ss pr rl txt pt pd lst)
 (command "ucs" "w") (command "undo" "be")
 (setq fn (getfiled "Chon file de lay so lieu" "" "txt" 8))
 (or (and tlx (or (= (type tlx) 'int) (= (type tlx) 'real))) (setq tlx 200))
 (setq tlx (cond ((getreal (strcat "\nTi le theo phuong X <" (rtos tlx 2 0) ">: "))) (tlx)))
 (or (and tly (or (= (type tly) 'int) (= (type tly) 'real))) (setq tly 5000))
 (setq tly (cond ((getreal (strcat "\nTi le theo phuong Y <" (rtos tly 2 0) ">: "))) (tly)))
 (or (and hei (or (= (type hei) 'int) (= (type hei) 'real))) (setq hei 0.10))
 (setq hei (cond ((getreal (strcat "\nChieu cao chu <" (rtos hei 2 2) ">: "))) (hei)))
 (setq ss (ssadd))
 (setq pr (open fn "r"))
 (while (setq rl (read-line pr))
  (setq txt (HA:str->lst rl (chr 9)))
  (setq pt (list (/ (car txt) tlx) (/ (cadr txt) tly)))
  (setq pd (list (/ (car txt) tlx) 0))
  (MakeLine pd pt 5)
  (ssadd (entlast) ss)
  (if (>= (cadr txt) 0)
   (MakeText (polar pd (/ pi -2) hei) (rtos (cadr txt) 2 0) hei 2 "MR")
   (MakeText (polar pd (/ pi 2) hei) (rtos (cadr txt) 2 0) hei 2 "ML"))
  (ssadd (entlast) ss)
  (setq lst (cons pt lst)))
 (close pr)
 (MakeSpline (reverse lst) 1)
 (ssadd (entlast) ss)
 (MakeLine (list (cadr (last lst)) 0) (list (caar lst) 0) 3)
 (ssadd (entlast) ss)
 (command "move" ss "" (list (cadr (last lst)) 0) pause)
 (command "undo" "e") (princ))
;----- String to List, EX: (HA:str->lst "1,2,3,4,5" ",") => (1 2 3 4 5)
(defun HA:str->lst ( str del / pos )
 (if (setq pos (vl-string-search del str))
  (cons (atof (substr str 1 pos)) (HA:str->lst (substr str (+ pos 1 (strlen del))) del)) 
  (list (atof str))))
(defun MakeSpline (lst col)
 (entmake (append (list '(0 . "SPLINE") '(100 . "AcDbEntity") (cons 62 col) '(100 . "AcDbSpline") (cons 71 3) (cons 74 (length lst))) (mapcar '(lambda (p) (cons 11 p)) lst))))
(defun MakeLine (p1 p2 col)
 (entmake (list (cons 0 "LINE") (cons 62 col) (cons 10 p1) (cons 11 p2))))
(defun MakeText (pt str hei col jus / lst)
 (setq lst (list '(0 . "TEXT") (cons 62 col) (cons 10 pt) (cons 40 hei) (cons 1 str) (cons 50 (/ pi 2))))
 (cond
  ((= jus "ML") (setq lst (append lst (list (cons 72 0) (cons 11 pt) (cons 73 2)))))
  ((= jus "MR") (setq lst (append lst (list (cons 72 2) (cons 11 pt) (cons 73 2))))))
 (entmake lst))
 

 anh có thể chỉ giúp em các lệnh để vẽ được ko ạ. bị kém về cái khoản đọc ngôn ngữ lập trình :/


<<

Filename: 339169_ha3.lsp

Trang 221/330

221