conghoan1003 0 Báo cáo bài đăng Đã đăng Tháng 9 9, 2009 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ẻ! 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 Báo cáo bài đăng Đã đăng Tháng 9 9, 2009 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 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 Báo cáo bài đăng Đã đăng Tháng 9 9, 2009 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 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
truongthanh 7 Báo cáo bài đăng Đã đăng Tháng 9 9, 2009 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! 1 1 Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
truongthanh 7 Báo cáo bài đăng Đã đăng Tháng 9 9, 2009 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! 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 Báo cáo bài đăng Đã đăng Tháng 9 9, 2009 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 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 Báo cáo bài đăng Đã đăng Tháng 9 9, 2009 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 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
truongthanh 7 Báo cáo bài đăng Đã đăng Tháng 9 9, 2009 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.com/upfiles/2/thongso2.dwg thanks! 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
moihoclisp 0 Báo cáo bài đăng Đã đăng Tháng 9 9, 2009 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! 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
Tuynh 1 Báo cáo bài đăng Đã đăng Tháng 9 10, 2009 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. 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 Báo cáo bài đăng Đã đăng Tháng 9 10, 2009 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.com/upfiles/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 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
truongthanh 7 Báo cáo bài đăng Đã đăng Tháng 9 10, 2009 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! 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
truongthanh 7 Báo cáo bài đăng Đã đăng Tháng 9 10, 2009 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: 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 Báo cáo bài đăng Đã đăng Tháng 9 10, 2009 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 đỡ! 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
truongthanh 7 Báo cáo bài đăng Đã đăng Tháng 9 10, 2009 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.com/forum/index.php?sho...205&st=2600 Thanks TUE nhiều! Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
Tue_NV 3915 Báo cáo bài đăng Đã đăng Tháng 9 10, 2009 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 : Cac duong deu la LINE hoac PLINE/ : PLINE co 1 phan doan la arc : : ")) ) 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.com/forum/index.php?sho...205&st=2600 Thanks TUE nhiều! Của bạn đây : Thay số 1 bằng cách ấn Enter nhé : (defun c:gktvg(/ oldos ans po ss prad prac p11 p1 p2 p22 inte ss1 po poo) (vl-load-com) (setq oldos (getvar "osmode")) (setvar "osmode" 2999) (initget "2") (setq ans (getkword "\n : Cac duong deu la LINE hoac PLINE/ : PLINE co 1 phan doan la arc : : ")) (if (not ans) (progn (setq po (getpoint "\n Pick chon mot diem tren canh vat goc :")) (setq ss (car(nentselp po))) (if (and (= (cdr(assoc 0 (entget ss))) "LWPOLYLINE") (>= (cdr(assoc 90 (entget ss))) 4)) (progn (setq prad (fix (vlax-curve-getParamAtPoint ss po))) (setq p11 (vlax-curve-getPointAtParam ss (- prad 1))) (setq p1 (vlax-curve-getPointAtParam ss prad)) (setq p2 (vlax-curve-getPointAtParam ss (+ prad 1))) (setq p22 (vlax-curve-getPointAtParam ss (+ prad 2))) (setq inte (inters p11 p1 p2 p22 nil)) (setvar "osmode" 0) (command "dimaligned" p1 inte pause) (command "dimaligned" p2 inte pause) );progn );if (if (= (cdr(assoc 0 (entget ss))) "LINE") (progn (prompt "\n Chon 3 duong vat goc : duong thu nhat, duong thu hai va duong vat goc:") (setq ss1 (ssget)) (command "pedit" "m" ss1 "" "y" "j" "10" "") (setq ss (ssname (ssget "L") 0)) (setq prad (fix (vlax-curve-getParamAtPoint ss po))) (setq p11 (vlax-curve-getPointAtParam ss (- prad 1))) (setq p1 (vlax-curve-getPointAtParam ss prad)) (setq p2 (vlax-curve-getPointAtParam ss (+ prad 1))) (setq p22 (vlax-curve-getPointAtParam ss (+ prad 2))) (setq inte (inters p11 p1 p2 p22 nil)) (setvar "osmode" 0) (command "dimaligned" p1 inte pause) (command "dimaligned" p2 inte pause) (command "explode" ss "") );progn );if (setvar "osmode" oldos) );progn );if (if (= ans "2") (progn (setvar "osmode" 2) (setq po (getpoint "\n Pick chon trung diem canh vat goc :")) (setvar "osmode" 2999) (setq p1 (getpoint "\n Pick chon mot diem tren duong thang :")) (setq ss (car(nentselp po))) (setq prac (fix (vlax-curve-getParamAtPoint ss p1))) (setq p11 (vlax-curve-getPointAtParam ss prac)) (setq prad (fix (vlax-curve-getParamAtPoint ss po))) (setq p2 (vlax-curve-getPointAtParam ss prad)) (setq p22 (vlax-curve-getPointAtParam ss (+ prad 1))) (setq ang (+ (angle '(0 0 0) (vlax-curve-getFirstDeriv ss (vlax-curve-getParamAtPoint ss po))) (/ pi 2))) (setq poo (polar po ang 100)) (setq inte (inters p11 p1 po poo nil)) (setvar "osmode" 0) (command "dimaligned" p2 inte pause) (command "dimaligned" p22 inte pause) )) (princ) ) 2 Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
truongthanh 7 Báo cáo bài đăng Đã đăng Tháng 9 10, 2009 Của bạn đây : Thay số 1 bằng cách ấn Enter nhé : mình load lên, gõ lệnh nó báo lỗi TUE ơi! Command: gktvg ; error: too many arguments TUE kiem tra lại dùm mình tí nhen!thanks! 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 Báo cáo bài đăng Đã đăng Tháng 9 10, 2009 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:truongthanh bỏ dòng mã sau:dodoc (/ 1000 dk) và dòng mã: " - i" (rtos dodoc 2 2) 2 Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
thiep 367 Báo cáo bài đăng Đã đăng Tháng 9 10, 2009 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 đỡ! Chào CH1003, Lisp chỉnh sửa này sẽ cho phép người dùng tự tạo một file mới để ghi dữ liệu, nếu chọn file có sẵn nó sẽ ghi dữ liệu đè lên file cũ. Nên nhớ rằng lisp yêu cầu mở thư mục để tạo file trước khi yêu cầu người dùng pick point: (defun SAVE_MODE () (command "UCS" "W" "") (setq OLD_OSMODE (getvar "OSMODE")) (setvar "cmdecho" 0) (setvar "blipmode" 1) ) (defun RESTORE () (setvar "osmode" OLD_OSMODE) (setvar "cmdecho" 1) (setvar "blipmode" 0) ) (defun c:gtd (/ ST fn f x1 y1) (setq fn (getfiled "Tao file ghi toa do: " "D:/" "tdo" 1)) (setq f (open fn "w")) (setq ST 1) (SAVE_MODE) (setvar "osmode" 0) (while (setq pt (getpoint "Pick point: ")) (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) (RESTORE) (redraw) (print) ) Lisp tạm thời mở hộp thoại "tạo file ghi toa do" tại thư mục gốc là D:, còn người dùng muốn ghi vào đâu thì tùy, còn muốn thường xuyên ghi vào 1 thư mục nào đó, thì sửa lại dòng này: "D:/" Ví dụ, CH1003 muốn ghi vào thư mục đã có sẵn: "E:/Conghoan1003/data/" chẳng hạn. Còn trên máy người dùng chưa có thư mục như ví dụ trên, thì lisp sẽ mở thư mục "My documents" :s_big: 3 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 3915 Báo cáo bài đăng Đã đăng Tháng 9 10, 2009 mình load lên, gõ lệnh nó báo lỗi TUE ơi!Command: gktvg ; error: too many arguments TUE kiem tra lại dùm mình tí nhen!thanks! Bạn test lại xem nhé : http://www.cadviet.com/upfiles/2/gktvg.lsp 1 Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
dovanlinh 4 Báo cáo bài đăng Đã đăng Tháng 9 10, 2009 Em chào các anh. em muốn hỏi khi viêt lisp muốn chon điểm là điểm gốc của đối tượng dtext thì phải dùng hàm như thế nào? 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 Báo cáo bài đăng Đã đăng Tháng 9 10, 2009 cám ơn bạn,mình vẩn ko làm được....đây là file mẩu của mình,mong các bạn giúp đở.. http://www.cadviet.com/upfiles/2/vd.dwg em xin 1 lisp thực hiện như trong hình..http://www.cadviet.com/upfiles/2/vd_3.dwg em cám ơn nhiều... :s_big: Chào Kamezoko, Trước hết Thiep đề nghị định dạng lại bản vẽ của bạn như sau: Các điểm đo là đối tượng POINT được đặt trong lớp "DIEM" Các ký hiệu điểm đo là đối tượng TEXT được đặt trong lớp "TENDIEM" Các cao độ điểm đo là đối tượng TEXT được đặt trong lớp "CAODO" Các ký hiệu điểm đo phải là một ký tự chữ kèm với 1 số tự nhiên tăng dần. ví dụ: đường chuyền đa giác 1: I.1, I.2, I.3... I.100, đường chuyền đa giác 2: H-1, H-2, H-3 ... H-100, không được là II.1, II.2, II.3 ...Nếu bạn lỡ ký hiệu như vậy thì dùng chức năng find and replace của CAD để chỉnh sửa lại. Lisp sẽ tự động dò các điểm có ký hiệu cùng 1 kiểu đường chuyền sẽ nối với nhau thành một 3dpolyline Thiep dùng lisp JD của bác Hoanh chỉnh sửa lại cho phù hợp với bạn hơn. Các bạn trắc địa dùng và cho ý kiến nhé: ;;;=============================================== ;;; Lisp tao duong chuyen 3DPOLYLINE ;;; Update: 09/09/2009 ;;; Free from CADVIET.COM (defun 3DPoly (Lp *ModelSpace* / PntArr) (setq PntArr (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length Lp))) ) ) (vlax-safearray-fill PntArr Lp) (vla-Add3Dpoly *ModelSpace* PntArr) ) ;;;--------------------- (defun SAVE_MODE () (command "UCS" "W" "") (setq OLD_OSMODE (getvar "OSMODE") OLD_CECOLOR (getvar "CECOLOR") OLD_AUTOSNAP (getvar "AUTOSNAP") OLD_ORTHOMODE (getvar "ORTHOMODE") ) (setvar "osmode" 0) (setvar "cmdecho" 0) (setvar "plinegen" 1) ) (defun RESTORE () (setvar "osmode" OLD_OSMODE) (setvar "AUTOSNAP" OLD_AUTOSNAP) (setvar "ORTHOMODE" OLD_ORTHOMODE) (setvar "CECOLOR" OLD_CECOLOR) (setvar "cmdecho" 1) ) ;;;------------------------------------ (defun timgan (p lst / dmin ppluu) (foreach pp lst (setq d (distance p (car pp))) (if (or (not dmin) (> dmin d)) (setq dmin d ppluu pp ) ) ) (cdr ppluu) ) (defun filter (lstent otype olayer / kq) (foreach pp lstent (setq tt (entget pp)) (if (and (member (cons 0 otype) tt) (member (cons 8 olayer) tt) ) (setq kq (append kq (list pp))) ) ) kq ) (defun ss2ent(ss / sodt index lstent) (setq sodt (if ss (sslength ss) 0) index 0 ) (repeat sodt (setq ent (ssname ss index) index (1+ index) lstent (cons ent lstent) ) ) (reverse lstent) ) ;;;=============================================== (vl-load-com) (defun c:jd (/ ss lstent lstcode lstpoint lstponew lstassoc lstass pc code p lstPLY p0 lstponew co n ) (setq ActDoc (vla-get-ActiveDocument (vlax-get-acad-object)) *Model* (vla-get-ModelSpace ActDoc) *layer* (vla-get-Layers ActDoc) ) (vla-StartUndoMark ActDoc) (if (not (setq enlay (tblobjname "layer" "DUONGCHUYEN"))) (setq lay (vla-add *layer* "DUONGCHUYEN")) (progn (setq lay (vlax-ename->vla-object enlay)) (setq lay (vla-add *layer* "DUONGCHUYEN")) ) ) (vla-put-color lay acRed) (vla-put-Linetype lay "continuous") (setvar "clayer" "DUONGCHUYEN") (SAVE_MODE) (setq ss (ssget '((-4 . " (-4 . " (0 . "POINT") (8 . "DIEM") (-4 . "AND>") (-4 . " (0 . "TEXT") (8 . "TENDIEM") (-4 . "AND>") (-4 . "OR>") ) ) lstent (ss2ent ss) lstcode (mapcar '(lambda (e) (cons (cdr (assoc 10 (entget e))) (cdr (assoc 1 (entget e))) ) ) (filter lstent "TEXT" "TENDIEM") ) lstpoint (mapcar '(lambda (e) (cdr (assoc 10 (entget e)))) (filter lstent "POINT" "DIEM") ) lstpoint (mapcar '(lambda (p) (cons (timgan p lstcode) p) ) lstpoint ) ) (setq lstpoint (vl-sort lstpoint '(lambda (e1 e2) (< (car e1) (car e2) ) ) ) ) (foreach pn lstpoint (setq lstponew (cons (cons (read (substr (car pn) 1 1)) (list (cdr pn))) lstponew ) ) (setq lstassoc (cons (substr (car pn) 1 1) lstassoc)) ) (setq lstponew (reverse lstponew)) (while lstassoc (setq lstass (cons (car lstassoc) lstass)) ;flag (setq lstassoc (vl-remove (car lstassoc) lstassoc)) ) (setq n 1) (foreach flag lstass (setq lstPLY nil) (while (setq co (assoc (read flag) lstponew)) (setq lstPLY (append (cadr co) lstPLY)) (setq lstponew (vl-remove co lstponew)) ) (vla-put-color (3DPoly lstPLY *Model*) n) (setq n (1+ n)) ) (RESTORE) (princ) ) Còn đây là bản vẽ Thiep đã test: http://www.cadviet.com/upfiles/2/vd_3_1.dwg 2 Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
vqhnb 0 Báo cáo bài đăng Đã đăng Tháng 9 10, 2009 Nhờ các cao thủ giúp mình một lisp như này. đây là file bản vẽ minh hoạ http://www.cadviet.com/upfiles/2/ghep_text..._doi_cao_do.dwg 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
Thaistreetz 539 Báo cáo bài đăng Đã đăng Tháng 9 10, 2009 Em chào các anh. em muốn hỏi khi viêt lisp muốn chon điểm là điểm gốc của đối tượng dtext thì phải dùng hàm như thế nào? Không biết điểm gốc của đối tượng dtext theo ý bạn là điểm nào trong 2 điểm sau: - điểm bắt đầu của đối tượng Dtext, nó nằm ở góc dưới bên trái mỗi đối tượng dtext. Điểm này có mã DXF là 10 - điểm Justify của đối tượng Dtext, nó nằm ở một trong các vị trí: Left, center, right, top left, top center ... của text. Điểm này có mã DXF là 11. Mình lấy ví dụ cho trường hợp 1 nhé. trường hợp 2 cũng tương tự. (setq DT (entsel "\nChon text"))(setq Pt (cdr(assoc 10 (entget(car DT))))) @vqhnb: Lisp bạn cần mình nhớ ở diễn đàn đã có. bạn PHẢI TÌM KIẾM TRƯỚC khi post yêu cầu nhé (dùng hộp thoại tìm kiếm). nếu vì một lý do nào đó lisp đã có trên diễn đàn chưa phù hợp với nhu cầu của bạn thì hãy post yêu cầu đê mọi người sửa giúp bạn. 2 Chia sẻ bài đăng này Liên kết tới bài đăng Chia sẻ trên các trang web khác
conghoan1003 0 Báo cáo bài đăng Đã đăng Tháng 9 11, 2009 Chào CH1003, Lisp chỉnh sửa này sẽ cho phép người dùng tự tạo một file mới để ghi dữ liệu, nếu chọn file có sẵn nó sẽ ghi dữ liệu đè lên file cũ. Nên nhớ rằng lisp yêu cầu mở thư mục để tạo file trước khi yêu cầu người dùng pick point: (defun SAVE_MODE () (command "UCS" "W" "") (setq OLD_OSMODE (getvar "OSMODE")) (setvar "cmdecho" 0) (setvar "blipmode" 1) ) (defun RESTORE () (setvar "osmode" OLD_OSMODE) (setvar "cmdecho" 1) (setvar "blipmode" 0) ) (defun c:gtd (/ ST fn f x1 y1) (setq fn (getfiled "Tao file ghi toa do: " "D:/" "tdo" 1)) (setq f (open fn "w")) (setq ST 1) (SAVE_MODE) (setvar "osmode" 0) (while (setq pt (getpoint "Pick point: ")) (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) (RESTORE) (redraw) (print) ) Lisp tạm thời mở hộp thoại "tạo file ghi toa do" tại thư mục gốc là D:, còn người dùng muốn ghi vào đâu thì tùy, còn muốn thường xuyên ghi vào 1 thư mục nào đó, thì sửa lại dòng này: "D:/" Ví dụ, CH1003 muốn ghi vào thư mục đã có sẵn: "E:/Conghoan1003/data/" chẳng hạn. Còn trên máy người dùng chưa có thư mục như ví dụ trên, thì lisp sẽ mở thư mục "My documents" :s_big: Cảm ơn Thiêp nha! Lisp chạy tốt lắm. Thiep có thể làm thêm mình một cái nữa nhé, Mình muốn kết hợp lisp đánh số thứ tự của các point và sau đó xuất các toạ độ của các point này ra một file .tdo. Fiile .tdo gồm có stt (là số vừa đánh) và toạ độ của point. Toạ độ thì có 2 sự chọn lựa 2D (x,y) hay 3D(x,y,z) tuỳ chọn. Lisp đánh số thứ tự point (sưu tầm từ cadviet) nè: http://www.cadviet.com/upfiles/2/stt_point_sttp.lsp Cái lisp đánh số thứ tự này đánh từ trái sang phải, Thiep có thể chỉnh lại để nó sắp xếp từ trên xuống cho mình với, mình cần đánh số thứ tự từ trên xuống. Cảm ơn nhiều! Chúc Thiep sức khoẻ! 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