Viết Lisp theo yêu cầu

Tháng 8 24, 2009

có bác nào viết giúp 1 đoạn lisp xác định 1 điểm trên spline có chiều dài từ điểm gốc đến điểm cần xác định cho trước. thanks

Tháng 8 24, 2009

Em có 1 bản vẽ gồm các line và pline, Nhờ các bác viết hộ em cái Lisp khi chạy sẽ tự động tìm tọa độ Xmin, Ymin, Xmax, Ymax của các đối tượng trên bản vẽ rồi gán Point_min = (Xmin,Ymin); Point_max = (Xmax,Ymax).

Thanks!

Tháng 8 24, 2009

mình đã test rồi, ok mà. Bây giờ bạn thử lại lần nữa xem sao, chứ tại vì nếu máy báo unknown cammand tức là bạn chưa load được đấy hoặc là khi load no báo lỗi nên nó không thể thực hiện được lệnh vừa rồi. Chúc bạn thành công nha

Mình đã thử lại rồi và dùng rất ngon lành, không hiểu sao lần trước load cùng các lisp khác thì không được, nhưng load riêng mỗi cái lisp đấy thì lại dùng ok. Thank cậu nhiều nhé!

Tháng 8 24, 2009

Mình sửa lại cho bạn rồi, thông cảm nhé tại mình chưa test kỹ,
link nè: http://www.cadviet.com/upfiles/2/gdt_2.rar (bản vá lỗi mới nhất đó)

Note: nếu bản vẽ tỉ tệ 1/10 thì trong Option của lệnh GDT phần tỉ lệ đo vẽ bạn nhập số 10 vào nhé!

Sao vẫn chưa được bạn ơi, diện tích tính ra không đúng, như thế này, bạn xem lại giúp mình. Mình so sánh 2 kết quả như sau:

1. Khu đất 100m2 vẽ với tỷ lệ 1/1 thì ra diện tích là 1.000m2 (tăng 10 lần)

2. Cũng với khu đất trên vẽ với tỷ lệ 1/10 thì ra diện tích 1m2 (giảm 100 lần)

Mình đã làm đúng theo hơớng dẫn của bạn rồi. Có thể sửa lại giúp mình, cảm ơn bạn nhiều

Tháng 8 24, 2009

Các bạn ơi mình gặp vấn đề này xin các bạn nghiên cứu giúp nhé!

Mình cần tính diện tích của các mặt surface mà không biết làm thế nào cả.

hay không tính dược phần diện tích ấy!

Tháng 8 24, 2009

Thế này thì có khác gì so với việc bạn vẽ theo cách thông thường nhỉ?
gõ L -> enter -> bắt điểm vào 1 -> bắt điểm vào 2 ->...-> bắt điểm vào d -> ok

chẳng khác tý nào cả

anh Thaistreetz giúp em,tại có nhiều text thì zôm mệt lắm...

Tháng 8 24, 2009

Các bạn giúp mình sửa lại cái lisp chạy Trắc dọc cống .
*Hiện trạng:

Lisp này dùng để vẽ trắc dọc cống

-Sau khi nhập các số liệu thiết kế vào five của Excel sau đó save as chúng lại dưới dạng đuôi .prn

-Từ Autocad R14 AP lisp TDC2005-v9.lsp, nhập lệnh tdc rồi mở five vừa save thi => bve TDOC

