Đến nội dung


Hình ảnh
* * * - - 8 Bình chọn

Viết lisp theo yêu cầu [phần 2]


  • Chủ đề bị khóa Chủ đề bị khóa
3783 replies to this topic

#21 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 08 September 2009 - 03:32 PM

File cad và file data.txt
http://www.cadviet.c...s/2/caddata.zip
@Anh Tuệ:
Em có đổi một chút vấn đề để tùy biến mạnh hơn, Ý tưởng của em như sau:
Trong file text các hàng dữ liệu ngăn cách bởi dấu tab, đầu tiên là tên điểm (VD: "Diem 1")
Bây giờ em mong được giúp làm 1 lisp:
- Đọc lần lượt từng hàng trong file text.
- Tách ra thành các chuỗi (các chuỗi trong hàng được ngăn cách bởi dấu tab - xem file data.txt đính kèm)
- Tìm trên toàn bản vẽ xem mtext nào có dòng đầu trùng với chuỗi đầu tiên (VD: tìm mtext có dòng đầu là "Diem 1")
- ghi lần lượt các chuỗi vừa tách vào các hàng tiếp theo của mtext đó.
- Tiếp tục với hàng tiếp theo trong data.txt (như trong file đính kèm là Diem 2)

+ Nếu không tìm thấy thì bỏ qua dòng text đó và nhảy xuống dòng tiếp theo trong file data.txt

Bạn dùng đoạn Lisp sau :
Trong đoạn Code có sử dụng hàm con POS của anh Hoành và hàm REPLACESTRING của anh giabach
Tue_NV xin mạn phép sử dụng 2 hàm con này để giúp cho bạn duongthanh85.
Cảm ơn anh Hoành và anh giabach

