Viết Lisp theo yêu cầu

Tháng 6 28, 2009

Lisp này Tue_NV đã viết rồi
Đường gấp khúc đó vẽ bằng lệnh Pline phải không bạn?

Nếu đường gấp khúc vẽ bằng Line thì bạn dùng lệnh PE để chuyển nó về Polyline

và sử dụng Code sau sẽ tính được chiều dài của nó theo ý của bạn

Bạn đọc bài viết này :

Bai viet so 2

Khi chay Lisp yêu cầu chon Pline

- Chon diem dau của duong pline

- Chon diem cuoi của duong pline

-> Lisp sẽ tính chiều dài đoạn gấp khúc từ điểm đầu đến điểm cuối cho bạn

Sử dụng Lisp này có thể đo một đoạn của Line, Pline, Arc, Circle, Spline, elipse

Chúc vui :cheers:

Chào bạn Tue_NV! Nhờ bạn sửa giúp mình đoạn lisp này với.

Khi gỏ GHC: hỏi

Chọn điểm thứ 1

Chọn điểm thứ 2

Tên cọc

OK. Cảm ơn bạn

(Bỏ qua câu lệnh hỏi đường kính đường tròn (chỉ cần định giá trị đường kính vòng tròn trước là được))

Lisp đây bạn:

(defun Init()

(setvar "BLIPMODE" 0)

(setvar "CMDECHO" 0)

)

(defun Reinit()

(setvar "BLIPMODE" 0)

(setvar "CMDECHO" 1)

)

;--------------------------------

;;Doi goc ra radian

(defun doi (a)

(* PI (/ a 180))

)

;--------------------------------

;;Doi goc ra radiando

(defun doi2 (d)

(* 180 (/ d pi))

)

;---------------------------------

;1 ENDP 2 MID 4 CEN 8 NODE 16 QUA 32 INT 64 INS 128 PER 256 TAN 512 NEA 1024 QUI

;;ONAP ENDP INT(MID) NEAR

(defun onap ()

(setvar "OSMODE" (+ 1 32 512))

)

;;;;ONAP ENDP INT(MID) CEN

(defun onap1 ()

(setvar "OSMODE" (+ 1 4 32))

)

;;;

;;;;ONAP ENDP INT(MID) CEN

(defun onap2 ()

(setvar "OSMODE" (+ 1 2 4 16 32 128 512))

)

;;;;;;

(defun ofnap ()

(command "-OSNAP" "OFF" "" )

)

;---------------------------------

;===========================

