Chuyển đến nội dung
Diễn đàn CADViet

thiep

Thành viên
 Xem Hồ Sơ  Xem hoạt động của họ

  • Số lượng nội dung

    514

  • Đã tham gia

  • Lần ghé thăm cuối

  • Ngày trúng

    48

Bài đăng được đăng bởi thiep

  2. Đã đăng · Trả lời báo cáo

    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?

    • Vote tăng 2

  3. Đã đăng · Trả lời báo cáo

    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"

    • Vote tăng 1

  4. Đã đăng · Trả lời báo cáo

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

    • Vote tăng 3

  5. Đã đăng · Trả lời báo cáo

    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.com/upfiles/2/thongso.dwg

    http://www.cadviet.com/upfiles/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

    • Vote tăng 1

  6. Đã đăng · Trả lời báo cáo

    Mình tìm trên diễn đàn cái lisp ghi toa độ mà chưa tìm được cái đúng ý mình, Nhờ các bác sửa giúp mình cái lisp này với, hiện mình đang dùng nhưng lại có 2 điểm bấc tiện thế này:

    1. Nó tự động lưu file .tdo vào nơi nào đó tuỳ thích, có lúc tìm hoài chẳng thấy luôn.

    2. Mỗi lần kích điểm thì phải đặtt tên điểm, mình muốn nó tự đông nhảy từ 1 sau đó lên 2 rồi 3.4.5.6...

    .....

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

    • Vote tăng 2

  7. Đã đăng · Trả lời báo cáo

    Chào thiep

    Mọi sự chia sẻ kiến thức và kinh nghiệm cho nhau không bao giờ là muộn màng cả và điều đó vô cùng đáng quý.

    Nếu có thể Thiep có thể vui lòng cho Tue_NV thêm 1 ví dụ về hàm này được không?

    Thanks

    Chào Tue_NV, đây là 1 đoạn mã lisp dùng để xác định trên 1 LWPOLYLINE hay POLYLINE có đoạn arc hay không:

    (defun c:bul (/ obj n i bul)
 (setq	obj (vlax-ename->vla-object (car (entsel "\nPick a polyline")))
n   (fix (vlax-curve-getEndParam obj))
i   0
 )
 (terpri)
 (repeat n
   (setq bul (vla-getbulge obj i))
   (if	(/= bul 0)
     (progn
(princ (Strcat "Tai vi tri node "
	       (itoa i)
	       " co 1 arc voi do cong la: "
	       (rtos bul 2 3) "\n"
       )
)
(terpri)
     )
   )
   (setq i (1+ i))
 )
 (princ)
 (textscr)
)

     

     

    Cảm ơn bạn Thiep, mình sẽ ứng dụng hàm này vào công việc của mình. Chắc là bạn đã biết rồi nhưng mình nói luôn ý nghĩa tham số độ cong:

    Là tỷ số giữa chiều đoạn thẳng nối hai trung điểm dây cung và cung tròn và chiều dài 1/2 dây cung đó. Nếu giá trị độ cong >0 : cung tròn polyline theo ngược chiều kim đồng hồ, ngược lại cùng chiều kim đồng hồ.

    Cảm ơn dangbaoduy1982, lâu nay Thiep cứ ngờ ngợ độ cong này là tan của 1 góc nào đó, bây giờ nhờ dangbaoduy1982 mình mới hiểu được tham số này.

    Nhân tiện, cho Thiep hỏi, các anh em nào hiểu rõ về hàm vlax-curve-getSecondDeriv như thế nào không ạ? Thiep nghĩ nó là giá trị đạo hàm bậc 2 tại 1 điểm trên Curve có phải không? Ứng dụng nó như thế nào? Nếu được cho mình 1 ví dụ.

  8. Đã đăng · Trả lời báo cáo

    Đây là dữ liệu của một đường PL gồm một đoạn thẳng và một đoạn cong. Chú ý rằng mỗi đỉnh PL đều có mã DXF 42. Nếu giá trị mã này khác 0 thì phân đoạn ngay sau đỉnh đó là đoạn cong.

    ((-1 . ) (0 . LWPOLYLINE) (330 .

    7ef69cf8>) (5 . 224F32) (100 . AcDbEntity) (67 . 0) (410 . Model) (8 .

    CAODODAYCONG) (100 . AcDbPolyline) (90 . 3) (70 . 0) (43 . 0.0) (38 . 0.0) (39

    . 0.0) (10 2391.15 -3135.52) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 2464.21

    -3061.75) (40 . 0.0) (41 . 0.0) (42 . -0.475185) (10 2609.54 -3075.87) (40 .

    0.0) (41 . 0.0) (42 . 1.92085) (210 0.0 0.0 1.0))

     

    Lệnh truy cập dữ liệu của một đối tượng:

    ;Ham xem du lieu doi tuong phuc

    (defun C:OBDT(/ ent)

    (setq ent (car(entsel "Chon doi tuong phuc : ")))

    (princ "\n")

    (while (/= (cdr(assoc 0 (entget ent))) "SEQEND")

    (princ (entget ent))

    (setq ent(entnext ent))

    (princ "\n")

    )

    (princ (entget ent))(princ)

    )

    ;Truy du lieu doi tuong

    (defun C:OBDT1(/ ent)

    (setq ent (car(entsel "Chon doi tuong : ")))

    (princ "\n")

    (princ (entget ent))

    (princ)

    )

    Cách của dangbaoduy1982 không hay bằng hàm này đâu. Đó là hàm (vla-getbulge object index), hàm sẽ trả về độ lồi của đoạn cong trên polyline. G288 tạo vòng lặp với n là số node, khi nào (vla-getbulge object index) /= 0 có nghĩa là tại index đó có đoạn cong (arc)

    Từ lâu, thiep đã biết hàm này, bây giờ thiep mới reply, không biết có muộn màng không?

    • Vote tăng 1

  9. Đã đăng · Trả lời báo cáo

    Cám ơn Tuệ nhé lisp bạn chỉnh cho mình chạy ok thực sự cảm ơn sự nhiệt tình của Tuệ và các thành viên trong diễn đàn đã giúp đỡ mình lisp đó của bạn chạy đúng như ý tớ. Nhưng khi mình làm thì nảy sinh một vấn đề là khi mình chỉnh lại cao độ đường 3d polyline thì phải chạy lại lisp ý mình muốn thế này khi chỉnh lại cao độ đường 3d polyline thì chỉ cần chỉnh ở dạng text là cao độ đường 3d polyline cũng thay đổi theo không cần vào PROPERTIES hay chạy lại lisp nữa, mình muốn hiện cao độ ở dạng text có ý là như vậy. Nhưng thực sự lisp của bạn đã giúp tớ rất nhiều. Cám ơn bạn nhé :s_big:

    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

  10. Đã đăng · Trả lời báo cáo

    Chào bạn Thiep minh rất vui khi bạn viết cho mình một Lisp thay doi do cao cac node cua POLYLINE, đúng như bạn nói đường polyline của mình có tới vài trục các node làm như thế quả là lâu thật, theo ý bạn thì phải chuyển toạ độ ra excell và xây dựng một lisp khác là như thế nào bạn có thể hướng dẫn chi tiết hơn được không. Nhân tiện cho mình hỏi là lisp trên bạn có thể sửa được là khi Pick a point on Polyine: thì các node tự động chuyển đến để ta có thể thêm cao độ vào các node và nếu các node hiện lên cao độ dạng text thì càng tốt lúc đầu là 0.00 sau đó tuỳ người dùng chỉnh sửa. Rất cảm ơn bạn.

    Chào Tuynh,

    Bạn hãy tạo 1 ví dụ bảng excel chứa dữ liệu, gồm n cột, trong đó phải có 4 cột: tên node, X, Y, Z. Dữ liệu có hàng chục điểm như bạn nói hoặc nhiều hơn nữa. Upload lên, và Thiep sẽ gửi cho bạn 1 lisp tạo đường 3Dpolyline.

    Còn ý tưởng 2: có phải bạn muốn nói thêm node trên polyline không? chứ các node tự động chuyển đến là sao?

    Chỉ thêm text độ cao tại vị trí thêm node trên polyline hay thêm text toàn bộ các node của polyline?

  11. Đã đăng · Trả lời báo cáo

    Khi mình vẽ đến lúc select đối tượng rất khó khăn khi phải zoom quá nhiều, các ban nào có lisp cad mà khi move hay copy thì crosshair size không hiện ô vuông mà nó chỉ hiện hai đường dẫn không cho mình xin với. Cám ơn nhiều. Bạn nào có thì cho minh xin nhé, gửi giúp mình vào kts.duc274@gmail.com ai gửi cho minh thi minh xin luôn số DT nhé. mình muốn mời uống nước để anh em giao lưu. ( cám ơn các bạn đã đọc và giúp mình)

    daknong nói rõ hơn được không? Tôi chưa từng gặp trường hợp nào khi chọn đối tượng mà lại hiện "hai đường dẫn"???

  12. Đã đăng · Trả lời báo cáo

    Tuynh:

    Mình đưa file lên đây

    http://www.cadviet.com/upfiles/2/2d3d.dwg

    đường 2d poline có cao độ là 10, đường 3d poline có cao độ khác nhau tại các điểm point, bạn có lisp nào mà khi pick vào đường

    2d poline thì tại các điểm point hiện cao độ cho mình nhập theo ý muốn và đường 2d poline chuyển thành 3d poline.

     

    Chào Tuynh, lisp sau đây, yêu cầu Bạn pick các node của polyline sẽ biến 2D polyline thành 3D polyline. Sau đó bạn tiếp tục thay đổi độ cao các node của 3d polyline

    ;;; Lisp thay doi do cao cac node cua POLYLINE