(defun c:imp( / tfile f st td ss st vt chuoidau1 chuoithay i sn ent)
  (setq tfile (getfiled "Ten file" "" "txt" 6))
  (if tfile (progn
    (setq f (open tfile "r"))
   (setq ss (ssget '((0 . "MTEXT"))) i 0)

    (while (setq st (read-line f))
(setq vt (pos "\t" st))
(setq chuoidau1 (substr st 1 (- vt 1)))
(setq chuoithay (replacestring st "\t" "\\P"))

       (while (< i (sslength ss))
      (setq sn (ssname ss i))
(setq ent (entget sn))
(setq chuoidau2 (cdr(assoc 1 ent)))

(if (= chuoidau1 chuoidau2)
(setq ent (entmod (subst (cons 1 chuoithay) (assoc 1 ent) ent)))
)
(setq i (1+ i))
)
(setq i 0 ss (ssget "P"))
    )
    (close f)
  
  ))
)
;
(defun pos (sub st / l1 l2 index)
(setq index 1
l1 (strlen sub)
l2 (strlen st)
)
(while
(and (<= (+ index l1 -1) l2) (/= sub (substr st index l1)))
(setq index (1+ index))
)
(if (= sub (substr st index l1))
index
nil
)
)
;
(defun ReplaceString (str str1 str2 / m)
(setq m 0)
(while (setq m (vl-string-search str1 str m))
(setq str (vl-string-subst str2 str1 str m))
(setq m (1+ m))
) ;_ end of while
str
) ;_ end of defun

  • 2

#22 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 08 September 2009 - 04:28 PM

Các bạn ơi! mình có mấy cái lisp này mình sưu tầm được nhưng chưa đúng ý mình, nhờ các bạn sửa lại dùm mình tí.
- Lisp thông số cống:nhờ các bạn sửa lại sao cho độ dốc cống bằng nghịch đảo của đường kính cống (đường kính tự mình nhập) (độ dốc lấy theo đơn vị phần ngàn ví dụ với đường kính là 400 thì độ dốc là 2.5) (hiện nay độ dốc cống đang mặc định là 0.0035 )
- Lisp thông số điện:
+ thì bỏ mũi tên đi (ko cần vẽ mũi tên)
+ bỏ ko cần ghi chiều dài luôn
+ tiết diện dây tự mình nhập (hiện nay mình nhập bất cứ số nào cũng mặc định là M-(3x240))
Chi tiết rõ hơn phiền các bạn xem bản vẽ mình gửi kèm nhé!
http://www.cadviet.c...s/2/thongso.dwg
http://www.cadviet.c.../2/filelisp.rar
Cảm ơn mọi người rất nhiều!

Chào TruongThanh, nhìn chung, tác giả của 2 lisp bạn sưu tầm không chịu khó chỉnh sửa, ví dụ muốn tạo Layer có tên "ahs-tnt-TSC" nhưng không tạo, các tham số đường kính không đưa vào text. 2 lisp trên mình đã chỉnh sửa cho bạn:
(defun C:Tn ()
(vl-load-com)
(setq *layer* (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))))
(setvar "cmdecho" 0)
(setvar "orthomode" 0)
(setvar "gridmode" 0)
(setvar "snapmode" 0)
(setvar "osmode" 0)
(if (not (setq enlay (tblobjname "layer" "ahs-tnt-TSC")))
(progn
(setq lay (vla-add *layer* "ahs-tnt-TSC"))
(vla-put-color lay acMagenta)
(vla-put-Linetype lay "CONTINUOUS")
)
(progn
(setq lay (vlax-ename->vla-object enlay))
(setq lay (vla-add *layer* "ahs-tnt-TSC"))
(vla-put-color lay acWhite)
(vla-put-Linetype lay "CONTINUOUS")
)
)
(setvar "clayer" "ahs-tnt-TSC")
(command ".style" "ahs-Arial" "Arial" "" "0.8" "" "" "" "" "")
(setq SS (ssget '((0 . "lwpolyline"))))
(setq dk (cond (dk)
(300)
)
)
(setq olddk dk)
(setq dk (getreal (strcat "\nNhap tiet dien day <"
(rtos olddk 2 1)
"> : "
)
)
)
(if (null dk)
(setq dk olddk)
)
(setq chu (cond (chu)
(3)
)
)
(setq oldchu chu)
(setq N 0)
(repeat (sslength SS)
(setq ent (ssname SS N))
(setq obj (vlax-ename->vla-object ent))
(setq len (vlax-curve-getdistatpoint obj (vlax-curve-getendpoint obj)); chieu dai polyline
PC (vlax-curve-getendpoint obj); dien cuoi
PD (vlax-curve-getstartpoint obj); diem dau
)
;lay gia tri toa do cua diem dau
(setq PDx (car PD)
PDY (cadr PD)
)
;lay gia tri toa do cua diem cuoi
(setq PCx (car PC)
PCY (cadr PC)
)
(If (< PDx PCx)
(progn
(setq goc (angle PD PC)
ang (cvunit goc "radians" "degrees")
p1 (polar PD goc (/ len 2))
p2 (polar p1 (+ (/ pi 2) goc) chu)
p3 (polar p1 (+ (/ pi 2) goc) (- 0 chu))
p4 (polar p3 goc (/ (* 1 -16.25) chu))
p5 (polar p4 goc (/ (* 1 25) chu))
p6 (polar p5 goc (/ (* 1 7.5) chu))
dodoc (/ 1000 dk)
)
; ghi gia tri va ve mui ten
(command ".text" "j" "mc" p2 chu ang (strcat "Ø" (rtos dk 2 0) " - L" (rtos len 2 0) " - i" (rtos dodoc 2 2))
".pline" p4 "w" 0.5 0.5 p5 "w" 2 0 p6 "")
);dong progn
(progn
(setq goc1 (angle PC PD)
ang1 (cvunit goc1 "radians" "degrees")
p1_1 (polar PD goc1 (- 0 (/ len 2)))
p2_1 (polar p1_1 (+ (/ pi 2) goc1) chu)
p3_1 (polar p1_1 (+ (/ pi 2) goc1) (- 0 chu))
p4_1 (polar p3_1 goc1 (/ (* 1 16.25) chu))
p5_1 (polar p4_1 goc1 (/ (* 1 -25) chu))
p6_1 (polar p5_1 goc1 (/ (* 1 -7.5) chu))
)
; ghi gia tri va ve mui ten
(command ".text" "j" "mc" p2_1 chu ang1 (strcat "Ø" (rtos dk 2 0) " - L" (rtos len 2 0) " - i" (rtos dodoc 2 2))
".pline" p4_1 "w" 0.5 0.5 p5_1 "w" 2 0 p6_1 "")
)
);dong if
(setq N (1+ N))
); dong vong lap repeat
(princ)
;mo bat diem
(setvar "osmode" 7)
)

(defun C:tsd ()
(vl-load-com)
;tat bat diem
(setvar "cmdecho" 0)
(setvar "orthomode" 0)
(setvar "gridmode" 0)
(setvar "snapmode" 0)
(setvar "osmode" 0)
(setq *layer* (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))))
(if (not (setq enlay (tblobjname "layer" "ahs-tnt-TSC")))
(progn
(setq lay (vla-add *layer* "ahs-tnt-TSC"))
(vla-put-color lay acMagenta)
(vla-put-Linetype lay "CONTINUOUS")
)
(progn
(setq lay (vlax-ename->vla-object enlay))
(setq lay (vla-add *layer* "ahs-tnt-TSC"))
(vla-put-color lay acWhite)
(vla-put-Linetype lay "CONTINUOUS")
)
)
(setvar "clayer" "ahs-tnt-TSC")
(command ".style" "ahs-Arial" "Arial" "" "0.8" "" "" "" "" "")
(setq SS (ssget '((0 . "lwpolyline"))))
(setq dk (cond (dk)
(300)
)
)
(setq olddk dk)
(setq dk (getreal (strcat "\nNhap tiet dien day <"
(rtos olddk 2 1)
"> : "
)
)
)
(if (null dk)
(setq dk olddk)
)
(setq chu (cond (chu)
(3)
)
)
(setq oldchu chu)
(setq chu (getreal (strcat "\nChon chieu cao chu <"
(rtos oldchu 2 1)
"> : "
)
)
)
(if (null chu)
(setq chu oldchu)
)
(setq N 0); gia tri ban dau
(repeat (sslength SS)
(setq ent (ssname SS N))
(setq obj (vlax-ename->vla-object ent))
(setq len (vlax-curve-getdistatpoint obj (vlax-curve-getendpoint obj))
; chieu dai polyline
PC (vlax-curve-getendpoint obj) ; dien cuoi
PD (vlax-curve-getstartpoint obj) ; diem dau
)
;lay gia tri toa do cua diem dau
(setq PDx (car PD)
PDY (cadr PD)
)
;lay gia tri toa do cua diem cuoi
(setq PCx (car PC)
PCY (cadr PC)
)
(If (< PDx PCx)
(progn
(setq goc (angle PD PC)
ang (cvunit goc "radians" "degrees")
p1 (polar PD goc (/ len 2))
p2 (polar p1 (+ (/ pi 2) goc) chu)
p3 (polar p1 (+ (/ pi 2) goc) (- 0 chu))
p4 (polar p3 goc -16.25)
p5 (polar p4 goc 25)
p6 (polar p5 goc 7.5)
)
; ghi gia tri va ve mui ten
(command ".text"
"j"
"mc"
p2
chu
ang
(strcat "M-(3x" (rtos dk 2 0) ")" "-L" (rtos len 2 0) "m")
)
) ;dong progn
(progn
(setq goc1 (angle PC PD)
ang1 (cvunit goc1 "radians" "degrees")
p1_1 (polar PD goc1 (- 0 (/ len 2)))
p2_1 (polar p1_1 (+ (/ pi 2) goc1) chu)
p3_1 (polar p1_1 (+ (/ pi 2) goc1) (- 0 chu))
p4_1 (polar p3_1 goc1 16.25)
p5_1 (polar p4_1 goc1 -25)
p6_1 (polar p5_1 goc1 -7.5)
)
; ghi gia tri va ve mui ten
(command ".text"
"j"
"mc"
p2_1
chu
ang1
(strcat "M-(3x" (rtos dk 2 0) ")" "-L" (rtos len 2 0) "m")
)
)
) ;dong if
(setq N (1+ N))
) ; dong vong lap repeat
(princ)
;mo bat diem
(setvar "osmode" 7)
); dong cong thuc

  • 1

#23 truongthanh

truongthanh

    biết lệnh text

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

Đã gửi 08 September 2009 - 05:27 PM

Chào TruongThanh, nhìn chung, tác giả của 2 lisp bạn sưu tầm không chịu khó chỉnh sửa, ví dụ muốn tạo Layer có tên "ahs-tnt-TSC" nhưng không tạo, các tham số đường kính không đưa vào text. 2 lisp trên mình đã chỉnh sửa cho bạn:

Cảm ơn Thiep nhiều lắm!nhưng vẫn còn 1 số vướng mắc:
1)Lisp TN:
-Lisp TN thì bị mất phần nhập chiều cao chữ và mũi tên vẫn chưa giống mũi tên của LISP thông số điện của mình gửi.
-Chữ FI (đường kính) bị lỗi (mình dùng font Arial)

2)Lisp TSD:
- Bỏ ko cần ghi chiều dài
- Và chia làm 2 trường hợp dùm mình với
+Trường hợp 1 như ban đầu (chỉ việc bỏ chiều dài thôi)
+Trường hợp 2 có dạng 2xM-(3xXXX + 1xYYY)
XXX:mình tự nhập với câu lệnh là:"Nhập tiết diện đầu:"
YYY: mình tự nhập với câu lệnh là: "Nhập tiết diện sau:"
Mong Thiep giúp dùm mình nhé!cảm ơn sự quan tâm nhiệt tình của bạn!
http://www.cadviet.c.../2/thongso1.dwg
P/S:cho mình hỏi tí:
- Khi load lisp lên thì báo lỗi:
Command: tn
Unknown command "TN". Press F1 for help.
Unknown command "TN". Press F1 for help.
Làm máy mình bị treo 1 hồi. :s_big:
  • -1