(lisp này chạy được khi cad R14 có font ( Vn_vni.shx)

*Sửa chữa:

-Vì lisp này chỉ chạy ổn định trên cad R14 còn các CAD khác thì 1 là chạy không được ,2 là bị lỗi do đó nhờ các bạn trên diễn đàn CADViet chuyển giúp lisp này chạy trên Cad2007 và không phụ thuộc vào font trên .

Nếu lisp này hoàn thiện nó sẽ giúp ích rất nhiều cho các bạn làm bên mảng thoát nước .

-Rất mong được sự giúp đỡ của các anh em trên diễn đàn và sớm nhận được hồi âm.

Thân chào

Đây là five mình đã upload

http://www.cadviet.com/upfiles/2/tdc.zip

Cuả bạn đây. đã chạy tốt với cad 2007, 2008.

Lisp này vẽ trắc dọc cống khá đẹp. bạn có thể chia sẻ cách tạo ra file số liệu bằng excel không. mình đoán chắc không phải nhập thủ công cho từng cọc chứ.

Tháng 8 25, 2009

có bác nào viết giúp 1 đoạn lisp xác định 1 điểm trên spline có chiều dài từ điểm gốc đến điểm cần xác định cho trước. thanks

To : tivanteo

Bạn chạy thử lisp xác định điểm trên Curve (LINE,ARC, PLINE và SPLINE hở) có chiều dài xác định từ 1 điểm cho trước.

(defun c:test(/ vl ov Ent isClosed dis dis0 pt dis_pt dis_max pt1 pt2);
 (if (and (setq Ent (car (entsel "\nChon doi tuong :")))
   (wcmatch (cdr (assoc 0 (entget ent))) "*LINE,ARC")
   (not (setq isClosed (vlax-curve-isClosed ent)))
   )
   (progn
     (command "undo" "be")
     (setq vl '("osmode" "orthomode" "cmdecho") ; Sys Var list
    ov (mapcar 'getvar vl))  		 ; Get Old values
     (setvar "osmode" 123)(setvar "orthomode" 0) (setvar "cmdecho" 0)
     (setq pt (getpoint (vlax-curve-getStartPoint Ent) "\nChon diem goc :")  )
     (if (vlax-curve-getDistAtPoint ent pt)
(progn
  (setq dis_pt (vlax-curve-getDistAtPoint Ent pt)
	dis0 (vlax-curve-getDistAtParam Ent (vlax-curve-getEndParam Ent))
	dis_max (max (- dis0 dis_pt) dis_pt)
	dis (getreal (strcat "\nNhap chieu dai <" (rtos dis_max) "> :") )
	)
  (if (<= dis dis_max)
    (progn
      (if (setq pt1 (vlax-curve-getPointAtDist Ent (- dis_pt dis)))
	(progn
	  (princ (strcat "\n Point  X = " (rtos(car pt1)) "; Y = " (rtos(cadr pt1))))
	  (entmake (list '(0 . "POINT")(cons 10 pt1)) ) ))
      (if (setq pt2 (vlax-curve-getPointAtDist Ent (+ dis_pt dis)))
	(progn
	  (princ (strcat "\n Point  X = " (rtos(car pt2)) "; Y = " (rtos(cadr pt2))))
	  (entmake (list '(0 . "POINT")(cons 10 pt2)) )) )
      )
    (alert "Khong ton tai diem voi thong so da nhap !")
    )
  )
)
     (mapcar 'setvar vl ov) ; reset Sys Vars
     (command "undo" "e")
     )
   (if isClosed
     (alert "List khong chay duoc tren doi tuong kin ")
     (alert "Khong chon duoc doi tuong !")))
 (princ))

Em có 1 bản vẽ gồm các line và pline, Nhờ các bác viết hộ em cái Lisp khi chạy sẽ tự động tìm tọa độ Xmin, Ymin, Xmax, Ymax của các đối tượng trên bản vẽ rồi gán Point_min = (Xmin,Ymin); Point_max = (Xmax,Ymax).
Thanks!

To : moihoclisp

Bạn chạy thử lisp tìm tọa độ Xmin, Ymin, Xmax, Ymax của 1 đối tượng.

Sau đó bạn có thể phát triển Code cho các đối tượng trên bản vẽ

(defun C:test(/ vl ov ent ll ur oo)
 (if (setq Ent (car (entsel "\nChon doi tuong :")))
   (progn
     (command "undo" "be")
     (setq vl '("osmode"  "cmdecho") ; Sys Var list
    ov (mapcar 'getvar vl))           ; Get Old values
     (mapcar 'setvar vl '(0 0))
     (vl-load-com)
     (vla-getBoundingBox (vlax-ename->vla-Object ent) 'll 'ur)
     (setq ll (vlax-safearray->list ll)
    ur (vlax-safearray->list ur)
    )
     (princ (strcat "\n Point_Min  X = " (rtos(car ll)) "; Y = " (rtos(cadr ll))))
     (princ (strcat "\n Point_Max  X = " (rtos(car ur)) "; Y = " (rtos(cadr ur))))
     (entmake (list '(0 . "POINT")(cons 10 ll)) )
     (entmake (list '(0 . "POINT")(cons 10 ur)) )
     (mapcar 'setvar vl ov) ; reset Sys Vars
     (command "undo" "e")
     )
   (alert "Khong chon duoc doi tuong !")
   )
 )

Tháng 8 25, 2009

À, thiep thấy rồi, đường giới hạn nạo vét là 2 cái "râu cá trê" line màu vàng đặt trong lớp "giới hạn vét" phải không?
Thiep hỏi tiếp: đường nạo vét, Hoan có muốn là nét đứt màu tím không?

đường Cái Mép - Thị Vải hằng năm có bị bồi lắng hay sao mà phải nạo vét hả H?

Thiep mới ở CPC về hơn 10 ngày.

Uh, đúng là hai cái râu đó nhưng mà lại có hai cái râu phía trên làm mình khó quét nè, hay là mình nối nó lại thành một sau đó rồi mới dùng lisp được không hả thiep, mà như thế thì đường giới hạn vét cũng là polyline không biết thiep nghĩ sao!

Còn đường Cái Mép, cái này là vét hữu cơ trên đường chứ không phải nạo vét lòng sông thiep a? Thiep đi CPC sao về nhanh thế? Đi về có còn nguyên vẹn không thế! :bigsmile:

Tháng 8 25, 2009

Gửi Hoan, bây giờ thì Ý tưởng của Hoan đã được hoàn thiện bằng lisp sau đây. Khi chọn đối tượng, Hoan phải chọn cả đường địa hình tự nhiên và cả đường giới hạn cùng 1 lúc, cứ tiếp tục cho đến hết mặt cắt, enter kết thúc. :bigsmile:

;;;---------------------------------
;;; LISP vet bun, COPYRIGHT BY THIEP 0918841230
;;; 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 "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)

)
(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 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
 )
)
;;;--------------------------
(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	   Len	  lop	 upp
	Lint   intP   enLWP
       )
 (setq	ActDoc	(vla-get-ActiveDocument (vlax-get-acad-object))
*Model*	(vla-get-ModelSpace ActDoc)
*layer*	(vla-get-Layers ActDoc)
 )
 (vla-StartUndoMark ActDoc)
 (SAVE_MODE)
 (loadLinetype ActDoc "HIDDEN" "acad.lin")
 (if (not (tblsearch "layer" "vetbun"))
   (progn
     (setq lay (vla-add *layer* "vetbun"))
     (vla-put-color lay acMagenta)
     (vla-put-Linetype lay "HIDDEN")
   )
 )
 (princ "Chon cac curve be mat nao vet: ")
 (While
   (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 (eq (dxf 0 en) "LWPOLYLINE")
 (progn
   (redraw en 3)
   (setq enLWP en
	 OBcur (vlax-ename->vla-object enLWP)
   )
   (vla-getboundingbox OBcur 'minpoint 'maxpoint)
   (setq lop (vlax-safearray->list minpoint)
	 upp (vlax-safearray->list maxpoint)
	 un  (getvar "viewsize")
	 ofp (list (/ (+ (car upp) (car lop)) 2)
		   (- (cadr lop) un)
		   0.0
	     )
   )
 )
      )				;end if
    )
    (foreach en Len
      (if (not (eq (dxf 0 en) "LWPOLYLINE"))
 (progn
   (setq intP (car (GiaoDT en enLWP)))
   (if intP
     (setq Lint (cons intP Lint))
   )
 )
      )
    )
    (setq Lint
    (vl-sort
      Lint
      '(lambda (e1 e2) (< (car e1) (car e2)))
    )
    )
    (setvar "osmode" 32)
    (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)
    )
;;;================
    (vl-cmdf ".offset" d_Thiep enLWP ofp "")
    (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))
    )
    (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))
   )
 )
;;;end if trong
 (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)))
      )
;;;end progn 1
      (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
 )
      )
;;;end progn 2
    )
;;;end if ngoai
    (vla-put-layer lineNV "vetbun")
    (vla-put-color lineNV acbylayer)
    (vla-put-LinetypeScale lineNV 2)
    (vla-put-LinetypeGeneration lineNV T)
;;;---tao text----
    (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)

;(redraw en 4)
 )
;;;end while
 (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 lisp vbu.lsp")
 (princ)
 (c:vbu)
)

Cảm ơn Thiêp nhiều, cái này dùng được 90% rồi.

Khi dùng mình vấn đề như thế này: Đường giới hạn vét có thêm một đoạn không cắt đường polyline (thực ra nó là đường trồng cỏ) cho nên khi quét, nếu quét luôn nó thì lisp sẽ không hiều. Còn nếu mình pick từng đường một thì lisp chạy được nhưng cũng có một số mặt cắt bị lỗi nhưng làm thế này thì nó sẽ lâu hơn là mỗi mặt cắt mình quét luôn 1lần. Nếu thiêp sữa được để quét một lần càng tốt không thì mình sẽ pick từng đường một cũng được

Còn ý tưởng của mình là thay vì mình quét từng mặt cắt mình sẽ quét tấc cả các mặt cắt luôn không biết như thế có khó qúa không? Nếu không thể quét tấc cả thì mình quét từng mặt cắt như thế cũng nhanh lằm rồi. Chúc sức khỏe! file test: http://www.cadviet.com/upfiles/2/tnct_3.dwg

Tháng 8 25, 2009

Cảm ơn Thiêp nhiều, cái này dùng được 90% rồi.
Khi dùng mình vấn đề như thế này: Đường giới hạn vét có thêm một đoạn không cắt đường polyline (thực ra nó là đường trồng cỏ) cho nên khi quét, nếu quét luôn nó thì lisp sẽ không hiều. Còn nếu mình pick từng đường một thì lisp chạy được nhưng cũng có một số mặt cắt bị lỗi nhưng làm thế này thì nó sẽ lâu hơn là mỗi mặt cắt mình quét luôn 1lần. Nếu thiêp sữa được để quét một lần càng tốt không thì mình sẽ pick từng đường một cũng được

Còn ý tưởng của mình là thay vì mình quét từng mặt cắt mình sẽ quét tấc cả các mặt cắt luôn không biết như thế có khó qúa không? Nếu không thể quét tấc cả thì mình quét từng mặt cắt như thế cũng nhanh lằm rồi. Chúc sức khỏe! file test: http://www.cadviet.com/upfiles/2/tnct_3.dwg

Hoan có chắc là quét luôn đường trồng cỏ của Hoan thì lisp bị lỗi không? Lisp này chỉ xử lý 1 đường tự nhiên là LWPOLYLINE và 2 hai đường giới hạn là LINE cắt qua đường tự nhiên. còn 2 line là đường trồng cỏ không cắt qua đường tự nhiên thì không sao.

Còn Hoan muốn lisp chọn hết 1 lúc các loại đường trên một lúc thì cũng sẽ có lisp, nhưng Thiep e rằng nếu số lượng mặt cắt quá lớn, hàng trăm, ngàn cái, thì lisp sẽ chậm và nếu có 1 mặt cắt nào đó không phù hợp với yêu cầu của Lisp (như Thiep đã từng phân tich có 5 trường hợp xảy ra) thì lisp sẽ báo lỗi ngay.

Tháng 8 25, 2009

To : tivanteo

Bạn chạy thử lisp xác định điểm trên Curve (LINE,ARC, PLINE và SPLINE hở) có chiều dài xác định từ 1 điểm cho trước.

(defun c:test(/ vl ov Ent isClosed dis dis0 pt dis_pt dis_max pt1 pt2);
 (if (and (setq Ent (car (entsel "\nChon doi tuong :")))
   (wcmatch (cdr (assoc 0 (entget ent))) "*LINE,ARC")
   (not (setq isClosed (vlax-curve-isClosed ent)))
   )
   (progn
     (command "undo" "be")
     (setq vl '("osmode" "orthomode" "cmdecho") ; Sys Var list
    ov (mapcar 'getvar vl))  		 ; Get Old values
     (setvar "osmode" 123)(setvar "orthomode" 0) (setvar "cmdecho" 0)
     (setq pt (getpoint (vlax-curve-getStartPoint Ent) "\nChon diem goc :")  )
     (if (vlax-curve-getDistAtPoint ent pt)
(progn
  (setq dis_pt (vlax-curve-getDistAtPoint Ent pt)
	dis0 (vlax-curve-getDistAtParam Ent (vlax-curve-getEndParam Ent))
	dis_max (max (- dis0 dis_pt) dis_pt)
	dis (getreal (strcat "\nNhap chieu dai <" (rtos dis_max) "> :") )
	)
  (if (<= dis dis_max)
    (progn
      (if (setq pt1 (vlax-curve-getPointAtDist Ent (- dis_pt dis)))
	(progn
	  (princ (strcat "\n Point  X = " (rtos(car pt1)) "; Y = " (rtos(cadr pt1))))
	  (entmake (list '(0 . "POINT")(cons 10 pt1)) ) ))
      (if (setq pt2 (vlax-curve-getPointAtDist Ent (+ dis_pt dis)))
	(progn
	  (princ (strcat "\n Point  X = " (rtos(car pt2)) "; Y = " (rtos(cadr pt2))))
	  (entmake (list '(0 . "POINT")(cons 10 pt2)) )) )
      )
    (alert "Khong ton tai diem voi thong so da nhap !")
    )
  )
)
     (mapcar 'setvar vl ov) ; reset Sys Vars
     (command "undo" "e")
     )
   (if isClosed
     (alert "List khong chay duoc tren doi tuong kin ")
     (alert "Khong chon duoc doi tuong !")))
 (princ))

To : moihoclisp

Bạn chạy thử lisp tìm tọa độ Xmin, Ymin, Xmax, Ymax của 1 đối tượng.

Sau đó bạn có thể phát triển Code cho các đối tượng trên bản vẽ

(defun C:test(/ vl ov ent ll ur oo)
 (if (setq Ent (car (entsel "\nChon doi tuong :")))
   (progn
     (command "undo" "be")
     (setq vl '("osmode"  "cmdecho") ; Sys Var list
    ov (mapcar 'getvar vl))           ; Get Old values
     (mapcar 'setvar vl '(0 0))
     (vl-load-com)
     (vla-getBoundingBox (vlax-ename->vla-Object ent) 'll 'ur)
     (setq ll (vlax-safearray->list ll)
    ur (vlax-safearray->list ur)
    )
     (princ (strcat "\n Point_Min  X = " (rtos(car ll)) "; Y = " (rtos(cadr ll))))
     (princ (strcat "\n Point_Max  X = " (rtos(car ur)) "; Y = " (rtos(cadr ur))))
     (entmake (list '(0 . "POINT")(cons 10 ll)) )
     (entmake (list '(0 . "POINT")(cons 10 ur)) )
     (mapcar 'setvar vl ov) ; reset Sys Vars
     (command "undo" "e")
     )
   (alert "Khong chon duoc doi tuong !")
   )
 )

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

Lisp thứ 2, nếu là đường Line, hoặc Pline có ll và ur trùng với điểm đầu và cuối của Pline thì đúng. Còn nếu Pline có nhiều điểm "lồi" cao hơn UR hay điểm "lõm" thấp hơn LL, thì lisp hiểu sai ngay.

Tháng 8 25, 2009

Các bạn giúp mình sửa lại cái lisp chạy Trắc dọc cống .
*Hiện trạng:

Lisp này dùng để vẽ trắc dọc cống

-Sau khi nhập các số liệu thiết kế vào five của Excel sau đó save as chúng lại dưới dạng đuôi .prn

-Từ Autocad R14 AP lisp TDC2005-v9.lsp, nhập lệnh tdc rồi mở five vừa save thi => bve TDOC

(lisp này chạy được khi cad R14 có font ( Vn_vni.shx)

*Sửa chữa:

-Vì lisp này chỉ chạy ổn định trên cad R14 còn các CAD khác thì 1 là chạy không được ,2 là bị lỗi do đó nhờ các bạn trên diễn đàn CADViet chuyển giúp lisp này chạy trên Cad2007 và không phụ thuộc vào font trên .

Nếu lisp này hoàn thiện nó sẽ giúp ích rất nhiều cho các bạn làm bên mảng thoát nước .

-Rất mong được sự giúp đỡ của các anh em trên diễn đàn và sớm nhận được hồi âm.

Thân chào

Đây là five mình đã upload

http://www.cadviet.com/upfiles/2/tdc.zip

mình sửa lại cho bạn rồi nè, mình thêm cả phần lựa chọn text style cho bạn đấy để bạn đỡ phụ thuộc khi máy của bạn không có font mặc định. Mình không biết bạn Thaistrezz đã sửa cho bạn rồi, nhưng thôi lỡ rồi mình cứ post lên nếu bạn thấy cái nào chạy êm không báo lỗi thì cứ xài nhé, còn nếu có lỗi thì cứ thông báo cho anh em diễn đàn biết để vá lỗi nhé.

link đây: http://www.cadviet.com/upfiles/2/tdc.rar

Tháng 8 25, 2009

@Gia_bach, lisp thứ 1 cũng có cách để lisp chạy trên đường kín đó bạn.
Lisp thứ 2, nếu là đường Line, hoặc Pline có ll và ur trùng với điểm đầu và cuối của Pline thì đúng. Còn nếu Pline có nhiều điểm "lồi" cao hơn UR hay điểm "lõm" thấp hơn LL, thì lisp hiểu sai ngay.

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.

Tháng 8 25, 2009

Sao vẫn chưa được bạn ơi, diện tích tính ra không đúng, như thế này, bạn xem lại giúp mình. Mình so sánh 2 kết quả như sau:
1. Khu đất 100m2 vẽ với tỷ lệ 1/1 thì ra diện tích là 1.000m2 (tăng 10 lần)

2. Cũng với khu đất trên vẽ với tỷ lệ 1/10 thì ra diện tích 1m2 (giảm 100 lần)

Mình đã làm đúng theo hơớng dẫn của bạn rồi. Có thể sửa lại giúp mình, cảm ơn bạn nhiều

Bạn Hoàng Sơn 614 thân mến, mình test lại rồi, chạy êm mà. Bạn chú ý nhé:

nếu ví dụ bạn có 1 cái ao hình chữ nhật với mỗi chiều là 1m và 2m

khi bạn vẽ lên máy với đơn vị là: m thì các cạch tương ứng trong autocad sẽ là: 1 và 2 tỉ lệ 1/n trong chương trình sẽ là: 1

----------------------------------- :Dm --------------------------------------------- -- : 10 và 20 ------------------------------------ : 10

----------------------------------- :cm ------------------------------------------------ : 100 và 200 ------------------------------------- : 100

------------------------------------ :mm ------------------------------------------------ : 1000 và 2000 ------------------------------------- : 1000

hoặc bạn có thể xác định tỉ lệ bản vẽ của bạn bằng cách đo khoảng cách cạnh AB trên Autocad và chia cho khoảng cách thực ở ngoài thực địa nhé

ví dụ bạn đo chiều dài cái nhà là 4.50 tương ứng ở thực địa là 9m như vậy tỉ lệ bản vẽ sẽ là 4.5 / 9 = 0.5.

Bạn lấy thương số đó lắp vào tỉ lệ 1/n của chương trình tính diện tích nhé.

note: xoá hết cái lisp cũ nhé rồi down lại cái bản vá lỗi về nhé.

nhớ làm theo hướng dẫn trong file "huong dan.doc" nhé...

Tháng 8 25, 2009

Ý bạn là : Vẽ Line từ điểm chèn của Text 1 đến điểm chèn của Text 2 ?
Bạn cho hỏi : Cad có lệnh LINE để nối 2 text lại với nhau ?

Phiên bản CAD bao nhiêu vậy bạn ?

phiên bản nào cũng có, chỉ cần mặc định chế độ truy bắt điểm thường trú là Node thôi

Tháng 8 25, 2009

Mình đã thử lại rồi và dùng rất ngon lành, không hiểu sao lần trước load cùng các lisp khác thì không được, nhưng load riêng mỗi cái lisp đấy thì lại dùng ok. Thank cậu nhiều nhé!

bạn test kỹ lại đi, nếu đúng như bạn nói thì các lisp kia làm hỏng lisp của mình đấy, không những hỏng lisp của mình mà có thể còn làm hỏng các lisp khác nữa... bạn có thể post các lisp kia lên để mình vá lỗi luôn cho nhé.

Tháng 8 25, 2009

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!

Tháng 8 25, 2009

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!

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

Tháng 8 25, 2009

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

Tháng 8 25, 2009

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 ạ

Tháng 8 25, 2009

mình sửa lại cho bạn rồi nè, mình thêm cả phần lựa chọn text style cho bạn đấy để bạn đỡ phụ thuộc khi máy của bạn không có font mặc định. Mình không biết bạn Thaistrezz đã sửa cho bạn rồi, nhưng thôi lỡ rồi mình cứ post lên nếu bạn thấy cái nào chạy êm không báo lỗi thì cứ xài nhé, còn nếu có lỗi thì cứ thông báo cho anh em diễn đàn biết để vá lỗi nhé.
link đây: http://www.cadviet.com/upfiles/2/tdc.rar

Bản sửa lỗi của Tomboy hay hơn của mình nhiều. nhưng mình góp ý chút để bản sửa của bạn hoàn thiện hơn để chạy tốt trong mọi điều kiện. lisp này chỉ vẽ tốt khi tắt bỏ chế độ bắt điểm. (nói chung tất cả các lisp có vẽ tự động cái gì đó ra màn hình đều cần phải bỏ chế độ bắt điểm mới chạy chính xác trên các bản cad đời cao đc. vì các bản cad này được thiết kế với chế độ bắt điểm thông minh so với chế độ bắt điểm bình thường của cad cũ).

Lisp bắt đầu tự động vẽ sau khi load dữ liệu từ file *.prn. sau bước load file này bạn set giá trị biến OSMODE bằng 0, và trả về giá trị ban đầu khi lisp kết thúc vẽ.

Tháng 8 25, 2009

Hoan có chắc là quét luôn đường trồng cỏ của Hoan thì lisp bị lỗi không? Lisp này chỉ xử lý 1 đường tự nhiên là LWPOLYLINE và 2 hai đường giới hạn là LINE cắt qua đường tự nhiên. còn 2 line là đường trồng cỏ không cắt qua đường tự nhiên thì không sao.
Còn Hoan muốn lisp chọn hết 1 lúc các loại đường trên một lúc thì cũng sẽ có lisp, nhưng Thiep e rằng nếu số lượng mặt cắt quá lớn, hàng trăm, ngàn cái, thì lisp sẽ chậm và nếu có 1 mặt cắt nào đó không phù hợp với yêu cầu của Lisp (như Thiep đã từng phân tich có 5 trường hợp xảy ra) thì lisp sẽ báo lỗi ngay.

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!

Tháng 8 25, 2009

Bản sửa lỗi của Tomboy hay hơn của mình nhiều. nhưng mình góp ý chút để bản sửa của bạn hoàn thiện hơn để chạy tốt trong mọi điều kiện. lisp này chỉ vẽ tốt khi tắt bỏ chế độ bắt điểm. (nói chung tất cả các lisp có vẽ tự động cái gì đó ra màn hình đều cần phải bỏ chế độ bắt điểm mới chạy chính xác trên các bản cad đời cao đc. vì các bản cad này được thiết kế với chế độ bắt điểm thông minh so với chế độ bắt điểm bình thường của cad cũ).
Lisp bắt đầu tự động vẽ sau khi load dữ liệu từ file *.prn. sau bước load file này bạn set giá trị biến OSMODE bằng 0, và trả về giá trị ban đầu khi lisp kết thúc vẽ.

thanhks, bạn nói đúng, tại vì mình chỉ tập trung tìm lỗi của chương trình đó là lỗi thiếu font trong autocad và lỗi vòng lặp khi đọc dữ liệu từ tệp ra thôi nên mình không để ý tới vấn đề đó. mình sẽ rút kinh nghiệm để những bản vá sau được hoàn thiện hơn.

Tháng 8 25, 2009

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é.

Đăng nhập

Viết Lisp theo yêu cầu

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

tivanteo 18

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

viennv 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

HoangSon614 66

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

thuyvan0210 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

bonchen 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

Thaistreetz 539

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

gia_bach 1.549

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

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

tomboy 21

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

gia_bach 1.549

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

tomboy 21

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

tomboy 21

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

tomboy 21

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

nataca 554

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

tivanteo 18