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

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ẻ!

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

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"

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!

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!

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

p5

"w"

2

0

p6

""

Những con số màu đỏ ở trên, bạn thử thay số khác xem?

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ẻ!

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!

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!

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.

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

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)

)

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!

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:

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 đỡ!

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!

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

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!

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)

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:

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

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?

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

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

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.

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ẻ!

Đăng nhập

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

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

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

thiep 365

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 365

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

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

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 365

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 365

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

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

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

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 365

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

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

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

truongthanh 7

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 3.912

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

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 365

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 365

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 3.912