#24 Tuynh

Tuynh

    biết vẽ arc

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

Đã gửi 08 September 2009 - 05:51 PM

Cảm ơn Tuệ, Thiep bận rộn cả ngày hôm qua, Tuệ đã tiếp tay rất nhanh cho Tuynh.
Thiep chỉ gợi ý Tue rằng có 1 hàm trong thư viện Express tools tạo POLYLINE rất nhanh, đó là: acet-pline-make.
Còn lisp trên, Tuynh hãy đợi Tue_NV sẽ thêm vòng lặp để chọn đối tượng đến khi enter thì thôi

Cảm ơn các pác đã nhiệt tình giúp đỡ, mình vẫn tiếp tục nhờ các pác giúp cho là khi mình chỉnh sửa cao độ đường 3d polyline thì chỉ cần chỉnh ở dạng text (cao độ mình đã nhập khi lần đầu chạy lisp) và đường 3d polyline có cao độ thay đổi theo khi chỉnh sửa text
  • -1

#25 theking99

theking99

    Chưa sử dụng CAD

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

Đã gửi 08 September 2009 - 11:41 PM

Xin chào mọi người...Mình đã có Lisp để nối LINE, ARC thành POLYLINE. Nhưng trong bản Cad của mình có cả những hình đựơc vẽ nên từ SPLINE và PLINE. Bi giờ muốn nó thành POLYLINE thì lại phải BO rất là mất công. Bạn nào có thể viết cho mình cái LISP để thực hiện lệnh biến SPLINE , PLINE thành POLYLINE được ko? Mình xin chân thành cảm ơn ! Chúc diễn đàn ngày càng phát triển
  • -1