(defun C:GCH ()

(command

"-OSNAP" "OFF" ""

"layer" "m" "manh" "c" "252" "" "l" "continuous" "" ""

"layer" "m" "chuv" "c" "3" "" "l" "continuous" "" ""

"style" "chuv" "VNI-Helve" "" "1" "" "" "" ""

)

; (setq

; Pt1 (getpoint "\nChon diem dau tien :")

; x (car Pt1)

; y (cadr Pt1)

(setq AnserCK "Co")

; )

;------------------------------

(While (= AnserCK "Co")

(initget "Co Khong")

(setq AnserCK (getkword "\nCo tiep tuc khong :"))

(if (= AnserCK "Co")

(progn (onap)

(setq

Pt1 (getpoint "\nChon diem dau 1:")

x (car Pt1)

y (cadr Pt1)

)

(setq

Pt2 (getpoint Pt1 "\nChon diem thu 2:")

Dis (getdist "\nDuong kinh vong tron:")

Dis1 (/ Dis 2)

a (getstring "\nTen coc:")

) (ofnap)

(command

"layer" "s" "manh" ""

"line" Pt1 Pt2 ""

"circle" "2p" Pt2 (polar Pt2 (angle Pt1 Pt2) 7) ""

"layer" "s" "chuv" ""

"style" "chuv" "VNI-Helve" "" "1" "" "" "" ""

"text" "j" "mc" (polar Pt2 (angle Pt1 Pt2) 3.5) 3.0 0.0 (strcat a) ""

) (onap2)

)

(Reinit)

)

Tháng 6 28, 2009

Nhờ bác Tue_NV nâng cấp cái lisp tgtext này lên tí nha, lisp này mình mới thêm được ký tự cách vị trí đầu chứ chưa thêm được cách vị trí cuối. bạn thêm vào giúp nha. Thank!
Chúc mọi người cuối tuần vui vẽ!

Tue_NV đã viết bài trả lời cho Conghoan và cải tiến luôn đoạn Code bớt Text viết cho HoangSon ở đây :

http://www.cadviet.com/forum/index.php?sho...amp;#entry65704

Chào bạn Tue_NV! Nhờ bạn sửa giúp mình đoạn lisp này với.
Khi gỏ GHC: hỏi

Chọn điểm thứ 1

Chọn điểm thứ 2

Tên cọc

OK. Cảm ơn bạn

(Bỏ qua câu lệnh hỏi đường kính đường tròn (chỉ cần định giá trị đường kính vòng tròn trước là được))

Chào HoangSon

Chưa hiểu ý của bạn muốn nói gì?

Bạn viết gì thì phải cho người khác hiểu thì mới giúp bạn được

Hãy nói rõ ràng ra và cần thiết kèm theo file .dwg minh hoạ nếu có thể

Chúc vui :s_big:

Tháng 6 29, 2009

Trích dẫn(conghoan1003 @ Jun 28 2009, 12:14) *

Nhờ bác Tue_NV nâng cấp cái lisp tgtext này lên tí nha, lisp này mình mới thêm được ký tự cách vị trí đầu chứ chưa thêm được cách vị trí cuối.

Mình kiếm được trên diễn dàn ( nếu kô lầm thì cái lisp này của Bác Duy782006) cái lisp này, không biết có đúng theo yêu cầu của bạn kô nhưng nó có thề cho minh thêm chuỗi ký tự vào đầu và cuối những đối tượng text đuợc chọn. Tên lệnh là :themtext

;Dung de them chuoi ky tu vao Truoc_Sau chuoi ky tu duoc chon
(defun c:THEMTEXT (/ c e ss txt cmde ttdangs ttdangt)
 (command "undo" "be")
 (setq cmde (getvar "CMDECHO"))
 (setvar "CMDECHO" 0)
 (setq ttdangt (getstring 5"\nChuoi muon them phia truoc:")) 
 (setq ttdangs (getstring 5"\nChuoi muon them phia sau:")) 
 (if (null ttdangt)(setq ttdangt ""))
 (if (null ttdangs)(setq ttdangs ""))
(prompt "\nChon chu muon chinh.")
 (setq ss (ssget))
 (setq c 0)
 (if ss (setq e (ssname ss c)))
 (while e
   (setq e (entget e))
   ; Ensure entity is text
   (if (= (cdr (assoc 0 e)) "TEXT")
       (progn
                (setq txt (strcat ttdangt (cdr (assoc 1 e)) ttdangs))
          (setq e (subst (cons 1 txt) (assoc 1 e) e))
          (entmod e)
       )
   )
   (setq c (1+ c)) ; Increment counter.
   (setq e (ssname ss c))  ; Obtain next entity.
  )
  (setvar "CMDECHO" cmde)
  (command "undo" "end")
     (Prin I)
)
(defun c:BOTTEXT (/ c e ss txt cmde tbdangs tbdangt)
 (command "undo" "be")
 (setq cmde (getvar "CMDECHO"))
 (setvar "CMDECHO" 0)
 (setq tbdangt (getreal "\nSo ky tu muon bot phia truoc:")) 
 (setq tbdangs (getreal "\nSo ky tu muon bot phia sau:")) 
 (if (null tbdangt)(setq tbdangt 0))
 (if (null tbdangs)(setq tbdangs 0))
 (setq sotru (+ tbdangt tbdangs))
(prompt "\nChon chu muon chinh.")
 (setq ss (ssget))
 (setq c 0)
 (if ss (setq e (ssname ss c)))
 (while e
   (setq e (entget e))
   ; Ensure entity is text
   (if (= (cdr (assoc 0 e)) "TEXT")
       (progn
(setq sochu (strlen (cdr (assoc 1 e))))
(if (> sochu sotru)
(progn
(setq txt (substr (cdr (assoc 1 e)) (fix (+ 1 tbdangt)) (fix (- sochu tbdangt tbdangs))))
          (setq e (subst (cons 1 txt) (assoc 1 e) e))
          (entmod e)
)
)
       )
   )
   (setq c (1+ c)) ; Increment counter.
   (setq e (ssname ss c))  ; Obtain next entity.
  )
  (setvar "CMDECHO" cmde)
  (command "undo" "end")
     (Prin I)
)

:s_big:

Tháng 6 29, 2009

Trích dẫn(conghoan1003 @ Jun 28 2009, 12:14) *
Nhờ bác Tue_NV nâng cấp cái lisp tgtext này lên tí nha, lisp này mình mới thêm được ký tự cách vị trí đầu chứ chưa thêm được cách vị trí cuối.

Tue_NV thật sự không vui khi mình viết bài ra mà bạn chẳng hề chịu đọc :s_big:

Bài viết trả lời của mình ngay trên bài viết của bạn đấy thôi

Nhờ bác Tue_NV nâng cấp cái lisp tgtext này lên tí nha, lisp này mình mới thêm được ký tự cách vị trí đầu chứ chưa thêm được cách vị trí cuối. bạn thêm vào giúp nha. Thank!
Chúc mọi người cuối tuần vui vẽ!

Tue_NV đã viết bài trả lời cho Conghoan và cải tiến luôn đoạn Code bớt Text viết cho HoangSon ở đây :

http://www.cadviet.com/forum/index.php?sho...amp;#entry65704

Tháng 6 29, 2009

Tue_NV đã viết bài trả lời cho Conghoan và cải tiến luôn đoạn Code bớt Text viết cho HoangSon ở đây :
http://www.cadviet.com/forum/index.php?sho...amp;#entry65704

Chào HoangSon

Chưa hiểu ý của bạn muốn nói gì?

Bạn viết gì thì phải cho người khác hiểu thì mới giúp bạn được

Hãy nói rõ ràng ra và cần thiết kèm theo file .dwg minh hoạ nếu có thể

Chúc vui :cheers:

Chào Tue_NV!

Với đoạn lisp mình gửi trên, mình nhờ bạn sửa lại giúp mình như sau:

Gỏ GCH (Ghi chú cọc)

Mình đã gán giá trị đường kính vòng tròn là 7 nhưng khi chạy lisp cứ hỏi nhập giá trị đường kính, ý mình là khi nhập điểm thứ 1, thứ 2 và tên cọc thì có được text nằm giữa vòng tròn (mình không rành lisp lắm, đoạn lisp trên lỗi chỗ nào? nhờ bạn text và sửa giúp mình). Cảm ơn bạn.

Tháng 6 29, 2009

Chào Tue_NV!
Với đoạn lisp mình gửi trên, mình nhờ bạn sửa lại giúp mình như sau:

Gỏ GCH (Ghi chú cọc)

Mình đã gán giá trị đường kính vòng tròn là 7 nhưng khi chạy lisp cứ hỏi nhập giá trị đường kính, ý mình là khi nhập điểm thứ 1, thứ 2 và tên cọc thì có được text nằm giữa vòng tròn (mình không rành lisp lắm, đoạn lisp trên lỗi chỗ nào? nhờ bạn text và sửa giúp mình). Cảm ơn bạn.

Đã sửa lại. HoangSon thử nhé :

(defun Init()
(setvar "BLIPMODE" 0)
(setvar "CMDECHO" 0)
)
;
(defun Reinit()
(setvar "BLIPMODE" 0)
(setvar "CMDECHO" 1)
)
;--------------------------------
;;Doi goc ra radian
(defun doi (a)
(* PI (/ a 180))
)
;--------------------------------
;;Doi goc ra radiando
(defun doi2 (d)
(* 180 (/ d pi))
)
;---------------------------------
;1 ENDP 2 MID 4 CEN 8 NODE 16 QUA 32 INT 64 INS 128 PER 256 TAN 512 NEA 1024 QUI
;;ONAP ENDP INT(MID) NEAR
(defun onap () 
(setvar "OSMODE" (+ 1 32 512))
)
;;;;ONAP ENDP INT(MID) CEN
(defun onap1 ()
(setvar "OSMODE" (+ 1 4 32))
)
;;;
;;;;ONAP ENDP INT(MID) CEN
(defun onap2 () 
(setvar "OSMODE" (+ 1 2 4 16 32 128 512))
)
;;;;;;
(defun ofnap ()
(command "-OSNAP" "OFF" "" )
)
;---------------------------------

;===========================
(defun C:GCH()
(setvar "cmdecho" 0)
(command 
"-OSNAP" "OFF" ""
"layer" "m" "manh" "c" "252" "" "l" "continuous" "" ""
"layer" "m" "chuv" "c" "3" "" "l" "continuous" "" ""
"style" "chuv" "VNI-Helve" "" "1" "" "" "" ""
)

(setq
Pt1 (getpoint "\nChon diem dau 1:")
x (car Pt1)
y (cadr Pt1) 
)
(setq 
Pt2 (getpoint Pt1 "\nChon diem thu 2:")
Dis 7
Dis1 (/ Dis 2)
a (getstring "\nTen coc:")
) (ofnap) 
(command
"layer" "s" "manh" ""
"line" Pt1 Pt2 ""
"circle" "2p" Pt2 (polar Pt2 (angle Pt1 Pt2) 7) ""
"layer" "s" "chuv" ""
"style" "chuv" "VNI-Helve" "" "1" "" "" "" ""
"text" "j" "mc" (polar Pt2 (angle Pt1 Pt2) 3.5) 3.0 0.0 (strcat a) ""
) (onap2)


(setq AnserCK "C")

(While (or (= AnserCK "C") (= AnserCK "c"))
(initget "C K")
(setq AnserCK (getkword "\nCo tiep tuc khong  ?:"))
(if (or (= AnserCK "C") (= AnserCK "c"))
(progn (onap)
(setq
Pt1 (getpoint "\nChon diem dau 1:")
x (car Pt1)
y (cadr Pt1) 
)
(setq 
Pt2 (getpoint Pt1 "\nChon diem thu 2:")
Dis 7
Dis1 (/ Dis 2)
a (getstring "\nTen coc:")
) (ofnap) 
(command
"layer" "s" "manh" ""
"line" Pt1 Pt2 ""
"circle" "2p" Pt2 (polar Pt2 (angle Pt1 Pt2) 7) ""
"layer" "s" "chuv" ""
"style" "chuv" "VNI-Helve" "" "1" "" "" "" ""
"text" "j" "mc" (polar Pt2 (angle Pt1 Pt2) 3.5) 3.0 0.0 (strcat a) ""
) (onap2)
)
)
)

(Reinit)
(princ)
)

Tháng 6 29, 2009

Tue_NV thật sự không vui khi mình viết bài ra mà bạn chẳng hề chịu đọc :s_big:
Bài viết trả lời của mình ngay trên bài viết của bạn đấy thôi

Tue_NV đã viết bài trả lời cho Conghoan và cải tiến luôn đoạn Code bớt Text viết cho HoangSon ở đây :

http://www.cadviet.com/forum/index.php?sho...amp;#entry65704

Xin lỗi Tue_LV nha,

Không phai mình không chịu đọc mà tại hôm post bài mạng báo lỗi mình tưởng là chưa post được nên mới mần lại cái nữa ở chổ này thành ra viết bài hai chỗ luôn!

Cảm ơn Tue nha. lisp chạy tốt lắm!

Tháng 6 29, 2009

Đã sửa lại. HoangSon thử nhé :

(defun Init()
(setvar "BLIPMODE" 0)
(setvar "CMDECHO" 0)
)
;
(defun Reinit()
(setvar "BLIPMODE" 0)
(setvar "CMDECHO" 1)
)
;--------------------------------
;;Doi goc ra radian
(defun doi (a)
(* PI (/ a 180))
)
;--------------------------------
;;Doi goc ra radiando
(defun doi2 (d)
(* 180 (/ d pi))
)
;---------------------------------
;1 ENDP 2 MID 4 CEN 8 NODE 16 QUA 32 INT 64 INS 128 PER 256 TAN 512 NEA 1024 QUI
;;ONAP ENDP INT(MID) NEAR
(defun onap () 
(setvar "OSMODE" (+ 1 32 512))
)
;;;;ONAP ENDP INT(MID) CEN
(defun onap1 ()
(setvar "OSMODE" (+ 1 4 32))
)
;;;
;;;;ONAP ENDP INT(MID) CEN
(defun onap2 () 
(setvar "OSMODE" (+ 1 2 4 16 32 128 512))
)
;;;;;;
(defun ofnap ()
(command "-OSNAP" "OFF" "" )
)
;---------------------------------

;===========================
(defun C:GCH()
(setvar "cmdecho" 0)
(command 
"-OSNAP" "OFF" ""
"layer" "m" "manh" "c" "252" "" "l" "continuous" "" ""
"layer" "m" "chuv" "c" "3" "" "l" "continuous" "" ""
"style" "chuv" "VNI-Helve" "" "1" "" "" "" ""
)

(setq
Pt1 (getpoint "\nChon diem dau 1:")
x (car Pt1)
y (cadr Pt1) 
)
(setq 
Pt2 (getpoint Pt1 "\nChon diem thu 2:")
Dis 7
Dis1 (/ Dis 2)
a (getstring "\nTen coc:")
) (ofnap) 
(command
"layer" "s" "manh" ""
"line" Pt1 Pt2 ""
"circle" "2p" Pt2 (polar Pt2 (angle Pt1 Pt2) 7) ""
"layer" "s" "chuv" ""
"style" "chuv" "VNI-Helve" "" "1" "" "" "" ""
"text" "j" "mc" (polar Pt2 (angle Pt1 Pt2) 3.5) 3.0 0.0 (strcat a) ""
) (onap2)
(setq AnserCK "C")

(While (or (= AnserCK "C") (= AnserCK "c"))
(initget "C K")
(setq AnserCK (getkword "\nCo tiep tuc khong  ?:"))
(if (or (= AnserCK "C") (= AnserCK "c"))
(progn (onap)
(setq
Pt1 (getpoint "\nChon diem dau 1:")
x (car Pt1)
y (cadr Pt1) 
)
(setq 
Pt2 (getpoint Pt1 "\nChon diem thu 2:")
Dis 7
Dis1 (/ Dis 2)
a (getstring "\nTen coc:")
) (ofnap) 
(command
"layer" "s" "manh" ""
"line" Pt1 Pt2 ""
"circle" "2p" Pt2 (polar Pt2 (angle Pt1 Pt2) 7) ""
"layer" "s" "chuv" ""
"style" "chuv" "VNI-Helve" "" "1" "" "" "" ""
"text" "j" "mc" (polar Pt2 (angle Pt1 Pt2) 3.5) 3.0 0.0 (strcat a) ""
) (onap2)
)
)
)

(Reinit)
(princ)
)

Chạy tốt rồi, cảm ơn bạn nhiều.....

Tháng 7 1, 2009

Vừa rồi mình có tìm được lisp vẽ tim sông và tim đường trên diễn đàn của mình , lisp chạy rất nhanh và chính xác.

Nhưng gặp trường hợp tại nhánh sông nhỏ ra sông lớn ( chổ ngã ba ) thì lisp thể hiện chưa đúng lắm.

Vậy rất mong được các bạn giúp khắc phục cho lởi trên

Tháng 7 1, 2009

Vừa rồi mình có tìm được lisp vẽ tim sông và tim đường trên diễn đàn của mình , lisp chạy rất nhanh và chính xác.
Nhưng gặp trường hợp tại nhánh sông nhỏ ra sông lớn ( chổ ngã ba ) thì lisp thể hiện chưa đúng lắm.

Vậy rất mong được các bạn giúp khắc phục cho lởi trên

Hiện giờ chưa có giải pháp khắc phục, Bạn phải cắt bỏ bờ của nhánh sông nhỏ và tạm thời nối lại bờ sông lớn.

Lúc này thiep không rảnh để chỉnh sửa lisp TIMDUONG cho bạn.

Tháng 7 1, 2009

"Một đoạn lisp nhỏ, chưa lời đáp

Cho đến bây giờ mặt vẫn chau"

(cảm ơn Haanh đã nhắc lại bài thơ "Các vị La Hán chùa Tây Phương" của Huy Cận trên diễn đàn)

Đó là cái lisp tạo hatch này. Tạo 1 hatch kiểu solid, hình tròn, bán kính và điểm pick tâm hình tròn do user chọn:

(defun c:NUT (/ R poNUT Xnut Ynut Q1 Q2 Lhatch)
 (setvar "cmdecho" 0)
 (setq R (getreal "\nBan kinh nut: ")
poNUT (getpoint "\nDiem chen nut: ")
 )
 (setq Xnut (car poNUT)
Ynut (cadr poNUT))
 (setq Q1 (cons 10 (list Xnut (+ Ynut R) 0.0))
Q2 (cons 10 (list Xnut (- Ynut R) 0.0)))
 (setq Lhatch (list (cons 0 "HATCH")
	     '(100 . "AcDbEntity")
	     (cons 8 "0")
	     '(100 . "AcDbHatch")
	     (cons 10 (list 0.0 0.0 0.0))
	     (cons 210 (list 0.0 0.0 1.0))
	     (cons 2 "solid")
	     (cons 70 1)
	     (cons 71 0)
	     (cons 91 1)
	     (cons 92 1)
	     (cons 73 1)
	     (cons 93 1)
	     (cons 40 R)	;bankinh
	     Q1
	     (cons 72 2)
	     (cons 42 1.0)
	     Q2
	     (cons 42 1.0)
	     (cons 98 1)
	     (cons 75 0)
	     (cons 76 1)
	     (cons 210 (list 0.0 0.0 1.0))
	     (cons 470 "LINEAR") ;
       )
 )
 (entmake Lhatch)
 (princ)
)

Lisp không báo lỗi, nhưng lại không tạo hatch trên màn hình, thiep không hiểu lỗi gì, mong các anh em Cadviet chỉnh sửa giúp.

Trân trọng.

Tháng 7 1, 2009

"Một đoạn lisp nhỏ, chưa lời đáp
Cho đến bây giờ mặt vẫn chau"

(cảm ơn Haanh đã nhắc lại bài thơ "Các vị La Hán chùa Tây Phương" của Huy Cận trên diễn đàn)

Đó là cái lisp tạo hatch này. Tạo 1 hatch kiểu solid, hình tròn, bán kính và điểm pick tâm hình tròn do user chọn:
(defun c:NUT (/ R poNUT Xnut Ynut Q1 Q2 Lhatch)
 (setvar "cmdecho" 0)
 (setq R (getreal "\nBan kinh nut: ")
poNUT (getpoint "\nDiem chen nut: ")
 )
 (setq Xnut (car poNUT)
Ynut (cadr poNUT))
 (setq Q1 (cons 10 (list Xnut (+ Ynut R) 0.0))
Q2 (cons 10 (list Xnut (- Ynut R) 0.0)))
 (setq Lhatch (list (cons 0 "HATCH")
	     '(100 . "AcDbEntity")
	     (cons 8 "0")
	     '(100 . "AcDbHatch")
	     (cons 10 (list 0.0 0.0 0.0))
	     (cons 210 (list 0.0 0.0 1.0))
	     (cons 2 "solid")
	     (cons 70 1)
	     (cons 71 0)
	     (cons 91 1)
	     (cons 92 1)
	     (cons 73 1)
	     (cons 93 1)
	     (cons 40 R)	;bankinh
	     Q1
	     (cons 72 2)
	     (cons 42 1.0)
	     Q2
	     (cons 42 1.0)
	     (cons 98 1)
	     (cons 75 0)
	     (cons 76 1)
	     (cons 210 (list 0.0 0.0 1.0))
	     (cons 470 "LINEAR") ;
       )
 )
 (entmake Lhatch)
 (princ)
)
Lisp không báo lỗi, nhưng lại không tạo hatch trên màn hình, thiep không hiểu lỗi gì, mong các anh em Cadviet chỉnh sửa giúp.

Trân trọng.

Tạo hatch bằng entmake thì đúng là đụng vô ổ kiến lửa rùi. Hatch có rất nhiều code mà nhiều cái mình ko thể hiểu nó là cái gì, ngoài 2 điểm q1 q2 nó còn có 1 điểm nữa (code 10) mà toạ độ chẳng ăn nhập gì với 2 cái q1 q2 thì làm sao mình biết mà tính được.

Sao bạn ko chọn cách tạo hatch nào đon giản hơn?

Tháng 7 2, 2009

Chào bạn Tue_NV!

Mình làm phiền bạn lần nữa nha, muốn bạn viết dùm mình 1lisp (Copy text tăng dần) như sau:

Khởi động, lisp hỏi chọn đối tượng >> bấm chọn >> OK (Cụ thể như: 01/5 -> 02/5 .....05/5)

(Mình đã có lisp copy text tăng dần rồi nhưng sử dụng vào trường hợp này không được (VD: 01/5 -> 01/6, 01/7). Cố gắng giúp mình nha. Cảm ơn bạn

Tháng 7 2, 2009

Mình làm phiền bạn lần nữa nha, muốn bạn viết dùm mình 1lisp (Copy text tăng dần) như sau:
Khởi động, lisp hỏi chọn đối tượng >> bấm chọn >> OK (Cụ thể như: 01/5 -> 02/5 .....05/5)

(Mình đã có lisp copy text tăng dần rồi nhưng sử dụng vào trường hợp này không được (VD: 01/5 -> 01/6, 01/7). Cố gắng giúp mình nha. Cảm ơn bạn

Lisp này Tue_NV đã viết rồi. HoangSon đọc bài viết này nhé :

Bài viết số 45 - Đánh số thứ tự tăng dần

Nhưng có khác 1 chút với yêu cầu của bạn nhưng tựu trung lại nó cùng 1 mục đích .

Danh so thu tu dang n/m

Khi chạy Lisp hỏi :

Danh so bat dau (n)

Danh so tong (m)

-> Bạn chọn điểm chèn Text-> Lisp sẽ đánh số thứ tự dạng n/m theo ý của bạn

Chúc vui :s_big:

Tháng 7 2, 2009

Lisp này Tue_NV đã viết rồi. HoangSon đọc bài viết này nhé :
Bài viết số 45 - Đánh số thứ tự tăng dần

Nhưng có khác 1 chút với yêu cầu của bạn nhưng tựu trung lại nó cùng 1 mục đích .

Danh so thu tu dang n/m

Khi chạy Lisp hỏi :

Danh so bat dau (n)

Danh so tong (m)

-> Bạn chọn điểm chèn Text-> Lisp sẽ đánh số thứ tự dạng n/m theo ý của bạn

Chúc vui :cheers:

Cảm ơn bạn nhiều, nhưng mình muốn trước số 1 là con số 0 có được không bạn (cụ thể: 01/2, 02/2)

Nếu được bạn chỉnh lại giúp mình. Thank....bạn

Tháng 7 2, 2009

Mình hiện đang dùng phần mềm Landesktop đề làm việc. Mình tìm được một Lisp trên diễn đàn hỗ trợ mình rất tốt khi vẽ mặt cắt, cũng không nhớ của bạn nào viết nữa. Hôm nay mình đưa lên nhờ mọi người giúp mình thêm cho lisp một tính năng nữa là lisp chạy thêm được một hàng khoảng cách lẻ bên dưới cột cao độ. Nếu được mình sẽ rất cảm ơn. Đây là đoạn lisp mình đang sử dụng:

(defun c:SCD()

(vl-load-com)

(command "undo" "be")

(setq oldos (getvar "osmode"))

(setvar "osmode" 0)

(setq olddim (getvar "dimzin"))

(setvar "dimzin" 0)

(setq mss (car(entsel "\n Chon mat so sanh :")))

(HLI mss)

(setq gtmss (getreal "\n Nhap gia tri mat so sanh :"))

(setq PL (car (entsel "\n Chon Pline :")))

(HLI PL)

(setq pr (vlax-curve-getEndParam PL) i 0)

(setq cao (getreal "\n Chon chieu cao chu :"))

(setq tp (getint "\n So chu so thap phan :"))

(while (<= i pr)

(setq po (vlax-curve-getPointAtParam PL i))

(setq po2 (vlax-curve-getClosestPointTo mss po))

(setq pot (list (car po2) (- (cadr po2) (/ cao 2)) 0))

(setq kc (+ (distance po po2) gtmss))

(Command "line" po po2 "")

(Command "style" "CADVIET" "TIMES.TTF" "0" "1" "0" "N" "N")

(Command "Text" "j" "BR" pot cao "90" (rtos kc 2 tp))

(HLI PL)

(setq i (1+ i))

)

(setvar "dimzin" olddim)

(setvar "osmode" oldos)

(command "undo" "end")

(Princ)

)

;

(defun HLI(enT)

(sssetfirst (ssadd enT (ssadd)) (ssadd enT (ssadd)))

)

Tháng 7 2, 2009

Mình hiện đang dùng phần mềm Landesktop đề làm việc. Mình tìm được một Lisp trên diễn đàn hỗ trợ mình rất tốt khi vẽ mặt cắt, cũng không nhớ của bạn nào viết nữa. Hôm nay mình đưa lên nhờ mọi người giúp mình thêm cho lisp một tính năng nữa là lisp chạy thêm được một hàng khoảng cách lẻ bên dưới cột cao độ. Nếu được mình sẽ rất cảm ơn. Đây là đoạn lisp mình đang sử dụng:

Chào bạn dienlicogi17

Lisp này của chính Tue_NV viết cho bạn Thuyvan. Nó nằm ngay trong chính topic này

Tue_NV không phải là dân cầu đường nên mình chỉ am hiểu một phần nào đó trong chuyên ngành của bạn thôi. Vậy nên bạn muốn nhờ Tue_NV chỉnh sửa lại Code này thì bạn phải nói rõ và mình nghĩ bạn nên post file .dwg nói rõ điều bạn muốn

Bởi lẽ không phải ai cũng hiểu như bạn. Viết Lisp ra không đúng ý bạn thì mất thời gian lắm.

@HoangSon: Bạn nên rút kinh nghiệm là nói cho đầy đủ ý.

Ví dụ nhé : bản vẽ 01/9 . Số 1 thêm số 0 đằng trước thành 01. còn số 9 có thêm 0 đằng trước hay không?

Viết ra rồi ừ thì tôi muốn thêm số 0 đằng trước số 9 nữa thì mất công lắm.

Bạn nên suy nghĩ cho thật kĩ, có cái nhìn tổng quát trước khi viết bài

Nếu bạn muốn thêm số 0 đằng trước số 1 hay muốn thêm số 0 đằng trước số 9 thì sử dụng Lisp tgtext của Tue_NV. Nó sẽ thêm kí tự do user nhập vào cách vị trí đầu hay vị trí cuối bao nhiêu kí tự

Còn nếu bạn muốn thì Tue_NV sẽ thêm vào Code cho bạn

;; copyright by Tue_NV
(defun c:dstt(/ dau tong po po1 ent i)
(prompt "\n Danh so thu tu dang n/m ")
(setvar "cmdecho" 0)

(setq dau (getint "\n Danh so bat dau (n) :"))
(setq tong (getint "\n Danh so tong (m) :") i 1)

(setq po (getpoint 
(strcat "\n Cho diem chen cua so : " (if ((wtxt (strcat (if (
(Repeat (- tong dau)
(setq po1 (getpoint po 
(strcat "\n Cho diem chen cua so : " (if (
(command "copy" "L" "" po po1) 
(setq ent (entget(entlast)))
(setq ent 
(subst 
(cons 1 (strcat (if ((entmod ent)
(setq i (1+ i))
(setq po po1)
)
(princ)
)
;
(defun wtxt (txt p / sty d h)
(setq sty (getvar "textstyle")
d (tblsearch "style" sty)
h (cdr (assoc 40 d)))
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 11 p) 
(cons 72 1) (cons 73 2)
(if (> h 0) (cons 40 h) (assoc 40 d)) (assoc 41 d))
)
)

:s_big:

Tháng 7 2, 2009

@HoangSon: Bạn nên rút kinh nghiệm là nói cho đầy đủ ý.
Ví dụ nhé : bản vẽ 01/9 . Số 1 thêm số 0 đằng trước thành 01. còn số 9 có thêm 0 đằng trước hay không?

Viết ra rồi ừ thì tôi muốn thêm số 0 đằng trước số 9 nữa thì mất công lắm.

Bạn nên suy nghĩ cho thật kĩ, có cái nhìn tổng quát trước khi viết bài

Nếu bạn muốn thêm số 0 đằng trước số 1 hay muốn thêm số 0 đằng trước số 9 thì sử dụng Lisp tgtext của Tue_NV. Nó sẽ thêm kí tự do user nhập vào cách vị trí đầu hay vị trí cuối bao nhiêu kí tự

Còn nếu bạn muốn thì Tue_NV sẽ thêm vào Code cho bạn
;; copyright by Tue_NV
(defun c:dstt(/ dau tong po po1 ent i)
(prompt "\n Danh so thu tu dang n/m ")
(setvar "cmdecho" 0)

(setq dau (getint "\n Danh so bat dau (n) :"))
(setq tong (getint "\n Danh so tong (m) :") i 1)

(setq po (getpoint 
(strcat "\n Cho diem chen cua so : " (if (< dau 10) (strcat "0" (itoa dau)) (itoa dau)) "/" (itoa tong))))
(wtxt (strcat (if (< dau 10) (strcat "0" (itoa dau)) (itoa dau)) "/" (itoa tong)) po)

(Repeat (- tong dau)
(setq po1 (getpoint po 
(strcat "\n Cho diem chen cua so : " (if (< (+ dau i) 10) (strcat "0" (itoa (+ dau i))) (itoa (+ dau i))) "/" (itoa tong))))

(command "copy" "L" "" po po1) 
(setq ent (entget(entlast)))
(setq ent 
(subst 
(cons 1 (strcat (if (< (+ dau i) 10) (strcat "0" (itoa (+ dau i))) (itoa (+ dau i))) "/" (itoa tong))) (assoc 1 ent) ent))
(entmod ent)
(setq i (1+ i))
(setq po po1)
)
(princ)
)
;
(defun wtxt (txt p / sty d h)
(setq sty (getvar "textstyle")
d (tblsearch "style" sty)
h (cdr (assoc 40 d)))
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 11 p) 
(cons 72 1) (cons 73 2)
(if (> h 0) (cons 40 h) (assoc 40 d)) (assoc 41 d))
)
)
:cheers:

Cảm ơn Tue_NV nhiều...lắm. Nhắc nhở của bạn mình sẽ rút kinh nghiệm (nhưng ngày từ đầu và bài thứ 2 mình đã nêu cụ thể rồi mà). Thanhk bạn lần nữa.

Tháng 7 3, 2009

Lisp này của chính Tue_NV viết cho bạn Thuyvan. Nó nằm ngay trong chính topic này
Tue_NV không phải là dân cầu đường nên mình chỉ am hiểu một phần nào đó trong chuyên ngành của bạn thôi. Vậy nên bạn muốn nhờ Tue_NV chỉnh sửa lại Code này thì bạn phải nói rõ và mình nghĩ bạn nên post file .dwg nói rõ điều bạn muốn

Bởi lẽ không phải ai cũng hiểu như bạn. Viết Lisp ra không đúng ý bạn thì mất thời gian lắm.

Mình thử đổi sang font vntimeh.shx thì nó báo lỗi, bác Tue_NV giải thích giùm mình nhé, mình đang mò về lisp nên không rành lắm. :s_big:

Command: scd

undo Current settings: Auto = On, Control = All, Combine = Yes

Enter the number of operations to undo or [Auto/Control/BEgin/End/Mark/Back]

<1>: be

Command:

Chon mat so sanh :

Nhap gia tri mat so sanh :6

Chon Pline :

Chon chieu cao chu :0.15

So chu so thap phan :2

line Specify first point:

Specify next point or [undo]:

Command: style Enter name of text style or [?] : CADVIET

Existing style.

Specify full font name or font filename (TTF or SHX) : vntimeh.shx

Specify height of text <0.00000000>: 0 Specify width factor <1.00000000>: 1

Specify obliquing angle <0>: 0 Display text backwards? [Yes/No] : N Display

text upside-down? [Yes/No] : N Vertical? Text

Yes or No, please.

; error: Function cancelled

Vertical?

"CADVIET" is now the current text style.

PS: Mình có ý kiến thế này.

1/ Khi lisp chạy thì bị mất truy bắt điểm.

2/ Nhờ bác sửa giúp các thông số đầu vào tự động lưu lại cho các lần sau, và chỉ việc enter nếu không cần thiết phải thay đổi các thông số đó. :blink:

Tháng 7 3, 2009

PS: Mình có ý kiến thế này.
1/ Khi lisp chạy thì bị mất truy bắt điểm.

2/ Nhờ bác sửa giúp các thông số đầu vào tự động lưu lại cho các lần sau, và chỉ việc enter nếu không cần thiết phải thay đổi các thông số đó. :s_big:

Tue_NV đang đợi ý và yêu cầu của bạn dienlicogi17 rồi cải thiện đoạn Code 1 lần luôn.

Tháng 7 3, 2009

Chào bạn dienlicogi17

Lisp này của chính Tue_NV viết cho bạn Thuyvan. Nó nằm ngay trong chính topic này

Tue_NV không phải là dân cầu đường nên mình chỉ am hiểu một phần nào đó trong chuyên ngành của bạn thôi. Vậy nên bạn muốn nhờ Tue_NV chỉnh sửa lại Code này thì bạn phải nói rõ và mình nghĩ bạn nên post file .dwg nói rõ điều bạn muốn

Bởi lẽ không phải ai cũng hiểu như bạn. Viết Lisp ra không đúng ý bạn thì mất thời gian lắm.

Cám ơn bạn đã nhắc nhở mình. Đay là bãn vẽ của minh:

http://www.cadviet.com/upfiles/file_mau_2.dwg

Cám ơn cậu đã nhiệt tình giúp đỡ. Thanh kiu nhé! :s_big:

Tháng 7 3, 2009

Cám ơn bạn đã nhắc nhở mình. Đay là bãn vẽ của minh:
http://www.cadviet.com/upfiles/file_mau_2.dwg

....

Chào dienlicogi và xuantran

Đoạn Code sau Tue_NV đã cải thiện theo ý của dienlicogi và xuantran

Các bạn dùng thử và cho ý kiến :

(defun c:SCD(/ oldos olddim sty d h mss gtmss PL pr tp po po2 pot LA1 po3 po4 po5 kc kcle pott)
;copyright by Tue_NV
(vl-load-com)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)

(setq olddim (getvar "dimzin"))

(setvar "dimzin" 0)

 (setq sty (getvar "textstyle")
d (tblsearch "style" sty))

(if (= (cdr (assoc 40 d)) 0)
 (setq h (cdr (assoc 42 d)))
(setq h (cdr (assoc 40 d)))
 )

(setq mss (car(entsel "\n Chon mat so sanh :")))
(HLI mss)
(setq gtmss (getreal "\n Nhap gia tri mat so sanh :"))

(setq PL (car (entsel "\n Chon Pline :")))
(HLI PL)

(setq pr (vlax-curve-getEndParam PL) i 1)


(setq tp (getint "\n So chu so thap phan :"))


(setq po (vlax-curve-getPointAtParam PL 0))

(setq po2 (vlax-curve-getClosestPointTo mss po))


(setq pot (list (car po2) (- (cadr po2) (/ h 2)) 0))

 (command "offset" (* h 7) mss pot "")
(setq LA1 (entlast))
 (setq po4 (vlax-curve-getClosestPointTo LA1 po2))
 (setq po5 (list (car po4) (- (cadr po4) (* h 7)) 0))

 (command "offset" (* h 14) mss pot "")


(setq kc (+ (distance po po2) gtmss))

(Command "line" po po2 "")
 (Command "line" po4 po5 "")

(wtxt (rtos kc 2 tp) pot (/ pi 2))

(while (
(setq po (vlax-curve-getPointAtParam PL i))

(setq po3 (vlax-curve-getClosestPointTo mss po))
(setq po4 (vlax-curve-getClosestPointTo LA1 po3))
 (setq po5 (list (car po4) (- (cadr po4) (* h 7)) 0))

(setq kc (+ (distance po po3) gtmss))
 (setq kcle (distance po2 po3))

 (setq pot (list (car po3) (- (cadr po3) (/ h 2)) 0))
 (setq pott (list (- (car po3) (/ kcle 2)) (- (cadr po3) (* (/ h 2) 14)) 0))

(Command "line" po po3 "")
 (Command "line" po4 po5 "")
(wtxt (rtos kc 2 tp) pot (/ pi 2))
 (wtxt (rtos kcle 2 tp) pott (/ pi 2))
(setq po2 po3)
(setq i (1+ i))

)

(setvar "dimzin" olddim)
(setvar "osmode" oldos)
(command "undo" "end")
(Princ)
)

;
(defun HLI(enT)
(sssetfirst (ssadd enT (ssadd)) (ssadd enT (ssadd)))
)
;
(defun wtxt (txt p ang / sty d h)
(setq sty (getvar "textstyle")
d (tblsearch "style" sty)
h (cdr (assoc 40 d)))
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 11 p) 
(cons 72 2) (cons 73 2) (cons 50 ang)
(if (> h 0) (cons 40 h) (assoc 40 d)) (assoc 41 d))
)
)

:s_big:

Tick Thanksss thay lời nói cảm ơn :blink: :blink: :blink: :cry: :)

Tháng 7 3, 2009

Đã có lỗi xảy ra nên chua kiểm tra được bác Tue-NV ạ.

Command: scd

Chon mat so sanh :

Nhap gia tri mat so sanh :6

Chon Pline :

So chu so thap phan :2

Point or option keyword required.

; error: Function cancelled

Specify point on side to offset or [Exit/Multiple/Undo] :

Command:

Command: *Cancel*

Các truy bắt điểm vẫn bị mất, bác xem lại giúp nhé. :s_big:

Tháng 7 3, 2009

:cheers:Cám ơn Tue, Mình đã chạy thử và được rồi. Nhưng cậu giúp mình vẫn để lại chế độ chọn chiều cao chữ nhé. Còn Text thì cậu lấy theo style hiện hành phải không? Còn text cậu cố giúp mình căn vào giữa hàng như bản vẽ mình gửi cho cậu nhé. Cả chiều rộng của hàng text cũng như trong bản vẽ mình gửi cho cậu ý. Chứ thế này cũng hơi to. Mình gửi lại cậu xem nhé!

http://www.cadviet.com/upfiles/file_mau_3.dwg

Mình định nhờ cậu giúp mình đoạn lệnh loại bỏ những đường gióng có cao độ gần như nhau. Khoảng cao độ chênh lệch để loại bỏ do người vẽ tự chọn được. Như mặt cắt thứ 3 mình cũng đã loại bỏ bớt trông sẽ đỡ chen dày vào nhau. Nhưng chắc như thế hơi phức tạp. Mình sẽ loại bỏ thủ công vậy.

Cám ơn cậu thật nhiều! Thanh kiu trước nhé. :s_big:

Tháng 7 3, 2009

Mình dùng vẫn bình thường, cả chế độ truy bắt điểm cũng không sao. tại sao của cậu lại bị lỗi nhỉ.

Đăng nhập

Viết Lisp theo yêu cầu

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

HoangSon614 66

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

Tue_NV 3916

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

xuandao0708 9

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

Tue_NV 3916

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

HoangSon614 66

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

Tue_NV 3916

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

conghoan1003 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

HoangSon614 66

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

khaosat2009 11

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

thiep 367

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

thiep 367

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

q288 166

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

HoangSon614 66

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

Tue_NV 3916

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

HoangSon614 66

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

dienlicogi17 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

Tue_NV 3916

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

HoangSon614 66

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

xuantran15 112

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

Tue_NV 3916