;;; copyright by Thiep 7/2009
;;; yeu cau: cai dat day du Expresstools 
;;;--------------------------
(defun DXF (code en) (cdr (assoc code (entget en))))
;;;---------------------
(defun SAVE_MODE ()
 (command "UCS" "W" "")
 (setq	OLD_OSMODE    (getvar "OSMODE")
OLD_CECOLOR   (getvar "CECOLOR")
OLD_AUTOSNAP  (getvar "AUTOSNAP")
OLD_ORTHOMODE (getvar "ORTHOMODE")
 )
 (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 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)
)
;;;-----------------------------------
(vl-load-com)
(defun c:3dp (/ ActDoc *Model* wp lwp Obj n pn pcl Pe lstP Elev lt lstN)
 (SAVE_MODE)
 (setvar "osmode" 1)
 (setq	ActDoc	(vla-get-ActiveDocument (vlax-get-acad-object))
*Model*	(vla-get-ModelSpace ActDoc)
 )
 (while (setq pn (getpoint "\nPick a point on Polyine: "))
   (setq lwp (ssname (ssget pn) 0))
   (redraw lwp 3)
   (setq heinode (getreal "\nEnter height of node: ")
  obj	  (vlax-ename->vla-object lwp)
  lstP (ACET-GEOM-VERTEX-LIST lwp)
   )
   (if	(eq (dxf 0 lwp) "LWPOLYLINE")
     (progn
(setq Elev (vla-get-Elevation obj))
(setq lstN nil)
(foreach lt lstP
  (if (and (eq (car lt) (car pn)) (eq (cadr lt) (cadr pn)))
    (setq lt (list (car lt) (cadr lt) heinode))
    (setq lt (list (car lt) (cadr lt) Elev))
  )
  (setq lstN (append lt lstN))
)
(vla-update (3DPoly lstN *Model*))
(vla-delete obj)
     )
     (progn
(setq lstP (ACET-GEOM-VERTEX-LIST lwp))
(setq lstN nil)
(foreach lt lstP
  (if (and (eq (car lt) (car pn)) (eq (cadr lt) (cadr pn)))
    (setq lt (list (car lt) (cadr lt) heinode))
  )
  (setq lstN (append lt lstN))
)
(vla-update (3DPoly lstN *Model*))
(vla-delete obj)
     )
   )
 )
 (RESTORE)
 (princ "\nChuc cac ban vui ve! Thiep")
 (princ)
)

    Tuy nhiên, nếu bạn thay đổi 1 polyline có hàng 100 node thì nên dùng cách khác nhanh hơn: Dùng bảng kê tọa độ trong Excel đổi qua đuôi *.csv, sau đó xây dựng 1 3D polyline theo 1 lisp khác.

    • Vote tăng 1

  13. Đã đăng · Trả lời báo cáo

    tại vì mình nghĩ trong chương trình của bác Hoành mục đích chính là nối text TEN DIEM với text CODE để tạo thành 1 text duy nhất, (và đoạn này mình nghĩ đã bị ai xoá đi mất tiêu, còn đoạn nối TEN DIEM với CODE có tên trùng với TEN DIEM chỉ là để thông báo cho người dùng biết. Chính vì thế mà mình với thay đổi Lisp của bác ấy. Vả lại mình cũng nói với bác ấy nếu mình có thay đổi công năng chương trình của bác thì bác cứ góp ý phê bình mà. Dẫu sao thì mình cũng cảm ơn sự góp ý của bạn, còn chuyện biết Pass với sửa được thì bạn hoàn toàn hiểu sai ý của mình, chẳng lẽ đoạn lisp nào post lên mạng đều phải biết pass mới sửa được hay sao?

    Ví dụ nhé, Bạn thử xem bài post của Thiep:

    http://www.cadviet.com/forum/index.php?s=&...ost&p=71615

    Ngày mai Thiep sẽ update lại lisp này để áp dụng cho các kiểu curve ở 2 đầu trụ và chỉ có Thiep mới edit lại được. Tomboy xem có khác nhau không? và Tomboy có thể edit bài post của Thiep được không?

  14. Đã đăng · Trả lời báo cáo

    Nhờ các bác cao thủ viết giúp em LISP có yêu cầu như thế này:

    1.Khi thực hiện lệnh, ta có thể vẽ đồng thời 2 đường line hay 2 đường polyline, hoặc arc...với khoảng cách của 2 đường và màu sắc có thể thay đổi do người dùng.VD: khi vẽ, tạo ra đồng thời 2 đường line, line 1 màu số 4, line 2 màu số 8

    Lisp bạn cần có phản cái này không?

    ;;; Lisp tao 2 duong song song
(defun co (p1 p2 k / flag)
 (if (or (< (car p1) (car p2)) (< (cadr p1) (cadr p2)))
   (setq flag (- k))
   (setq flag k)
 )
 flag
)
(defun  c:d2c (/ )
 (setq	bit1 (cond (bit1)
	  ("Line")
    )
 )
 (initget "Line Pline Spline Arc Circle Ellipse")
 (setq	tmp1 (strcat "\nBan ve duong gi? [Line/Pline/Spline/Arc/Circle/Ellipse] <" bit1 ">: ")
bit1    (cond ((getkword tmp1))
	     (bit1)
       )
 )
 (setq	bit2 (cond (bit2)
	  ("Giua")
    )
 )
 (initget "Tren Duoi Giua")
 (setq	tmp2 (strcat "\nDiem pick nam duong Tren, duong Duoi hay Giua 2 duong? [Tren/Duoi/Giua] <" bit2 ">: ")
bit2    (cond ((getkword tmp2))
	     (bit2)
       )
 )
 (setq	k (cond (k)
	       (5)
	 )
 )
 (setq oldk k)
 (setq
   k (getreal
       (strcat "\nKhoang cach 2 duong <"
	       (rtos oldk 2 1)
	       "> : "

       )
     )
 )
 (if (null k)
   (setq k oldk)
 )

 (cond	((eq bit1 "Line")
 (command ".Line" pause pause)
)
((eq bit1 "Pline")
 (setq p1 (getpoint "\nPick diem dau"))
 (command ".PLine" p1)
 (while (setq p1 (getpoint p1 "\nPick diem tiep theo:"))
 (command p1)
   )
 (command "" "")
)
((eq bit1 "Spline")
 (setq p1 (getpoint "\nPick diem dau"))
 (command ".SPLine" p1)
 (while (setq p1 (getpoint p1 "\nPick diem tiep theo:"))
 (command p1)
   )
 (command "" "" "")
)
((eq bit1 "Arc")
 (command ".Arc" pause pause pause)
)
((eq bit1 "Circle")
 (command ".Circle" pause pause)
)
((eq bit1 "Ellipse")
 (command ".Ellipse" pause pause pause)
)
 )
 (setq	en  (entlast)
OBJ (vlax-ename->vla-object en)
pA (vlax-curve-getStartPoint en)
pB (vlax-curve-getEndPoint en)
 )

 (cond	((eq bit2 "Tren")
  (setq flag (co pA pB (- k)))
  (setq
    objLW1 (car	(vlax-safearray->list
		  (vlax-variant-value (vla-offset obj flag))
		)
	   )
  )
  (vla-put-color obj acCyan)
  (vla-put-color objLW1 8)
)
((eq bit2 "Duoi")
  (setq flag (co pA pB k))
  (setq
    objLW1
     (car (vlax-safearray->list
	    (vlax-variant-value (vla-offset obj flag))
	  )
     )
  )
  (if (/= (car p1) (car p2))
    (progn
      (vla-put-color obj acCyan)
      (vla-put-color objLW1 8)
    )
    (progn
      (vla-put-color obj 8)
      (vla-put-color objLW1 acCyan)
    )
  )
)
((eq bit2 "Giua")
  (setq	objLW1 (car (vlax-safearray->list
		      (vlax-variant-value
			(vla-offset obj (/ k 2))
		      )
		    )
	       )
  )
  (setq	objLW2 (car (vlax-safearray->list
		      (vlax-variant-value
			(vla-offset obj (/ (- k) 2))
		      )
		    )
	       )
  )
  (vla-delete obj)
  (vla-put-color objLW1 acCyan)
  (vla-put-color objLW2 8)
)
 )
 (princ)
)
;;; copyright by Thiep 9/2009

    • Vote tăng 1

  16. Đã đăng · Trả lời báo cáo

    do số liệu của bạn không đúng, bạn xem lại bản vẽ này nhé: http://www.cadviet.com/upfiles/2/tra_loi_ban_kamezoko.dwg

    @tomboy, @kamezoko

    Tomboy đưa ra lisp JD tuy thiep chưa chạy thử, nhưng Thiep hiểu là Tomboy muốn joint các ký tự trong text sao cho dấu chấm thập phân trùng với điểm đo chi tiết trong trắc địa.

    Còn lisp JD của bác Hoanh là để tạo line nối các điểm đo chi tiết sao cho nó có cùng kiểu seri Code.

    Làm sao mà giống nhau được?!! Tomboy nói ai đó đã táy máy sửa lại lisp JD của bác Hoanh có nghĩa ai đó đã biết được pass của bác Hoành (ngoại trừ bác Hoành đã táy máy làm điều này)!!! Lần sau nhớ nói cho đúng bạn ạ.

    Kamezoko chỉ cần sửa lại đoạn này không có các khoảng trống giữa "< OR" hay "< AND"

    Có lẻ bị lỗi khi đưa lisp vào CODEBOX, nó tự động tách ra thôi.

    • Vote tăng 1

  17. Đã đăng · Trả lời báo cáo

    Chào đại gia đình CADVIET và các cao thủ NOVA...

    Em có một thắc mắc khi chạy Trắc Ngang trong NOVA xin các bác chỉ giáo.

    Trên một trắc ngang tự nhiên thì nova chỉ vẽ số các điểm chi tiết (cũng là các đường dóng, ghi chú cao độ.) bằng số các điểm chi tiết đo thự tế, vì vậy khoảng cách giữa các điểm chi tiết trên một mặt cắt ngang có khi tới hàng trục mét. Một câu hỏi đặt ra là: Liệu NOVA có thể vẽ Trắc NGANG có khoảng cách bất kỳ do người dùng đặt không?( chẳng hạn trên một trắc ngang cứ 2m em muốn vẽ một điểm chi tiết)

    Rất mong các cao thủ hướng dẫn. cụ thể

    (em đang dùng NOVA TD16 cad 2005)

    TRÂN TRỌNG.

    Bạn load bản vẽ trắc ngang tự nhiên của bạn xem và nhớ xem lại chính tả khi viết bài nhé

  18. Đã đăng · Trả lời báo cáo

    sao em dùng file lisp thì khi "pick line dau tru" xong,rồi đến"pick line cuoi tru" pick xong thì nó hiện ra "Pick Line cuoi tru: ; error: no function definition: VLAX-CURVE-GETSTARTPOINT". Không biết em có làm sai cái gì không .Bác hướng dẫn em với.Và cũng rất cảm ơn bạn haanh ,cách của bạn cũng rất hay,nhưng làm như thế cũng hơi lâu.

    Có thể bạn dùng cad2004 trở về trước.

    Lisp sau đây Thiep đã update:

    ;;;---------------------------------
;;; LISP chieu hinh tru. COPYRIGHT BY THIEP
;;; FREE FROM CADVIET.COM-----------
(defun GiaoDT (ob1 ob2 / ob1 ob2 g L n kq)
 (setq	g (vlax-variant-value
      (vla-IntersectWith ob1 ob2 acExtendnone)
    )
 )
 (if (/= (vlax-safearray-get-u-bound g 1) -1)
   (setq L (vlax-safearray->list g))
 )
 (setq n 0)
 (repeat (/ (length L) 3)
   (setq kq
   (append (list (list (nth n L) (nth (+ n 1) L) (nth (+ n 2) L)))
	   kq
   )
   )
   (setq n (+ n 3))
 )
 kq
)
;;;----------------------
(defun Xline (ModelS poR1 poR2)
 (vla-AddXline
   ModelS
   (vlax-3d-point poR1)
   (vlax-3d-point poR2)
 )
)
;;;----------------------
(defun line (ModelS poR1 poR2)
 (vla-Addline
   ModelS
   (vlax-3d-point poR1)
   (vlax-3d-point poR2)
 )
)
;;;--------------------------
(defun SAVE_MODE ()
 (command "Undo" "begin")
 (command "UCS" "W" "")
 (setq	OLD_OSMODE    (getvar "OSMODE")
OLD_CECOLOR   (getvar "CECOLOR")
OLD_AUTOSNAP  (getvar "AUTOSNAP")
OLD_ORTHOMODE (getvar "ORTHOMODE")
 )
 (setvar "cmdecho" 0)
 (setvar "plinegen" 1)
 (setvar "OSMODE" 0)
)
(defun RESTORE ()
 (command "Undo" "end")
 (setvar "osmode" OLD_OSMODE)
 (setvar "AUTOSNAP" OLD_AUTOSNAP)
 (setvar "ORTHOMODE" OLD_ORTHOMODE)
 (setvar "CECOLOR" OLD_CECOLOR)
 (setvar "cmdecho" 1)
)
(vl-load-com)
(defun c:ctru (/ enL1 enL2 obj1 obj2 p1 p2 pa1 pa2 pb1 pb2 d1 d2 an1 an2 n dis1 dis2 a tam)
 (SAVE_MODE)
 (setq	ActDoc	(vla-get-ActiveDocument (vlax-get-acad-object))
*Model*	(vla-get-ModelSpace ActDoc)
 )
 (setq enL1 (car (entsel "\nPick curve DAU tru: ")))
 (while (null enL1)
   (princ "\nKhong dung curve DAU tru, chon lai:")
   (setq enL1 (car (entsel "\nPick curve DAU tru: ")))
 )
 (setq enL2 (car (entsel "\nPick curve CUOI tru: ")))
 (while (null enL2)
   (princ "\nKhong dung curve CUOI tru, chon lai:")
   (setq enL2 (car (entsel "\nPick curve CUOI tru: ")))
 )
 (setq obj1 (vlax-ename->vla-object enL1)
obj2 (vlax-ename->vla-object enL2)
Pa1  (vlax-curve-getStartPoint enL1)
lay  (cdr (assoc 8 (entget enL1)))
Pb1  (vlax-curve-getEndPoint enL1)
D1   (distance Pa1 Pb1)
Pa2  (vlax-curve-getStartPoint enL2)
Pb2  (vlax-curve-getEndPoint enL2)
D2   (distance Pa2 Pb2)
an1  (angle Pa1 Pb1)
an2  (angle Pa2 Pb2)
n    1
 )
 (setq	k (cond	(k)
	(24)
  )
 )
 (setq oldk k)
 (setq	k
 (getint
   (strcat "\n So khoang chia:  <"
	   (itoa oldk)
	   "> : "
   )
 )
 )
 (if (null k)
   (setq k oldk)
 )
 (command "undo" "be")
 (setvar "clayer" lay)
 (setq	bit (cond (bit)
	  ("No")
    )
 )
 (initget "Yes No")
 (setq	Tmp (strcat "\nBan có muôn thay doi mau sac line không? [Yes/No] <" bit ">: ")
bit    (cond ((getkword Tmp))
	     (bit)
       )
 )
(if (inters Pa1 Pa2 Pb1 Pb2)
   (progn
     (setq tam pa2
    pa2 pb2
    pb2 tam
    	    an2  (angle Pa2 Pb2)
     )
   )
 )
;;;---------------------------------------
 (repeat (- k 1)
   (setq a    (* n (/ pi k 2))
  dis1 (* D1 (sin a) (sin a))
  dis2 (* D2 (sin a) (sin a))
   )
   (setq p1 (polar pa1 an1 dis1)
  p2 (polar pa2 an2 dis2)
   )
   (setq objXL (Xline *Model* p1 p2))
(setq pk1 (car (giaoDT obj1 objXL))
      pk2 (car (giaoDT obj2 objXL)))
   (vla-delete objXL)
   (if	(eq bit "No")
     (progn
(entmake (list (cons 0 "LINE")
	       (cons 10 pk1)
	       (cons 11 pk2)
	 )
)
     )
     (progn
(IF (>= n (fix (/ k 2)))
  (setq as (cons 62 (- k n)))
  (setq as (cons 62 n))
)
(entmake (list (cons 0 "LINE")
	       (cons 10 pk1)
	       (cons 11 pk2)
	       as
	 )
)
     )
   )
   (setq n (1+ n))
 )
 (command "undo" "end")
 (RESTORE)
 (princ)
)

    Chúc mọi người vui vẻ.

    • Vote tăng 1

  19. Đã đăng · Trả lời báo cáo

    Xin lỗi anh là Nam hay nữ ??? Có một vấn đề nhỏ sao anh trình bầy cứ như là ...lần đầu tiên đến nhà ra mắt bố mẹ vợ tương lai ứ!

    Theo câu chữ của anh thì người ta có thể vẽ hình chiếu của của nước thải trong cống hình trụ thẳng đứng như sau:

    ncthi11231452142877725225544.jpg

     

    Hình ảnh em là hình tròn (mặt bằng), em vẽ đa giác 24 cạnh > Dóng lên mặt đứng> Chỉ đơn giản vậy thôi! Ko biết có đúng ý của anh ko???

    Haanh mới ở Hà Tiên về, sao mà nóng nảy vậy? Đi xa về làm cho hình ảnh của em tròn vo rồi!

    Nói đùa vậy thôi, vẫn có mã lisp cho tuyluypden và cho các bạn đây:

    ;;;---------------------------------
;;; LISP chieu hinh tru. COPYRIGHT BY THIEP
;;; FREE FROM CADVIET.COM-----------
(defun SAVE_MODE ()
 (command "Undo" "begin")
 (command "UCS" "W" "")
 (setq	OLD_OSMODE    (getvar "OSMODE")
OLD_CECOLOR   (getvar "CECOLOR")
OLD_AUTOSNAP  (getvar "AUTOSNAP")
OLD_ORTHOMODE (getvar "ORTHOMODE")
 )
 (setvar "cmdecho" 0)
 (setvar "plinegen" 1)
 (setvar "OSMODE" 0)
)
(defun RESTORE ()
 (command "Undo" "end")
 (setvar "osmode" OLD_OSMODE)
 (setvar "AUTOSNAP" OLD_AUTOSNAP)
 (setvar "ORTHOMODE" OLD_ORTHOMODE)
 (setvar "CECOLOR" OLD_CECOLOR)
 (setvar "cmdecho" 1)
)
(defun c:ctru ()
 (SAVE_MODE)
 (setq	enL1 (car (entsel "\nPick Line dau tru: "))
enL2 (car (entsel "\nPick Line cuoi tru: "))
Pa1  (vlax-curve-getStartPoint enL1)
lay  (cdr (assoc 8 (entget enL1)))
Pb1  (vlax-curve-getEndPoint enL1)
D1   (distance Pa1 Pb1)
Pa2  (vlax-curve-getStartPoint enL2)
Pb2  (vlax-curve-getEndPoint enL2)
D2   (distance Pa2 Pb2)
an1  (angle Pa1 Pb1)
an2  (angle Pa2 Pb2)
n    1
 )
 (setq	k (cond	(k)
	(5)
  )
 )
 (setq oldk k)
 (setq	k
 (getint
   (strcat "\n So khoang chia:  <"
	   (itoa oldk)
	   "> : "
   )
 )
 )
 (if (null k)
   (setq k oldk)
 )
 (command "undo" "be")
 (setvar "clayer" lay)
 (repeat (- k 1)
   (setq a    (* n (/ pi k 2))
  dis1 (* D1 (sin a) (sin a))
  dis2 (* D2 (sin a) (sin a))
  p1   (polar pa1 an1 dis1)
  p2   (polar pa2 an2 dis2)
   )
   (entmake (list (cons 0 "LINE")
	   (cons 10 p1)
	   (cons 11 p2)
     )
   )
   (setq n (1+ n))
 )
 (command "undo" "end")
 (RESTORE)
 (princ)
)

    • Vote tăng 1

  20. Đã đăng · Trả lời báo cáo

    Cái này mình biết rồi, mình chỉ đổi lệnh lại để cho tiện sử dụng thôi. Mình cũng chẳng hiểu tại sao không biết lệnh mà lại yêu cầu như thế nửa, mà thiệp test trên cad nào vậy?

    Thiep dùng cad2007 giống nhau, Tiếc là mình không đưa ảnh như NATACA được, bạn xem ảnh động sẽ thấy lisp VBU làm việc tại máy Thiep, link sau đây:

    http://www.cadviet.com/upfiles/2/vetbun.gif

    Ngoài ra ý tưởng 2 của Hoan, Thiep cũng đã test xong:

    ;;;---------------------------------
;;; LISP vet bun (ver 2.0), COPYRIGHT BY THIEP
;;; FREE FROM CADVIET.COM-----------
(defun GiaoDT (e1 e2 / ob1 ob2 g L n kq)
 (setq	ob1 (vlax-ename->vla-object e1)
ob2 (vlax-ename->vla-object e2)
g   (vlax-variant-value
      (vla-IntersectWith ob1 ob2 acExtendnone)
    )
 )
 (if (/= (vlax-safearray-get-u-bound g 1) -1)
   (setq L (vlax-safearray->list g))
 )
 (setq n 0)
 (repeat (/ (length L) 3)
   (setq kq
   (append (list (list (nth n L) (nth (+ n 1) L) (nth (+ n 2) L)))
	   kq
   )
   )
   (setq n (+ n 3))
 )
 kq
)
(defun LWP (Lpoint *Model* / PntArr)
 (setq	PntArr (vlax-make-safearray
	 vlax-vbDouble
	 (cons 0 (1- (length Lpoint)))
       )
 )
 (vlax-safearray-fill PntArr Lpoint)
 (vla-AddLightWeightPolyline *Model* PntArr)
)
;;;-----------------------
(defun SS-enlst	(ss / c L)
 (setq c -1)
 (repeat (sslength ss)
   (setq L (cons (ssname ss (setq c (1+ c))) L))
 )
 (reverse L)
)
;;;----------------------
(defun taoRay (ModelS poR1 poR2)
 (vla-Addray
   ModelS
   (vlax-3d-point poR1)
   (vlax-3d-point poR2)
 )
)

				;-----------------------
(defun TextTaluy (model k po h ang / obj)
 (setq	obj (vla-AddText
      *Model*
      (strcat "1:" (rtos k 2 1))
      (vlax-3d-point po)
      h
    )
 )
 (vla-put-Alignment obj acAlignmentTopCenter)
 (vla-put-TextAlignmentPoint obj (vlax-3d-point po))
 (vla-put-Rotation obj ang)
 (vla-put-layer obj "vetbun")
)
;;;---------------------
(defun SAVE_MODE ()
 (command "UCS" "W" "")
 (setq	OLD_OSMODE    (getvar "OSMODE")
OLD_CECOLOR   (getvar "CECOLOR")
OLD_AUTOSNAP  (getvar "AUTOSNAP")
OLD_ORTHOMODE (getvar "ORTHOMODE")
 )
 (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 DXF (code en) (cdr (assoc code (entget en))))
;;; -------------------------------
(defun existLinetype (doc LineTypeName / item loaded)
 (vlax-for item (vla-get-linetypes doc)
   (if	(= (strcase (vla-get-name item)) (strcase LineTypeName))
     (setq loaded T)
   )
 )
)
;;;------loadLinetype
(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
 )
)
;;;--------------------------
(defun lstvexter (obj / lstp)
 (setq	lstp (vlax-safearray->list
       (vlax-variant-value (vla-get-Coordinates obj))
     )
 )
 (setq n 0)
 (repeat (/ (length lstp) 2)
   (setq kqp
   (cons (list (nth n lstp) (nth (+ n 1) lstp) 0.0)
	 kqp
   )
   )
   (setq n (+ n 2))
 )
 kqp
)
;;;--------------------------
(vl-load-com)

;;;================================MAIN=============================
(DEFUN c:vbu (/	     ActDoc *Model*	  *layer*	en     ss
      p1     Pa	    Pb	   p1	  p11	 p2	p21    p3
      p4     objD   enD	   objR1  objR2	 enR1	enR2   pin1
      pin2   pe1    pe2	   objL2  objL1	 enL1	enL2   lay
      an1    an2    pTex1  pTex2  i	 ss	lop    upp
      un     ofp    intP   enLWP  LenLWP Lllup	LenGH  lstLWp
      Lint   Len    lstp objL2
     )
 (setq	ActDoc	(vla-get-ActiveDocument (vlax-get-acad-object))
*Model*	(vla-get-ModelSpace ActDoc)
*layer*	(vla-get-Layers ActDoc)
 )
 (vla-StartUndoMark ActDoc)
 (SAVE_MODE)
 (setvar "osmode" 0)
 (loadLinetype ActDoc "HIDDEN" "acad.lin")
 (if (not (setq enlay (tblobjname "layer" "vetbun")))
   (progn
     (setq lay (vla-add *layer* "vetbun"))
     (vla-put-color lay acMagenta)
     (vla-put-Linetype lay "HIDDEN")
   )
   (progn
     (setq lay (vlax-ename->vla-object enlay))
     (setq lay (vla-add *layer* "vetbun"))
     (vla-put-color lay acMagenta)
     (vla-put-Linetype lay "HIDDEN")
   )
 )
 (princ "Chon cac curve be mat nao vet: ")

 (setq SS (ssget '((0 . "LWPOLYLINE,LINE"))))
 (if (null k_Thiep1)
   (setq
     k_Thiep1 (getreal "\nChon goc doc nao vet ben PHAI (mau so): ")
   )
 )
 (if (null k_Thiep2)
   (setq
     k_Thiep2 (getreal "\nChon goc doc nao vet ben TRAI (mau so): ")
   )
 )
 (if (null d_Thiep)
   (setq d_Thiep (getreal "\nChieu sau nao vet: "))
 )
 (if (null hei_Thiep)
   (setq hei_Thiep (getreal "\nChon chieu cao chu: "))
 )
 (setq	Len (SS-enlst ss)
i   0
 )
 (foreach en Len
   (if	(and (eq (dxf 0 en) "LWPOLYLINE")
     (eq (strcase (dxf 8 en)) "DUONGTUNHIEN")
)
     (setq LenLWP (cons en LenLWP))
   )
 )
 (foreach enLWP LenLWP
   (redraw enLWP 3)
   (setq objLW	(vlax-ename->vla-object enLWP)
  Lllup	(ACET-ENT-GEOMEXTENTS enLWP)
  lop	(car Lllup)
  upp	(cadr Lllup)
  un	(getvar "viewsize")
  ofp	(list (/ (+ (car upp) (car lop)) 2)
	      (- (cadr lop) un)
	      0.0
	)
   )
   (setq pA (vlax-curve-getStartPoint enLWP)
  pB (vlax-curve-getEndPoint enLWP)
   )
   (if	(< (car pA) (car pB))
     (progn
(setq flag -0.1)
(setq disoff d_Thiep)
     )
     (progn
(setq flag 0.1)
(setq disoff (- d_Thiep))
     )
   )
   (setq objLW1 (car (vlax-safearray->list
		(vlax-variant-value (vla-offset objLW flag))
	      )
	 )
   )
   (setq lstLWp (lstvexter objLW1)
				;(setq lstP	(ACET-GEOM-VERTEX-LIST enLWP)
  ss	 (ssget "F" lstLWp)
  LenGH	 (SS-enlst ss)
  kqp	 nil
   )
   (vla-delete objLW1)
   (foreach enGH LenGH
     (if (and (eq (DXF 0 enGH) "LINE")
       (setq intP (car (GiaoDT enGH enLWP)))
  )
(progn
  (setq Lint (cons intP Lint))
  (setq kq nil)
)
     )
   )
   (setq Lint
   (vl-sort
     Lint
     '(lambda (e1 e2) (< (car e1) (car e2)))
   )
   )
   (setq p1  (car Lint)
  p2  (cadr Lint)
  p11 (list (+ (car p1) k_Thiep1) (- (cadr p1) 1) 0.0)
  p21 (list (- (car p2) k_Thiep2) (- (cadr p2) 1) 0.0)
  an1 (angle p1 p11)
  an2 (angle p2 p21)
   )
;;;================
   (vla-offset objLW disoff)
   (setq enD (entlast))
   (setq objR1	(taoRay *Model* p1 p11)
  objR2	(taoRay *Model* p2 p21)
   )
   (setq enR1 (vlax-vla-object->ename objR1)
  enR2 (vlax-vla-object->ename objR2)
   )
   (setq PA (vlax-curve-getStartPoint enD)
  PB (vlax-curve-getEndPoint enD)
   )
   (setq pin1 (car (giaoDT enR1 enD))
  p11  (car (giaoDT enR1 enLWP))
  pin2 (car (giaoDT enR2 enD))
  p22  (car (giaoDT enR2 enLWP))
  pinR (car (giaoDT enR1 enR2))
  kq   nil
   )
   (cond ((/= p1 p11)
   (setq p1 p11)
  )
  ((/= p2 p22)
   (setq p2 p22)
  )
   )
   (setvar "osmode" 0)
   (if	(< (car pin1) (car pin2))
     (Progn
(vla-delete objR1)
(vla-delete objR2)
(if (< (car PA) (car PB))
  (progn
    (VL-CMDF "_.break" enD pin2 pin2)
    (setq ss (ssname (ssget pin2) 0))
    (entdel ss)
    (setq pe1 (list (+ (car pin1) 0.1) (+ (cadr pin1) 0.1) 0.0)
	  pe2 (list (+ (car pin1) 0.1) (- (cadr pin1) 0.1) 0.0)
	  pe3 (list (- (car pin1) 0.1) (+ (cadr pin1) 0.1) 0.0)
	  pe4 (list (- (car pin1) 0.1) (- (cadr pin1) 0.1) 0.0)
    )
    (setq enD (ssname (ssget pin1) 0))
    (VL-CMDF "_.break" enD pin1 pin1)
    (entdel (ssname (ssget "F" (list pe3 pe4)) 0))
    (setq enD (ssname (ssget "F" (list pe1 pe2)) 0))
  )
  (progn
    (VL-CMDF "_.break" enD pin1 pin1)
    (setq ss (ssname (ssget pin1) 0))
    (entdel ss)
    (setq pe1 (list (+ (car pin2) 0.1) (+ (cadr pin2) 0.1) 0.0)
	  pe2 (list (+ (car pin2) 0.1) (- (cadr pin2) 0.1) 0.0)
	  pe3 (list (- (car pin2) 0.1) (+ (cadr pin2) 0.1) 0.0)
	  pe4 (list (- (car pin2) 0.1) (- (cadr pin2) 0.1) 0.0)
    )
    (setq enD (ssname (ssget pin2) 0))
    (VL-CMDF "_.break" enD pin2 pin2)
    (entdel (ssname (ssget "F" (list pe1 pe2)) 0))
    (setq enD (ssname (ssget "F" (list pe3 pe4)) 0))
  )
)
(setq Lp    (list (car p1)
		  (cadr p1)
		  (car pin1)
		  (cadr pin1)
	    )
      objL1 (LWP Lp *Model*)
      enL1  (vlax-vla-object->ename objL1)
)
(setq Lp    (list (car p2)
		  (cadr p2)
		  (car pin2)
		  (cadr pin2)
	    )
      objL2 (LWP Lp *Model*)
      enL2  (vlax-vla-object->ename objL2)
)
(vl-cmdf ".pedit" "m" enL1 end enL2 "" "j" "" "")
(setq lineNV (vlax-ename->vla-object (entlast)))
     )

     (Progn
(vla-delete objR1)
(vla-delete objR2)
(entdel enD)
(setq Lp (list (car p1)
	       (cadr p1)
	       (car pinR)
	       (cadr pinR)
	       (car p2)
	       (cadr p2)
	 )
)
(setq lineNV (LWP Lp *Model*))
(setq pin1 pinR
      pin2 pinR
)
     )

   )

   (vla-put-layer lineNV "vetbun")
   (vla-put-color lineNV acbylayer)
   (vla-put-LinetypeScale lineNV 2)
   (vla-put-LinetypeGeneration lineNV T)

   (setq pTex1	(polar (acet-geom-midpoint p1 pin1)
	       (- an1 (/ pi 2))
	       (/ hei_Thiep 2)
	)
   )
   (TextTaluy *Model* k_Thiep1 pTex1 hei_Thiep an1)
   (setq pTex2	(polar (acet-geom-midpoint p2 pin2)
	       (+ an2 (/ pi 2))
	       (/ hei_Thiep 2)
	)
   )
   (TextTaluy *Model* k_Thiep2 pTex2 hei_Thiep (+ an2 pi))
   (setq Lint	 nil
  Len	 nil
  lstp	 nil
  LenLWP (cdr LenLWP)
   )
 (vla-Regen ActDoc acActiveViewport)
 )

 (vla-ZoomExtents (vlax-get-acad-object))
 (RESTORE)
 (vla-EndUndoMark ActDoc)
 (princ "\nChuc cac ban thanh cong. Thiep")
 (princ)
)
;;;=============================================================================
=================================
;;;-----------------ham dinh thong so k_Thiep, d_Thiep, hei_Thiep
(defun c:khd ()
 (setq	k_Thiep1 (cond (k_Thiep1)
	       (5)
	 )
 )
 (setq oldk_Thiep1 k_Thiep1)
 (setq
   k_Thiep1 (getreal
       (strcat "\nChon goc doc nao vet ben PHAI (mau so) <"
	       (rtos oldk_Thiep1 2 1)
	       "> : "

       )
     )
 )
 (if (null k_Thiep1)
   (setq k_Thiep1 oldk_Thiep1)
 )
 (setq	k_Thiep2 (cond (k_Thiep2)
	       (5)
	 )
 )
 (setq oldk_Thiep2 k_Thiep2)
 (setq
   k_Thiep2 (getreal
       (strcat "\nChon goc doc nao vet ben TRAI (mau so) <"
	       (rtos oldk_Thiep2 2 1)
	       "> : "

       )
     )
 )
 (if (null k_Thiep2)
   (setq k_Thiep2 oldk_Thiep2)
 )



 (setq	d_Thiep	(cond (d_Thiep)
	      (5)
	)
 )
 (setq oldd_Thiep d_Thiep)
 (setq	d_Thiep	(getreal (strcat "\nChieu sau nao vet <"
			 (rtos oldd_Thiep 2 1)
			 "> : "

		 )
	)
 )
 (if (null d_Thiep)
   (setq d_Thiep oldd_Thiep)
 )
 (setq	hei_Thiep (cond	(hei_Thiep)
		(5)
	  )
 )
 (setq oldhei_Thiep hei_Thiep)
 (setq	hei_Thiep (getreal (strcat "\nChon chieu cao chu <"
			   (rtos oldhei_Thiep 2 1)
			   "> : "

		   )
	  )
 )
 (if (null hei_Thiep)
   (setq hei_Thiep oldhei_Thiep)
 )
 (prinC "\nBay gio ban co the su dung lenh VBU")
 (princ)
 (c:vbu)
)

    Lisp yêu cầu chọn các mằt cắt địa hình (thuộc lớp DUONGTUNHIEN) và các đường giới hạn (LINE) cùng 1 lúc

    • Vote tăng 1

  21. Đã đăng · Trả lời báo cáo

    Mình sử dụng nova, sau khi xuất toạ độ = lệnh cdtep, dùng lưới tam giác và chạy ra được đường đồng mức rồi, kiểm tra cao độ = lệnh CDTN đúng rồi .

     

    Bây giờ nhờ anh em viết cho đoạn lisp pick vào 1 điểm nào đó trên bình đồ thì xuất ra cao độ ở dạng text ngay vị trí đó

    Cám ơn các bác trước nhá.

    Lisp Thiep viết yêu cầu người dùng pick điểm cần xác định độ cao, pick contour thứ 1 gần điểm cần xác định độ cao, pick contour thứ 2 gần điểm cần xác định độ cao:

    ;;; LISP TIM DO CAO DIEM, COPYRIGHT BY THIEP
;;; FREE FROM CADVIET.COM-----------
(defun SAVE_MODE ()
 (command "UCS" "W" "")
 (setq	OLD_OSMODE    (getvar "OSMODE")
OLD_CECOLOR   (getvar "CECOLOR")
OLD_AUTOSNAP  (getvar "AUTOSNAP")
OLD_ORTHOMODE (getvar "ORTHOMODE")
 )
 (setvar "cmdecho" 0)
)
(defun RESTORE ()
 (setvar "osmode" OLD_OSMODE)
 (setvar "AUTOSNAP" OLD_AUTOSNAP)
 (setvar "ORTHOMODE" OLD_ORTHOMODE)
 (setvar "CECOLOR" OLD_CECOLOR)
 (setvar "cmdecho" 1)
)
(defun aLine (ModelS p01 p02)
 (vla-AddLine
   ModelS
   (vlax-3d-point p01)
   (vlax-3d-point p02)
 )
)
(defun aText (model z p0 h TP / obj)
 (setq	obj (vla-AddText
      *Model*
      (rtos z 2 TP)
      (vlax-3d-point p0)
      h
    )
 )
 (vla-put-Alignment obj acAlignmentBottomLeft)
 (vla-put-TextAlignmentpoint obj (vlax-3d-point p0))
)
(defun DXF (code en) (cdr (assoc code (entget en))))
;;;===================
(defun c:heipoint (/ p0	   p01	 p1    p2    p21   p3	 p5    p6
	     p7	   cont1 cont2 obj1  obj2  objL1 objL2 objL3
	     objT  z
	    )
 (SAVE_MODE)
 (setq	ActDoc	(vla-get-ActiveDocument (vlax-get-acad-object))
*Model*	(vla-get-ModelSpace ActDoc)
 )
 (vla-StartUndoMark ActDoc)
 (setq	h (cond	(h)
	(5)
  )
 )
 (setq oldh h)
 (setq	h (getreal (strcat "\nChieu cao chu <"
		   (rtos oldh 2 1)
		   "> : "

	   )
  )
 )
 (if (null h)
   (setq h oldh)
 )
 (setq	TP (cond	(TP)
	(5)
  )
 )
 (setq oldTP TP)
 (setq	TP (getint (strcat "\nBao nhieu chu so thap phan <"
		   (itoa oldTP)
		   "> : "

	   )
  )
 )
 (if (null TP)
   (setq TP oldTP)
 )
 (setvar "osmode" 8)
 (while (setq p0 (getpoint "\nPick vao diem can xac dinh do cao:"))
   (setq cont1	(car (entsel "\nPick contour gan nhat thu 1:"))
  obj1	(vlax-ename->vla-object cont1)
  cont2	(car (entsel "\nPick contour gan nhat thu 2:"))
  obj2	(vlax-ename->vla-object cont2)
  p1	(vlax-curve-getClosestpointTo obj1 p0)
  p2	(vlax-curve-getClosestpointTo obj2 p0)
  p21	(list (car p2) (cadr p2) (caddr p1))

   )
   (setvar "osmode" 0)
   (setq objL1	(aLine *Model* p1 p2)
  objL2	(aLine *Model* p1 p21)
  p3	(vlax-curve-getClosestpointTo objL2 p0)
  objL3	(aLine *Model* p21 p2)
   )
   (vla-move objL3 (vlax-3d-point p21) (vlax-3d-point p3))
   (vla-update objL3)
   (setq p5 (vlax-curve-getEndPoint objL3)
  p6 (inters p3 p5 p1 p2)
  z (caddr p6)
  p7 (list (car p0) (cadr p0) z)
   )
   (vla-delete objL1)
   (vla-delete objL2)
   (vla-delete objL3)
   (entdel (ssname (ssget p0) 0))
   (vla-addpoint *Model* (vlax-3d-point p7))
   (setq objT (aText *Model* z p7 h TP))
   (setvar "osmode" 8)
 )
 (vla-EndUndoMark ActDoc)
 (RESTORE)
 (princ)
)
)

    • Like 1
    • Vote tăng 1

  22. Đã đăng · Trả lời báo cáo

    Mình cũng chẳng hiểu sao lại lỗi ngư thế nữa, mình test (trên cad2007) nhiều lần mà mà vẫn như thế, mặt cắt đầu tiên chạy OK còn các mặt cắt tiếp theo thì không được. Thiệp xem lại giúp mình nhé. Cảm ơn nhiều!

    Nó báo như thế này:

    Command: AP APPLOAD khd_vbu.lsp successfully loaded.

    Command:

    Command:

    Command: VB Undo Current settings: Auto = On, Control = All, Combine = Yes

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

    <1>: begin

    Command: UCS

    Current ucs name: *WORLD*

    Specify origin of UCS or [Face/NAmed/OBject/Previous/View/World/X/Y/Z/ZAxis]

    : W

    Command: VB Unknown command "VB". Press F1 for help.

    Command: Chon cac curve be mat nao vet:

    Select objects: Specify opposite corner: 5 found

    Select objects:

    Chon goc doc nao vet ben PHAI (mau so): 1

    Chon goc doc nao vet ben TRAI (mau so): 1

    Chieu sau nao vet: 1

    Chon chieu cao chu: 1

    Select objects: Specify opposite corner: 5 found

    Select objects: bad argument type: lselsetp nil

    File mình test bị lối nè: http://www.cadviet.com/upfiles/2/tnct_5.dwg

    Không phải lệnh VB, mà là lệnh VBU. Nhưng Cad đã không hiểu lệnh rồi mà sao vẫn yêu cầu "Chon goc doc nao vet ben PHAI (mau so):"....???

    • Vote tăng 1

  23. Đã đăng · Trả lời báo cáo

    Chào thiệp!

    File mình test bị lỗi nè: http://www.cadviet.com/upfiles/2/tnct_4.dwg

    không biết mình dùng cad 2007 có ảnh hưởng gì không nữa.

    Nếu đúg như thiệp nói thì cái này OK rồi, còn cái mà quét một lần tấc cả các mặt cắt thì bao giờ rãnh thì thiep làm cũng được, còn việc chọn nhiều mặt cắt bị lỗi thì không sao, mình có thể giới hạn tối đa 100, 50 thậm chí 10 mặt cắt một lần cũng được mà. Cảm ơn thiep nhiều!

    Chào Hoan, thiep kiểm tra nhiều lần mà có lỗi gì đâu? khi chọn đối tượng, Hoan nhớ chọn theo kiểu cửa sổ từ phải qua trái, có 5 đối tượng được chọn, gồm 1 pline tự nhiên, 4 line giới hạn. Trong 4 line giới hạn màu vàng, có 2 line cắt qua pline. Điểm cắt này là điểm bắt đầu vẽ đường nạo vét. Sau khi chọn xong nhấn enter, nếu lần đầu khi chạy lisp, lisp sẽ hỏi các thông số. Tiếp tục chọn các mặt cắt khác, khi chọn xong, enter, chọn, enter.... cho đến khi hết mặt cắt, mỏi tay thì ẻnter kết thúc. Còn lisp chọn 1 lần các mặt cắt 1 lúc, Thiep đã viết xong đang test. Hãy đợi đấy nhé.

    • Vote tăng 1

  24. Đã đăng · Trả lời báo cáo

    cám ơn Thiệp đã giúp .Mình apload thử thì nó báo lỗi này "Chon doi tuong :; error: no function definition: VLAX-CURVE-ISCLOSED"

    không biết lỗi gì nhờ Thiệp kiểm tra giúp. có thêm 1 yêu cầu nhờ Thiệp giúp được không là vẽ 1 đường cong đi qua tập hợp các điểm đã xác định được

    Lỗi này chắc có lẽ bạn chạy trên nền cad 2004 trở xuống, Bạn thêm dòng (vl-load-com) ở cuối lisp xem sao?

     

    Theo mình thì vẫn đúng. Bất kể đối tượng đó là Curve hay là gì đi nữa.

    Nếu curve là CIRCLE thì các điểm Xmax, hay Ymax, hay Xmin, hay Ymin của nó là 4 điểm quadrant chứ không phải là 2 điểm LL và UR đâu NATACA ạ

  25. Đã đăng · Trả lời báo cáo

    Hi thiep

    1. lisp thứ 1 cũng có cách để lisp chạy trên đường kín đó bạn.

    -> Lisp này chỉ chạy trên đối tuợng hở không có nghĩa là không có (hay không thể viết) Lisp chạy trên đối tuợng kín.

    2 . Lisp thứ 2, .... thì lisp hiểu sai ngay.

    -> Hàm vla-getBoundingBox trả vể 2 điểm của hình chử nhật bao quanh đối tuợng (không cần biết có bao nhiêu điểm "lồi" hay điểm "lõm")

    Như vậy kết quả không phụ thuộc vào điểm "lồi" hay điểm "lõm".

    Bạn vui lòng Check lại.

    Hi, gia_bach

    1. Sao bạn không viết luôn cho trường hợp khi Curve là đối tuợng kín luôn.

    2. Theo đề bài yêu cầu chỉ tìm Xmax, Ymax, Xmin, Xmin, của đối tượng thì lisp của bạn rất đúng. Còn nếu tìm các điểm trên curve có Xmax, hay Ymax, hay Xmin, hay Xmin, thì lisp của bạn chưa đúng. Sorry! Sorry!

×