#26 conghoan1003

conghoan1003

    biết vẽ point

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

Đã gửi 09 September 2009 - 09:53 AM

Chào CongHoan, Thiep muốn tìm lại lisp gtd.lsp mà Hoan load được là của tác giả nào mà không thấy. Hoan chỉ giùm nhé
Bây giờ Thiep chỉnh lại lisp ấy đây:

(defun c:gtd (/ ST fn f x1 y1)
(setq fn (getfiled "Chon file ghi toa do: " "D:/" "tdo" 8))
(setq f (open fn "a"))
(setq ST 1)
(while (setq pt (getpoint "Toa do diem : "))
(setq x1 (rtos (car pt) 2 4)
y1 (rtos (cadr pt) 2 4))
(write-line (strcat (itoa ST) "\t" x1 "\t" y1) f)
(setq ST (1+ ST))
(terpri)
)
(close f)
(print)
)

Chào Thiêp! cảm ơn vì một lần nữa đã giúp mình.
Cái này mình sưu tầm được hình như không phải ở cadviet.
Lisp Thiep sửa chạy tốt lắm nhưng mình thấy khi bắt đầu là mở mốt file .tdo. Mình nghĩ để cho nó lưu file thì sẽ hay hơn , vì mối lần làm như thế mình cần một file mới mình nghĩ lưu một file sẽ hay hơn mở một file đã có.
Chúc thiep sức khoẻ!
  • 0
Học học nữa học mãi.
Đúp học lại!

#27 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 09 September 2009 - 10:25 AM

Cảm ơn Thiep nhiều lắm!nhưng vẫn còn 1 số vướng mắc:
1)Lisp TN:
-Lisp TN thì bị mất phần nhập chiều cao chữ và mũi tên vẫn chưa giống mũi tên của LISP thông số điện của mình gửi.
-Chữ FI (đường kính) bị lỗi (mình dùng font Arial)
2)Lisp TSD:
- Bỏ ko cần ghi chiều dài
- Và chia làm 2 trường hợp dùm mình với
+Trường hợp 1 như ban đầu (chỉ việc bỏ chiều dài thôi)
+Trường hợp 2 có dạng 2xM-(3xXXX + 1xYYY)
XXX:mình tự nhập với câu lệnh là:"Nhập tiết diện đầu:"
YYY: mình tự nhập với câu lệnh là: "Nhập tiết diện sau:"
Mong Thiep giúp dùm mình nhé!cảm ơn sự quan tâm nhiệt tình của bạn!
P/S:cho mình hỏi tí:
- Khi load lisp lên thì báo lỗi:
Command: tn
Unknown command "TN". Press F1 for help.
Unknown command "TN". Press F1 for help.
Làm máy mình bị treo 1 hồi. :s_big:

Chào truongthanh,
2 lisp Thiep đã chỉnh sửa theo ý của bạn. Còn khi đánh lệnh tn xong, bị lỗi là do dòng lệnh này:
(command ".style" "ahs-Arial" "Arial" "" "0.8" "" "" "" "" ""). Thiep cũng chỉnh sửa xong. Phải mất nhiều thời gian mới tìm ra lỗi này, tác giả trước đây đã thêm 2 lần enter.
;;; -------------------------------
(defun existLinetype (doc LineTypeName / item loaded)
(vlax-for item (vla-get-linetypes doc)
(if (= (strcase (vla-get-name item)) (strcase LineTypeName))
(setq loaded T)
)
)
)
(defun loadLinetype (doc LineTypeName FileName)
(if (and
(not (existLinetype doc LineTypeName))
(vl-catch-all-error-p
(vl-catch-all-apply
'vla-load
(list
(vla-get-Linetypes doc)
LineTypeName
FileName
)
)
)
)
nil
T
)
)
(vl-load-com)
(defun c:tn (/ *layer* enlay lay SS ent n obj
len pc pd pdx pdy pcx pcy goc ang
dodoc p1 p2 p3 p4 p5 p6
)
(princ "\nLISP THÔNG SÔ CÔNG THOAT NUOC - free lisp from cadviet.com")
(setq ActDoc (vla-get-ActiveDocument (vlax-get-acad-object))
*Model* (vla-get-ModelSpace ActDoc)
*layer* (vla-get-Layers ActDoc)
*LT* (vla-get-linetypes ActDoc)
)
(loadLinetype ActDoc "ACAD_ISO10W100" "acad.lin")
(vla-StartUndoMark ActDoc)
(setvar "cmdecho" 0)
(setvar "orthomode" 0)
(setvar "gridmode" 0)
(setvar "snapmode" 0)
(setvar "osmode" 0)
(if (not (setq enlay (tblobjname "layer" "ahs-tnt-TSC")))
(progn
(setq lay (vla-add *layer* "ahs-tnt-TSC"))
(vla-put-color lay acMagenta)
(vla-put-Linetype lay "ACAD_ISO10W100")
)
(progn
(setq lay (vlax-ename->vla-object enlay))
(setq lay (vla-add *layer* "ahs-tnt-TSC"))
(vla-put-color lay acWhite)
(vla-put-Linetype lay "ACAD_ISO10W100")
)
)
(setvar "clayer" "ahs-tnt-TSC")
(command ".style" "ahs-Arial" "Arial" "" "0.8" "" "" "")
(setq SS (ssget '((0 . "LWPOLYLINE,LINE"))))
(setq dk (cond (dk)
(300)
)
)
(setq olddk dk)
(setq dk (getreal (strcat "\nNhap tiet dien day <"
(rtos olddk 2 1)
"> : "
)
)
)
(if (null dk)
(setq dk olddk)
)
(setq chu (cond (chu)
(3)
)
)
(setq oldchu chu)
(setq chu (getreal (strcat "\nChon chieu cao chu <"
(rtos oldchu 2 1)
"> : "
)
)
)
(if (null chu)
(setq chu oldchu)
)
(setq N 0)
(repeat (sslength SS)
(setq ent (ssname SS N))
(setq obj (vlax-ename->vla-object ent))
(setq len (vlax-curve-getdistatpoint obj (vlax-curve-getendpoint obj))
PC (vlax-curve-getendpoint obj) ; dien cuoi
PD (vlax-curve-getstartpoint obj) ; diem dau
)
(setq PDx (car PD)
PDY (cadr PD)
)
(setq PCx (car PC)
PCY (cadr PC)
)
(If (< PDx PCx)
(progn
(setq goc (angle PD PC)
p1 (polar PD goc (/ len 2))
)
)
(progn
(setq goc (angle PC PD)
p1 (polar PD goc (- (/ len 2)))
)
)
)
(setq ang (cvunit goc "radians" "degrees")
p2 (polar p1 (+ (/ pi 2) goc) chu)
p3 (polar p1 (+ (/ pi 2) goc) (- chu))
p4 (polar p3 goc -16.25)
p5 (polar p4 goc 25)
p6 (polar p5 goc 7.5)
dodoc (/ 1000 dk)
)
(command ".text"
"j"
"mc"
p2
chu
ang
(strcat (chr 216)
(rtos dk 2 0)
" - L"
(rtos len 2 0)
" - i"
(rtos dodoc 2 2)
)
".pline"
p4
"w"
0.5
0.5
p5
"w"
2
0
p6
""
)
(setq N (1+ N))
); dong vong lap repeat
(setvar "osmode" 7)
(vla-EndUndoMark ActDoc)
(princ)
)


(vl-load-com)
(defun c:tsd (/ *layer* enlay lay ss ent n obj len
pc pd pdx pdy pcx pcy goc ang p1
p2 p3 p4 p5 p6
)
(princ "\nLISP THÔNG SÔ DIÊN - free lisp from cadviet.com")
(setq ActDoc (vla-get-ActiveDocument (vlax-get-acad-object))
*layer* (vla-get-Layers ActDoc)
)
(vla-StartUndoMark ActDoc)
(setvar "cmdecho" 0)
(setvar "orthomode" 0)
(setvar "gridmode" 0)
(setvar "snapmode" 0)
(setvar "osmode" 0)
(if (not (setq enlay (tblobjname "layer" "ahs-tnt-TSC")))
(progn
(setq lay (vla-add *layer* "ahs-tnt-TSC"))
(vla-put-color lay acMagenta)
(vla-put-Linetype lay "CONTINUOUS")
)
(progn
(setq lay (vlax-ename->vla-object enlay))
(setq lay (vla-add *layer* "ahs-tnt-TSC"))
(vla-put-color lay acWhite)
(vla-put-Linetype lay "CONTINUOUS")
)
)
(setvar "clayer" "ahs-tnt-TSC")
(command ".style" "ahs-Arial" "Arial" "" "0.8" "" "" "")
(setq SS (ssget '((0 . "LWPOLYLINE,LINE"))))
(setq dkd (cond (dkd)
(300)
)
)
(setq olddkd dkd)
(setq dkd (getreal (strcat "\nNhap tiet dien day dau <"
(rtos olddkd 2 1)
"> : "
)
)
)
(if (null dkd)
(setq dkd olddkd)
)
(setq chu (cond (chu)
(3)
)
)
(setq oldchu chu)
(setq chu (getreal (strcat "\nChon chieu cao chu <"
(rtos oldchu 2 1)
"> : "
)
)
)
(if (null chu)
(setq chu oldchu)
)
(setq N 0) ; gia tri ban dau
(repeat (sslength SS)
(setq ent (ssname SS N))
(setq obj (vlax-ename->vla-object ent))
(setq len (vlax-curve-getdistatpoint obj (vlax-curve-getendpoint obj))
PC (vlax-curve-getendpoint obj) ; dien cuoi
PD (vlax-curve-getstartpoint obj) ; diem dau
)
(setq PDx (car PD)
PDY (cadr PD)
)
(setq PCx (car PC)
PCY (cadr PC)
)
(If (< PDx PCx)
(progn
(setq goc (angle PD PC)
p1 (polar PD goc (/ len 2))
)
)
(progn
(setq goc (angle Pc Pd)
p1 (polar PD goc (- (/ len 2)))
)
)
)
(setq ang (cvunit goc "radians" "degrees")
p2 (polar p1 (+ (/ pi 2) goc) chu)
p3 (polar p1 (+ (/ pi 2) goc) (- chu))
p4 (polar p3 goc -16.25)
p5 (polar p4 goc 25)
p6 (polar p5 goc 7.5)
)
(setq bit (cond (bit)
("Yes")
)
)
(initget "Yes No")
(setq Tmp (strcat "\nBan co nhap tiet dien day khong? [Yes/No] <"
bit
">: "
)
bit (cond ((getkword Tmp))
(bit)
)
)
(if (eq bit "Yes")
(progn
(setq dkc (cond (dkc)
(300)
)
)
(setq olddkc dkc)
(setq dkc (getreal (strcat "\nNhap tiet dien day cuoi <"
(rtos olddkc 2 1)
"> : "
)
)
)
(if (null dkc)
(setq dkc olddkc)
)
(command ".text"
"j"
"mc"
p2
chu
ang
(strcat "2xM-(3x"
(rtos dkd 2 0)
" + "
"1x"
(rtos dkc 2 0)
")"
)
)
)
(command ".text"
"j"
"mc"
p2
chu
ang
(strcat "M-(3x" (rtos dkd 2 0) ")")
)
)
(setq N (1+ N))
) ; end repeat
(setvar "osmode" 7)
(vla-EndUndoMark ActDoc)
(princ)
)

  • 3

#28 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 09 September 2009 - 11:02 AM

Chào Thiêp! cảm ơn vì một lần nữa đã giúp mình.
Cái này mình sưu tầm được hình như không phải ở cadviet.
Lisp Thiep sửa chạy tốt lắm nhưng mình thấy khi bắt đầu là mở mốt file .tdo. Mình nghĩ để cho nó lưu file thì sẽ hay hơn , vì mối lần làm như thế mình cần một file mới mình nghĩ lưu một file sẽ hay hơn mở một file đã có.
Chúc thiep sức khoẻ!

Chào CongHoan, Bởi vì Hoan nói "có lúc tìm hoài chẳng thấy luôn" Vì vậy Thiep muốn Hoan tạo ra 1 file *.tdo rỗng ở thư mục gốc D:\ . Như vậy, Hoan sẽ biết trước file dữ liệu nằm ở đâu. Chắc có lẽ bạn muốn chỉ đưa tên file ghi tọa độ thôi như lisp gốc CongHoan sưu tầm. Nếu vậy, Hoan sửa lại 2 dòng mã như sau:
(setq fn (getfiled "Chon file ghi toa do: " "D:/" "tdo" 8))
(setq f (open fn "a"))
thành:
(setq file (getstring T "Ten file toa do : "))
(setq tenf (strcat file ".tdo"))
(setq f (open tenf "a"))
File dữ liệu *.tdo sẽ được tự động ghi vào thư mục "My Documents"
  • 1

#29 truongthanh

truongthanh

    biết lệnh text

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

Đã gửi 09 September 2009 - 11:32 AM

Chào truongthanh,
2 lisp Thiep đã chỉnh sửa theo ý của bạn. Còn khi đánh lệnh tn xong, bị lỗi là do dòng lệnh này:
(command ".style" "ahs-Arial" "Arial" "" "0.8" "" "" "" "" ""). Thiep cũng chỉnh sửa xong. Phải mất nhiều thời gian mới tìm ra lỗi này, tác giả trước đây đã thêm 2 lần enter.

cảm ơn Thiep nhiều lắm!mình làm được rồi!chúc Thiep thành đạt!
  • 0

#30 truongthanh

truongthanh

    biết lệnh text

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

Đã gửi 09 September 2009 - 11:55 AM

Chào truongthanh,
2 lisp Thiep đã chỉnh sửa theo ý của bạn. Còn khi đánh lệnh tn xong, bị lỗi là do dòng lệnh này:
(command ".style" "ahs-Arial" "Arial" "" "0.8" "" "" "" "" ""). Thiep cũng chỉnh sửa xong. Phải mất nhiều thời gian mới tìm ra lỗi này, tác giả trước đây đã thêm 2 lần enter.

;;; -------------------------------
(defun existLinetype (doc LineTypeName / item loaded)
(vlax-for item (vla-get-linetypes doc)
(if (= (strcase (vla-get-name item)) (strcase LineTypeName))
(setq loaded T)
)
)
)
(defun loadLinetype (doc LineTypeName FileName)
(if (and
(not (existLinetype doc LineTypeName))
(vl-catch-all-error-p
(vl-catch-all-apply
'vla-load
(list
(vla-get-Linetypes doc)
LineTypeName
FileName
)
)
)
)
nil
T
)
)
(vl-load-com)
(defun c:tn (/ *layer* enlay lay SS ent n obj
len pc pd pdx pdy pcx pcy goc ang
dodoc p1 p2 p3 p4 p5 p6
)
(princ "\nLISP THÔNG SÔ CÔNG THOAT NUOC - free lisp from cadviet.com")
(setq ActDoc (vla-get-ActiveDocument (vlax-get-acad-object))
*Model* (vla-get-ModelSpace ActDoc)
*layer* (vla-get-Layers ActDoc)
*LT* (vla-get-linetypes ActDoc)
)
(loadLinetype ActDoc "ACAD_ISO10W100" "acad.lin")
(vla-StartUndoMark ActDoc)
(setvar "cmdecho" 0)
(setvar "orthomode" 0)
(setvar "gridmode" 0)
(setvar "snapmode" 0)
(setvar "osmode" 0)
(if (not (setq enlay (tblobjname "layer" "ahs-tnt-TSC")))
(progn
(setq lay (vla-add *layer* "ahs-tnt-TSC"))
(vla-put-color lay acMagenta)
(vla-put-Linetype lay "ACAD_ISO10W100")
)
(progn
(setq lay (vlax-ename->vla-object enlay))
(setq lay (vla-add *layer* "ahs-tnt-TSC"))
(vla-put-color lay acWhite)
(vla-put-Linetype lay "ACAD_ISO10W100")
)
)
(setvar "clayer" "ahs-tnt-TSC")
(command ".style" "ahs-Arial" "Arial" "" "0.8" "" "" "")
(setq SS (ssget '((0 . "LWPOLYLINE,LINE"))))
(setq dk (cond (dk)
(300)
)
)
(setq olddk dk)
(setq dk (getreal (strcat "\nNhap tiet dien day <"
(rtos olddk 2 1)
"> : "
)
)
)
(if (null dk)
(setq dk olddk)
)
(setq chu (cond (chu)
(3)
)
)
(setq oldchu chu)
(setq chu (getreal (strcat "\nChon chieu cao chu <"
(rtos oldchu 2 1)
"> : "
)
)
)
(if (null chu)
(setq chu oldchu)
)
(setq N 0)
(repeat (sslength SS)
(setq ent (ssname SS N))
(setq obj (vlax-ename->vla-object ent))
(setq len (vlax-curve-getdistatpoint obj (vlax-curve-getendpoint obj))
PC (vlax-curve-getendpoint obj) ; dien cuoi
PD (vlax-curve-getstartpoint obj) ; diem dau
)
(setq PDx (car PD)
PDY (cadr PD)
)
(setq PCx (car PC)
PCY (cadr PC)
)
(If (< PDx PCx)
(progn
(setq goc (angle PD PC)
p1 (polar PD goc (/ len 2))
)
)
(progn
(setq goc (angle PC PD)
p1 (polar PD goc (- (/ len 2)))
)
)
)
(setq ang (cvunit goc "radians" "degrees")
p2 (polar p1 (+ (/ pi 2) goc) chu)
p3 (polar p1 (+ (/ pi 2) goc) (- chu))
p4 (polar p3 goc -16.25)
p5 (polar p4 goc 25)
p6 (polar p5 goc 7.5)
dodoc (/ 1000 dk)
)
(command ".text"
"j"
"mc"
p2
chu
ang
(strcat (chr 216)
(rtos dk 2 0)
" - L"
(rtos len 2 0)
" - i"
(rtos dodoc 2 2)
)
".pline"
p4
"w"
0.5
0.5
p5
"w"
2
0
p6
""
)
(setq N (1+ N))
); dong vong lap repeat
(setvar "osmode" 7)
(vla-EndUndoMark ActDoc)
(princ)
)

cho mình hỏi tí nhen!mình muốn đổi chiều dài mũi tên và bề rộng điểm đầu,bề rộng điểm cuối của Pline mũi tên thì mình chỉnh chỗ nào vậy Thiep!
  • 0

#31 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 09 September 2009 - 12:09 PM

cho mình hỏi tí nhen!mình muốn đổi chiều dài mũi tên và bề rộng điểm đầu,bề rộng điểm cuối của Pline mũi tên thì mình chỉnh chỗ nào vậy Thiep!

Muốn chỉnh chiều dài mũi tên thì chỉnh tọa độ của p6:
tại hàng: p6 (polar p5 goc 7.5). Bạn thay 7.5 bằng số lớn hơn
Muốn chỉnh bề rộng điểm đầu, bề rộng điểm cuối thì chỉnh ở chổ này:
".pline"
p4
"w"
0.5
0.5
p5
"w"
2
0
p6
""
Những con số màu đỏ ở trên, bạn thử thay số khác xem?
  • 2

#32 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 09 September 2009 - 12:21 PM

cảm ơn Thiep nhiều lắm!mình làm được rồi!chúc Thiep thành đạt!

Cảm ơn truongthanh, cầu mong lời chúc của truongthanh sẽ cải thiện được cái "thành đạt" hiện nay của mình. Chúc Truongthanh vui vẻ!
  • 1

#33 truongthanh

truongthanh

    biết lệnh text

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

Đã gửi 09 September 2009 - 02:05 PM

Thiep cho mình hỏi tí nữa nhen!Mình muốn chỉnh cho mũi tên song song và nằm center với Pline thì mình chỉnh sao vậy?chi tiết Thiep xem file mình gửi theo nè!
http://www.cadviet.c.../2/thongso2.dwg
thanks!
  • 0

#34 moihoclisp

moihoclisp

    biết zoom

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

Đã gửi 09 September 2009 - 06:36 PM

Các Bác cho em xin cái lisp này được không ah.
trên bản vẽ có các text thuộc các layer khác nhau.
VD:
Họ tên ---------> layer: hten
Địa chỉ ---------> layer: dchi
số dt ---------> layer: dthoai
bây giờ em muốn cái Lisp khi chạy sẽ tự động gán text "Họ tên" vào biến hoten ; "Địa chỉ" vào biến diachi ; "số dt" -> biến sdthoai.
Thanks các Bác nhiều!
  • 0

#35 Tuynh

Tuynh

    biết vẽ arc

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

Đã gửi 10 September 2009 - 08:13 AM

Bác Thaistreetz là dân giao thông chắc bác biết lệnh tạo nhà trong nova bác có thể giúp em viết một lisp tạo nhà giống như thế được không.
  • 0

#36 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 10 September 2009 - 08:56 AM

Thiep cho mình hỏi tí nữa nhen!Mình muốn chỉnh cho mũi tên song song và nằm center với Pline thì mình chỉnh sao vậy?chi tiết Thiep xem file mình gửi theo nè!
http://www.cadviet.c.../2/thongso2.dwg
thanks!

truongthanh thêm mã sau:
- sau hàng: PD (vlax-curve-getstartpoint obj) ; diem dau
chèn thêm: PG (vlax-curve-getPointAtDist obj (/ len 2)); diem giua
- sau hàng: p6 (polar p5 goc 7.5)
chèn thêm: p7 (polar Pg (- goc (/ pi 2)) chu)
- sau hàng: (command ".text"
"j"
"mc"
p2
chu
ang
(strcat (chr 216)
(rtos dk 2 0)
" - L"
(rtos len 2 0)
" - i"
(rtos dodoc 2 2)
)
".pline"
p4
"w"
0.5
0.5
p5
"w"
2
0
p6
""
)
chèn thêm:
(vla-move
(vlax-ename->vla-object
(entlast)
)
(vlax-3d-point
(acet-geom-midpoint
(car (ACET-ent-GEOMEXTENTS (entlast)))
(cadr (ACET-ent-GEOMEXTENTS (entlast)))
)
)
(vlax-3d-point p7)
)
  • 1

#37 truongthanh

truongthanh

    biết lệnh text

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

Đã gửi 10 September 2009 - 09:54 AM

truongthanh thêm mã sau:

cảm ơn Thiep nhé!mình làm dc rồi!cảm ơn bạn rất nhiều!
  • 0

#38 truongthanh

truongthanh

    biết lệnh text

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

Đã gửi 10 September 2009 - 10:42 AM

Thiep cho mình làm phiền thêm tí nữa nhé!LISP TN đó!mình mún bỏ ko thể hiện độ dốc thì sửa sao?chỉ cần thể hiện 2 thông số đầu thôi!làm fien tí nhé! :s_big:
  • 0

#39 conghoan1003

conghoan1003

    biết vẽ point

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

Đã gửi 10 September 2009 - 11:18 AM

Chào CongHoan, Bởi vì Hoan nói "có lúc tìm hoài chẳng thấy luôn" Vì vậy Thiep muốn Hoan tạo ra 1 file *.tdo rỗng ở thư mục gốc D:\ . Như vậy, Hoan sẽ biết trước file dữ liệu nằm ở đâu. Chắc có lẽ bạn muốn chỉ đưa tên file ghi tọa độ thôi như lisp gốc CongHoan sưu tầm. Nếu vậy, Hoan sửa lại 2 dòng mã như sau:
(setq fn (getfiled "Chon file ghi toa do: " "D:/" "tdo" 8))
(setq f (open fn "a"))
thành:
(setq file (getstring T "Ten file toa do : "))
(setq tenf (strcat file ".tdo"))
(setq f (open tenf "a"))
File dữ liệu *.tdo sẽ được tự động ghi vào thư mục "My Documents"

Chào Thiep!
Có lẽ Thiep hiểu sai ý của mình rồi. Sau khi mình chạy lisp nó cũng xuất hiện 1 cửa sổ, nhưng thay vì cửa sổ có chức nằng mở file có sẵn thì thay thế bằng cửa sổ có chức năng lưu file vào thư mục nào? Còn nếu tự động lưu thì lưu vào thư mục chứa file của cad đang dùng lấy toạ độ. Cảm ơn Thiệp đã giúp đỡ!
  • 0
Học học nữa học mãi.
Đúp học lại!

#40 truongthanh

truongthanh

    biết lệnh text

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

Đã gửi 10 September 2009 - 11:26 AM

Tue oi!cho mình hỏi chỗ này tí xíu!bữa trước mình có nhờ TUE viết dùm cái LISP vạt góc đó!
(setq ans (getkword
"\n <1> : Cac duong deu la LINE hoac PLINE/ <2> : PLINE co 1 phan doan la arc : <1/2> : "))
)

chỗ này nè!mình muốn mặc định là trường hợp 1 luôn, còn trường hợp 2 khi nào cần thì mình sẽ nhấn số 2, vì mình chủ yếu xài trường hợp 1 là nhiều!mỗi lần như vậy mình phải bấm lại số 1 nữa,mình muốn enter 1 cái thì nó sẽ hiểu là trường hợp 1 liền!nhờ TUE chỉ giúp cho mình với!
LISP đó nằm ở Phần 1 đó:bài 2607
http://www.cadviet.c...o...205&st=2600
Thanks TUE nhiều!
  • 0