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

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

    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.

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

    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.

    • Vote tăng 1

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

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

    • Vote tăng 1

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

    À, 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.

    • Vote tăng 1

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

    Chào anh Thiệp!

    Lisp này khi conghoan dùng gặp phải vấn đề như thế này Thiệp xem lại giúp mình với!

    1. Khi mình chọn mép nạo vét thì mình cần dùng truy bắt điểm là hai đường giao nhau (intersection), vì mình có đường trồng cỏ là đường giới hạn mà lisp thì chỉ có Nearest. nếu mình truy bwts điểm bằng ntersection thì sẽ bị lỗi.

    2.Khi chọn đường tự nhiên thì mình chọn xong rồi ENTER, thay vì như thế Thiệp đổi lại bằng cách pick chọn rồi tự tiếp tục chọn hai điiểm giới hạn vét mà không cần ENTER.

    3. Thường thì mái dốc vét hai bên bằng nhau nhưng cũng có trường hợp hai bên khác nhau Thiệp thêm vào với nhé.

    4. Mình thấy mỗi lần chọn mặt cắt thì nó zoom all, có lẽ ý của Thiep để như vậy dễ nhìn nhưng mình thấy cũng không tiện lắm có thể bỏ cái này đi.

    PS: hôm trước mình nghe nói Thiep sắp đi Lào vậy có đi không thế? Mình đang làm đường vào Cảng Cái Mép-Thị Vải ở dưới Bà Rịa. Công trình này đã nạo vét xong rồi, nhưng ngành mình làm công việc này nhiều lắm nên mình muốn tìm một cái lisp nào nhanh nhất để thực hiện thôi. Mình đưa ra ý tưởng như thế này Thiệp xem thử có khả thi không nhé: trên mỗi mặt cắt mình để lại hai layer (tự nhiên và giới hạn vét) , layer tự nhiên là polyline còn layer giới hạn là line, mục đích là khi mình chọn các đường tự nhiên thì mình dung thuộc tính polyline thì nó sẽ không chọn những đường giới hạn. Còn phạm vi vét là từ điểm giao giữa đường tự nhiên và đường giới hạn vét. đây là ý tưởng của mình mong được Thiep và anh em diễn đàn giúp đỡ. file cad: http://www.cadviet.com/upfiles/2/tnct_2.dwg

    Mình cảm ơn anh em diễn đàn nhiều! Chúc anh em sức khoẻ và cuối tuần vui vẽ!

    Gởi Hoan, theo đề nghị của Hoan, các mục 1, 2, 3, 4 Thiep sẽ chỉnh lại nhanh chóng. Còn ý tưởng mới của Hoan Thiep chưa hiểu lắm. Có phải Hoan nói nạo vét không phải offset từ mặt cắt tự nhiên xuống n mét, mà nạo vét xuống tới cots tuyệt đối nào đó không? Các luồng sông biển bên Hàng Hải cũng làm vậy và có một sai số nạo vét nữa. Hoan cứ đưa lên 1 bản vẽ ví dụ xem.

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

    Quái lạ. có phải do mạng nhà mình không thế này. mấy hôm rồi post bài ở cadviet rất khó khăn!

    Rất giống như Thiep về vấn đề này: Khi nhấn nút "thêm bài trả lời" thì trang web lại "xin lỗi" và yêu cầu mình phải đăng nhập lại, cỡ 5 lần như vậy mới thành công.

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

    -Trong lisp lam sao lưu được giá trị nhập vào cho những lần sau thực hiện lệnh.VD: mình có đọan code sau:

    (defun c:aa1()

    (setq LA (getvar "Clayer"))

    (initget 1 "P DT")

    (setq BT (getkword "\n Tinh dien tich Pick hoac chon doi tuong?

    :"))

    (if (= BT "P")

    - khi đánh lệnh aa1 và nhập giá trị P thì lần sau thực hiện lệnh không cần nhập lại. Mong được sự giúp đỡ.

    Bạn xem đoạn mã ví dụ sau đây:

    (defun c:Pick-Select ()
 (setq	bit (cond (bit)
	  ("Pick")
    )
 )
 (initget "Pick Select")
 (setq	Tmp (strcat "\nAnother Quension? [Pick/Select] <" bit ">: ")
bit    (cond ((getkword Tmp))
	     (bit)
       )
 )
 (if (eq bit "Pick")
   (Print "Toi chon picK")
   (Print "Toi chon select")
 )
 (princ)
)

    Bạn chỉ cần đánh P hay S, lần sau chỉ cần enter

    • Vote tăng 1

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

    Em vẽ Autocad2010 trên lapto, trước kia vẽ bình thường, hôm qua xuất hiện lỗi lạ: Khi di chuột trong vùng vẽ rất chậm.Song khi di chuột ngoài vùng vẽ tức là con trỏ chạy trên vùng vẽ chậm, chạy trên phần có các thanh công cụ nhanh bình thường, có bác nào biết cách khắc phục không?

    Bạn thử tắt các chương trình thường trú như MTD Lạc Việt, J'click xem. Các chương trình này cũng có dùng nút phải hoặc trái của chuột để tra nhanh từ, nên gây đụng chạm các lệnh của chương trình khác

    • Vote tăng 1

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

    Mình đang tìm cái lisp cộng, trừ, nhân, chia giữa các phần tử tương ứng của 2 hàng text.

    Mình nhớ Bác Hoành đã post nó trong topic này nhưng tìm hoài không ra.

    Bạn nào nhớ nó ở khoảng trang bao nhiêu thì nhắc mình với. Chức năng tìm kiếm của diễn đàn với 4 từ khóa trên cũng chịu thua rồi :bigsmile:

    link ở đây:

    http://www.cadviet.com/forum/index.php?sho...ost&p=65044

    • Vote tăng 1

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

    Cảm ơn Tue_NV đã nhiệt tình giúp đỡ. Mình đã test thử rồi, nếu mình chỉ để layer đường tự nhiên không thì OK nhưng nếu có đường khác nữa (như file của mình kèm theo:http://www.cadviet.com/upfiles/2/tnct_1.dwg ) thì nó lại không được. Trong file mình có thể hiện cái mình cần. Tue_NV và Thiệp coi thử có thể làm như thế nào để mình đựoc kết quả nhanh nhất là được chứ không nhất thiết là làm như nhưng bước mình yêu cầu. Mình nghĩ nếu chọn cùng một lúc nhiều mặt cắt cùng thực hiện một lần không biết có ngoài khả năng của lisp không. Cảm ơn mọi người quan tâm! Do mạng bị lỗi nên gởi hai lần mà không biết xoá. Nhờ admin xoá dùm bài này với. Thank!

    Chào Hoan, làm gì mà yêu cầu "được kết quả nhanh nhất" dữ quá, làm cho Thiep cũng không kịp hoàn thiện Lisp đúng cho mọi trường hợp. Xin hỏi Hoan đang thiết kế vét bùn cái gì mà gấp thế? Thôi thì Hoan tạm sử dụng lisp này vậy:

    ;;;---------------------------------
;;; LISP vet bun, 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 / objT)
 (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 "naovet")
)
;;;---------------------
(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)

)
(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)
;;;-----------------ham dinh thong so k_Thiep, d_Thiep, hei_Thiep
(defun c:khd ()
 (setq	k_Thiep	(cond (k_Thiep)
	      (5)
	)
 )
 (setq oldk_Thiep k_Thiep)
 (setq	k_Thiep	(getreal (strcat "\nChon goc doc nao vet (mau so) <"
			 (rtos oldk_Thiep 2 1)
			 "> : "

		 )
	)
 )
 (if (null k_Thiep)
   (setq k_Thiep oldk_Thiep)
 )
 (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)
 (print "Bay gio ban co the su dung lisp vbu.lsp")
)
;;;================================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
       )
 (setq	ActDoc	(vla-get-ActiveDocument (vlax-get-acad-object))
*Model*	(vla-get-ModelSpace ActDoc)
*layer*	(vla-get-Layers ActDoc)
 )
 (vla-StartUndoMark ActDoc)
 (SAVE_MODE)
 (if (not (tblsearch "layer" "naovet"))
   (progn
     (setq lay (vla-add *layer* "naovet"))
     (vla-put-color lay acRed)
   )
 )
 (princ "Chon cac curve be mat nao vet: ")
 (setq SS (ssget '((0 . "LWPOLYLINE"))))
 (setq Len (SS-enlst ss)
i 1)
 (foreach en Len
   (setq OBcur (vlax-ename->vla-object en))
   (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)
   )
   (vla-zoomwindow
     (vlax-get-acad-object)
     (vlax-3d-point lop)
     (vlax-3d-point upp)
   )
   (redraw en 3)
   (setvar "osmode" 512)
   (if	(null k_Thiep)
(setq k_Thiep (getreal "\nChon goc doc nao vet (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 p1  (getpoint	(strcat	"\nChon mep nao vet ben TRAI cua mat cat so "
			(itoa i)
			":"
		)
      )
  p2  (getpoint
	(strcat "\nChon mep nao vet ben PHAI cua mat cat so " (itoa i) ":")
      )
  p11 (list (+ (car p1) k_Thiep) (- (cadr p1) 1) 0.0)
  p21 (list (- (car p2) k_Thiep) (- (cadr p2) 1) 0.0)
  an1 (angle p1 p11)
  an2 (angle p2 p21)
   )
   ;;;================
   (vl-cmdf ".offset" d_Thiep en 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 en))
  pin2	(car (giaoDT enR2 enD))
  p22	(car (giaoDT enR2 en))
  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 "naovet")
(vla-put-color lineNV acbylayer)
;;;---tao text----
(setq pTex1 (polar (acet-geom-midpoint p1 pin1)
		    (- an1 (/ pi 2))
		    (/ hei_Thiep 2)
	     )
)
(TextTaluy *Model* k_Thiep pTex1 hei_Thiep an1)
(setq pTex2 (polar (acet-geom-midpoint p2 pin2)
		    (+ an2 (/ pi 2))
		    (/ hei_Thiep 2)
	     )
)
(TextTaluy *Model* k_Thiep pTex2 hei_Thiep (+ an2 pi))
   (setq i (1+ i))
   (vla-ZoomExtents (vlax-get-acad-object))
   ;(redraw en 4)
 );;;end foreach
 (RESTORE)
 (vla-EndUndoMark ActDoc)
 (princ "\nChuc cac ban thanh cong. Thiep")
 (princ)
)

    Hoan chú ý:

    - Lisp sẽ hỏi các thông số 1 lần đầu tiên thôi, lần sau sẽ không hỏi nữa cho dù phát lệnh VBU đến lần thứ n. Muốn thay đổi các thông số này phải phát lệnh KHD trước khi phát lệnh VBU.

    :bigsmile:

    • Vote tăng 1

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

    Cảm ơn Thiệp đã giúp đỡ!

    Cái này chạy tốt lắm nhưng có một số điểm chưa được hoàn thiện lắm Thiêp cố gắn chỉnh lại cho mình tí để lisp hoàn thiện hơn.

    Thứ nhất: Mình muốn các thông số như mái dốc vét, chiều sâu vét mình chỉ nhập vào đối với mặt cắt đầu tiên thôi, còn các mặt cắt sau thì lisp tự hiểu như mặt cắt đầu. Sau khi thực hiện xong mặt cắt thứ nhất thì lisp tự động thực hiện lệng cho mặt cắt tiếp theo cho đến khi bấm Esc thì kết thúc lệnh. Có nghĩa là đối với các mặt cắt sau mình chỉ cần kích 3 lần: chọn polyline, chọn điểm giới hạn bên trái, bên phải thì được. Vì mình có rất nhiều mặt cắt nên cần làm cho thật nhanh nên hy vong Thiêp sữa lại để lisp thực hiên cho nhanh.

    Thứ hai: đường vét là đường offet đường tự nhiên xuống chứ không phải coppy xuống như lisp của Thiêp.

    Cảm ơn thiêp đã giúp đỡ! Mong hồi âm của Thiệp!

    Chào Hoan và Tue_NV,

    Xem ra cái vét bùn của Hoan có nhiều điều cần phải phân tích đó Tue ạ:

    Lúc đầu, Thiep nghĩ, những yêu cầu trên của Hoan, mình sửa lại lisp 1 tý là xong. Sau đó mình phân tích lại có nhiều trường hợp xảy ra:

    - 1. Sẽ xảy ra như bản vẽ của Hoan: 2 taluy cắt đáy offset tại 2 điểm (cái này mình đã chỉnh sửa lisp theo ý của Hoan)

    - 2. Hai taluy cắt nhau trước, mà chưa gặp đáy offset.

    - 3. Hai taluy cắt đường địa hình trước khi cắt đáy offset,

    - 4. Hai taluy cắt đường địa hình trước và cắt nhau trước, mà chưa gặp đáy offset.

    - 5. Hai taluy cắt nhau tại 1 điểm nằm cao hơn đường địa hình, hoặc nằm trên đường địa hình (lúc này sẽ không cần nạo vét)....

    Mình đang chia nhiều cond cho lisp và sẽ sớm hoàn thiện Lisp.

    • Vote tăng 1

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

    Mình có 1 bản đồ quy hoach,giờ mình muốn xén 1 vùng trong 1 hình chữ nhật.Mình dùng lệnh Extrim ma không được.vậy mình sai lệnh hay sao giúp mình với?

    Mình cảm ơn!

    Nếu đường bao của bạn là 1 polyline, hay LWPoline, Bạn có thể xem ở đây:

    http://www.cadviet.com/forum/index.php?sho...ost&p=66019

    Lisp EWB của Gia_bach có thể thay thế extrim một cách gọn gàng sạch sẽ.

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

    Em thấy trong Cad hay sử dụng một loại option điều kiện [Yes/No] để xem xét việc có thực hiện một bước nào đó trong quá trình thao tác lệnh hay không. hiện em đang muốn dùng loại option điều kiện này nhưng viết mãi không được đoạn code ấy.

    hic! em nhức đầu với nó quá! mọi người giúp em với, em chịu thua với nó rồi. :bigsmile:

    Đoạn lisp này rất hay:

    (defun c:yes-no ()
 (setq	bit (cond (bit)
	  ("Yes")
    )
 )
 (initget "Yes No")
 (setq	Tmp (strcat "\nAnother Quension? [Yes/No] <" bit ">: ")
bit    (cond ((getkword Tmp))
	     (bit)
       )
 )
 (if (eq bit "Yes")
   (Print "I am Thiep")
   (Print "You are Thaistreetz")
 )
 (princ)
)

    Chỉ cần đánh Y hay N

    • Vote tăng 1

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

    vậy để em trải lòng mình: là thế này ví dụ như em vẽ 1 cây lúa, rồi em muốn trải đều cây lúa đó lên một vùng cho trước, như trong bản đồ đấy em nói thế ảnh hiểu được không :bigsmile:)

    Em thử dùng lệnh superHatch trong Express xem sao? Nó giúp ta tạo 1 hatch từ 1 đối tượng có thể là 1 block, theo tỷ lệ X, hay Y do người dùng chọn

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

    Mai bạn đi đi tây á!

    Vâng mình đi "tây" nhưng là "phương trời tây", cách TPHCM 700km lận.

    Ở một nơi không có internet, nơi yên ba thăm thẳm, mình đã update lại lisp CPA.LSP và xin gửi lại cho các bạn

    GHI CHÚ:

    - Lisp đôi khi ngộ nhận rải thép trên thành dưới, dưới thành trên. Nếu gặp trường không theo ý muốn thì các bạn đổi T thành D, D thành T

    - Lisp rải thép trên curve: trong đó Line, Spline, LWPolyline, Circle, ellipse là tập hợp con của Curve.

    ; Lisp rai thep tren curve
; Copyright by THIEP 6-2009 (0918841230)
; Free from CADVIET.COM
;;; Update v.2: 7/2009
;;;--------------------------
(defun ADDCIR (ModelS p R)
 (vla-Addcircle
   ModelS
   (vlax-3d-point p)
   R
 )
)
;;;------------
(defun ArrOBJ (cir / doc mspace po L)
 (setq L (cons cir L))
 (setq	CIRArr (vlax-make-safearray
	 vlax-vbObject
	 (cons 0 (1- (length L)))
       )
 )
 (vlax-safearray-fill CIRArr L)
)
;;;--------------------------
(defun get_point_above_curve (EntCu pt dis / param ang)
 (if (setq param (vlax-curve-getParamAtPoint EntCu pt))
     (setq ang	(- (angle '(0 0 0) (vlax-curve-getFirstDeriv EntCu param))
	   (/ pi 2)
	)
     )
 )
(polar pt ang dis) 
)
;------
(vl-load-com)
(defun c:cpa (/ addH enCUR PS PE enBL nameBL Lcur n k l1 dime n1 p1 pt l1 cmdo fi)
 (command "undo" "be")
 (setq cmdo (getvar "cmdecho"))				
 (setvar "cmdecho" 0)
 (setq	doc (vla-get-ActiveDocument
      (vlax-get-acad-object)
    )
 )
 (setq mspace (vla-get-modelspace doc))
 (setq enCUR (car (entsel "\nPick a curve: ")))
 (setq	PS (vlax-curve-getStartPoint encur)
PE (vlax-curve-getEndPoint encur)
 )
 (setq R (cond (R ) (2)))
 (setq oldR R)
 (setq R   (getreal (strcat "\nChon ban kinh thep <" (rtos oldR 2 0) "> : ")))
 (if (null R) (setq R oldR))
 (setq addH (vla-AddHatch mspace 1 "SOLID" T AcHatchObject))
 (setq glength (lambda (e) (command ".lengthen" e "") (getvar "perimeter"))
Lcur (glength enCUR)
 )
 (setq l1 0.0)
 (setq fi R)
 ; --
 (if  (> (car (vlax-curve-getEndPoint enCUR))
      (car (vlax-curve-getStartPoint enCUR))
   )
   (setq fi (- R))
   )
 (setq wTD (cond (wTD) ("T")))
 (initget 128 "T D")
      (setq TmpStr (strcat "\nBan rai thep tren hay duoi curve <T/D> <" wTD ">: ")
            wTD (cond ((getkword TmpStr)) (wTD))
      )
 (if (= WTD "D")
   (setq fi (- R))
   (setq fi R)
 )
 (setq d (cond (d) (20)))
 (setq oldd d)
 (setq d (getreal (strcat "\nChon khoang cach rai thep <" (rtos oldd 2 0) "> : ")))
 (if (null d) (setq d oldd))
;------
 (setq n (/ Lcur d))
   (if	(< (- n (setq n1 (fix n))) 0.5)
     (setq n n1)
     (setq n (1+ n1))
   )
 (setq dime (/ Lcur n))
 (vla-regen doc acAllViewports)
 (if (equal PS PE)
   (setq k n)
   (setq k (+ n 1))
 )
 (repeat k
   (setq p1 (vlax-curve-getPointAtDist enCUR l1))
   (setq pt (get_point_above_curve enCUR p1 (* fi 1.4)))
   (setq cir (ADDCIR mspace pt R))
   (vla-update cir)
   (setq arr (arrOBJ cir))
   (setq sl (vlax-invoke-method addH 'AppendOuterLoop arr))
   (setq l1 (+ l1 dime))
 )
 (command "undo" "end")
 (setvar "cmdecho" cmdo)
 (princ)
)

    • Vote tăng 1

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

    Chào các bạn.

    Về cơ bản thì LISP ERC của bạn Thiệp đã giải quyết đuợc các yêu cầu xóa các đối tuợng trong, ngoài và giữa 2 đuờng bao.

    Tuy nhiên với các đối tuợng có giao với đuờng bao thì Lisp ERC chưa hoàn chỉnh.

    Để giải quyết vấn đề xóa các đối tuợng có giao với đuờng bao, tui dùng giải pháp là cắt các đối tuợng này tại giao điểm với đuờng bao, sử dụng hàm break_with của CAB trên www.TheSwamp.org

    Do hàm break_with chỉ cắt các đối tuợng lines, lwplines, plines, splines, ellipse, circles & arcs nên với các đối tuợng còn lại như Text, Dimension,... LISP không giải quyết triệt để. :bigsmile:

    Các bạn chạy thử và cho ý kiến. File

    Gia_Bach, cảm ơn bạn đã hoàn chỉnh erc.lsp thành ewb.lsp thật tuyệt vời. Những ngày vắng mặt, ở nơi không có internet, Thiep cũng đã nghĩ đến hàm break-with và cũng hoàn chỉnh erc.lsp. Bây giờ thì không cần đưa lên diễn đàn nữa. Tuy nhiên EWB vẫn còn thiếu sót khi curve là spline. Còn khi curve là circle, ellipse, bạn tạo listpoint có 72 điểm, mình nghĩ là ít, mình cho đến 2009 điểm (chắc hơi nhiều).

    • Vote tăng 1

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

    Conghoan hãy chờ đợi. Tue_NV đang tìm 1 phương án khả thi hơn. Mình đã thử test trên CAD2007 rồi, tại sao lại bị lỗi như vậy

    Cong hoan chịu khó chờ nhé. Dạo này Tue_NV hơi bận. Tue_NV đang tìm phương án khác để hoàn thiện nó.

    Chào conghoan

    Cảm ơn Tue_NV nhiều. Mình rất vui khi biết lisp này vẫn còn hy vọng để hoàn thiện. Mình thấy có một nguyên nhân làm cho mình test không thành công xin được góp ý để Tue sửa lại cho dễ nha. Cad 2004 mình test cũng như cad 2007 chứ không ảnh hưởng gì cả, 2004 vẫn lỗi như thế. Và cùng có chung một nguyên nhân là polyline tự nhiên quá dốc thì xảy ra lỗi này, còn nếu như đường polyline bằng phẳng thì OK. Mình đinh up file cho Tue de nhin nhưng uo hoài không được. mình nói chung là thế này: nếu đường mái dốc cắt đường offset bên dưới thì nó nối lại với nhau còn không thì nó không nối lại với nhau được. Khi nào rãnh Tue_NV nghieng cuu giúp nha!

    Thank!

    Chào conghoan1003 và Tue_NV,

    Thiep cũng có một thời gian làm việc cùng với Bảm đảm An toàn Hàng Hải II, nạo vét luồng SG - Vũng Tàu từ Tân Cảng đến Ghềnh Rái, Người ta nạo vét đến cots 8.2m sai số 0.3m (mốc cao độ Mũi Nai). Còn yêu cầu của Conghoan thi vét bùn theo bề mặt địa hình tự nhiên rồi offset xuống, lại không có sai số nạo vét!

    Thôi thì cũng theo yêu cầu này, Thiep xin gánh cho Tue một chút tạo ra lisp như ý muốn của CongHoan:

    (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 taoRay (ModelS poR1 poR2)
 (vla-Addray
   ModelS
   (vlax-3d-point poR1)
   (vlax-3d-point poR2)
 )
)
(defun taoLine (ModelS p1 p2)
 (vla-AddLine
   ModelS
   (vlax-3d-point p1)
   (vlax-3d-point p2)
 )
)
(defun TextTaluy (model k po h ang / objT)
 (setq	obj (vla-AddText
      *Model*
      (strcat "1:" (itoa k))
      (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 "naovet")
)
;;;----------------------
(DEFUN c:vbu (/	ActDoc *Model*	 *layer*    en	    ss	   p1	  Pa	 Pb
	p11    p2     p3     p4	    p21	   objD	  enD	 objR1
	objR2  enR1   enR2   pin1   pin2   pe1	  pe2	 objL2
	objL1  enL1   enL2 lay ang1 ang2 poTex1 poTex2
       )
 (setq	ActDoc	(vla-get-ActiveDocument (vlax-get-acad-object))
*Model*	(vla-get-ModelSpace ActDoc)
*layer*	(vla-get-Layers ActDoc)
 )
 (vla-StartUndoMark ActDoc)
 (if (not (tblsearch "layer" "naovet"))
   (progn
   (setq lay (vla-add *layer* "naovet"))
   (vla-put-color lay acRed)
   )
 )
 (setvar "osmode" 512)
 (setq	en  (car(entsel "\nChon curve be mat nao vet: ")))
 (setq k (cond (k) (5)))
 (setq oldk k)
 (setq	k (getint (strcat "\nChon goc doc nao vet (mau so): <"
		   (itoa oldk)
		   "> : "
	   )
   )
 )
 (if (null k) (setq k oldk))
 (setq d (cond (d) (5)))
 (setq oldd d)
 (setq	d (getreal (strcat "\nChieu sau nao vet: <"
		   (rtos oldd 2 1)
		   "> : "
	   )
   )
 )
 (if (null d) (setq d oldd))
 (setq hei (cond (hei) (0.5)))
 (setq oldhei hei)
 (setq	hei (getreal (strcat "\nChon chieu cao chu: <"
		   (rtos oldhei 2 1)
		   "> : "
	   )
   )
 )
 (if (null hei) (setq hei oldhei))
 (setq p1 (getpoint "\nChon bien luong ben trai mat cat: ")
p2 (getpoint "\nChon bien luong ben phai mat cat: ")
p11 (list (+ (car p1) k) (- (cadr p1) 1) 0.0)
p21 (list (- (car p2) k) (- (cadr p2) 1) 0.0))
 (setq objD (vla-copy (vlax-ename->vla-object en)))
 (vla-move objD (vlax-3d-point (list 0.0 0.0 0.0)) (vlax-3d-point (list 0.0 (- d) 0.0)))
 (setq objR1 (taoRay *Model* p1 p11)
objR2 (taoRay *Model* p2 p21))
 (setq enR1 (vlax-vla-object->ename objR1)
enR2 (vlax-vla-object->ename objR2)
enD (vlax-vla-object->ename objD))
 (setq	PA (vlax-curve-getStartPoint enD)
PB (vlax-curve-getEndPoint enD)
 )
 (setq pin1 (car (giaoDT enR1 enD))
pin2 (car (giaoDT enR2 enD)))
 (vla-delete objR1)
 (vla-delete objR2)
 (setvar "osmode" 0)
 (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	objL2 (taoline *Model* p2 pin2)
ang2  (vla-get-Angle objL2)
enL2  (vlax-vla-object->ename objL2)
objL1 (taoline *Model* p1 pin1)
ang1  (vla-get-Angle objL1)
enL1  (vlax-vla-object->ename objL1)
 )
 (vl-cmdf ".pedit" "m" enL1 end enL2  "" "" "j" "" "")
 (vla-put-layer (vlax-ename->vla-object (entlast)) "naovet")
 (setq poTex1 (polar (ACET-GEOM-MIDPOINT p1 pin1) (- ang1 (/ pi 2)) (/ hei 2)))
 (TextTaluy *Model* k poTex1 hei ang1)
 (setq poTex2 (polar (ACET-GEOM-MIDPOINT p2 pin2) (+ ang2 (/ pi 2)) (/ hei 2)))
 (TextTaluy *Model* k poTex2 hei (+ ang2 pi))
 (vla-EndUndoMark ActDoc)
 (princ)
)

    • Vote tăng 3

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

    bác Tue_NV có thể viết cho e 1 cái lisp mà có thể kéo dài đường hatch được ko? mỗi lần thay đổi khung của phần hatch thì bình thường là em phải xoá phần hatch cũ đi rồi mới chọn khung để hatch lại. vậy thì bác thử xem viết lisp nào mà có thể chọn phần khung mới để kéo dài hacth cũ cho lấp đầy khung mới. kiểu như lệnh extent kéo dài 1 đường thẳng tới 1đường thẳng khác ấy bác ah! thanks!

    Yêu cầu của bach1212, chưa cần đến lisp đâu. Chỉ cần khi tạo hatch, bạn bấm vào ô Associative là được. Khi muốn mở rộng hatch, bấm rê các nút của boundảy là được, hoặc dùng lệnh stretch.

     

    Chào cả nhà CADVIET, sau hơn 1 tháng vắng mặt, mà topic này đã phát triển thêm 14 trang. Thật là vui khi thấy Tue_NV, Gia Bach, G288, ntvn... vẫn cần mẫn giúp ích cho đời.

    • Vote tăng 1

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

    Hi all !

    E muốn dải thép cho 1 đoạn tường cong bất kỳ, bác nào có lisp dải chấm thép như vậy ko nhỉ? Chứ chia ra rồi coppy thì lâu quá. Đa tạ , đa tạ !

    Đây là lisp gửi tặng các bạn có nhu cầu rải thép trên đường cong, đa giác bất kỳ.

    Yêu cầu người dùng tạo trước 1 block là mặt cắt thép: gồm vòng tròn có hatch kiểu solid.

    Lisp yêu cầu pick Curve, pick block mặt cắt thép, kích thước a rải thép, bán kính thép

    Rải trên hay dưới curve.

    ok

    ; Lisp rai thep tren curve, Block matcat thep da co tren ban ve
; Copyright by THIEP 2009 (0918841230)
; Free from CADVIET.COM
(defun get_point_above_curve (EntCu pt dis / param ang)
 (if (setq param (vlax-curve-getParamAtPoint EntCu pt))
     (setq ang	(- (angle '(0 0 0) (vlax-curve-getFirstDeriv EntCu param))
	   (/ pi 2)
	)
     )
 )
(polar pt ang dis) 
)
;------
(defun DXF (code en) (cdr (assoc code (entget en))))
;------
(defun c:cpa (/ enCUR enBL nameBL Lcur d n dime n1 p1 pt l1 cmdo fi)
 (command "undo" "be")
 (vl-load-com)
 (setq cmdo (getvar "cmdecho"))				
 (setvar "cmdecho" 0)
 (setq	doc (vla-get-ActiveDocument
      (vlax-get-acad-object)
    )
 )
 (setq mspace (vla-get-modelspace doc))
 (setq enCUR (car (entsel "\nPick a curve: ")))
 (setq enBL (car (entsel "\nPick origin block for insert")))
 (setq nameBL (dxf 2 enBL))
 (setq glength (lambda (e) (command ".lengthen" e "") (getvar "perimeter"))
Lcur (glength enCUR)
 )
 (setq l1 0.0)
 (setq d (getreal "\nSelect distance for insert block: "))
 (setq fi (getreal "\nSelect radius of slice: "))
 ; --
 (if  (> (car (vlax-curve-getEndPoint enCUR))
      (car (vlax-curve-getStartPoint enCUR))
   )
   (setq fi (- fi))
   )
 (initget 128 "T D")
 (setq wTD (getkword "\nBan rai thep tren hay duoi curve <Tren/Duoi>: <T>"))
 (if (= WTD "D")
   (setq fi (- fi))
 )
;------

 (setq objBL (vlax-ename->vla-object enBL))
 (setq n (/ Lcur d))
   (if	(< (- n (setq n1 (fix n))) 0.5)
     (setq n n1)
     (setq n (1+ n1))
   )
 (setq dime (/ Lcur n))
 (repeat (+ n 1)
   (setq p1 (vlax-curve-getPointAtDist enCUR l1))
   (setq pt (vlax-3d-point (get_point_above_curve enCUR p1 (* fi 1.2))))
   ;(command ".insert" nameBL pt "" "" "")
   (vla-InsertBlock mspace pt nameBL 1 1 1 0)
   (setq l1 (+ l1 dime))
 )
 (command "undo" "end")
 (setvar "cmdecho" cmdo)
 (princ)
)

    Các bạn dùng và rep cho mình nhé

     

     

     

    "Mai đi rồi nhớ CADVIET vô cùng!"

    • Vote tăng 1

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

    Bác Thiếp à,,sory bác vì lúc đầu e chỉ gặp rắc rối với 1 curve, vấn đề về 2 curve là ý tưởng phát sinh mà, hìhì...nhưng sao lisp này không kết hợp được với extrim giống như 1 curve hả bác thiep?nếu kết hợp được với extrim thì tuyệt quá bác thiêp a!Thanks bác nhiều nhiều nha

    Có lẽ hẹn sau khi vắng mặt một thời gian, khi quay về TP, thiep sẽ thêm extrim. Hoặc có thể nhờ bác Hoanh hoặc ai đó vậy.

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

    Câu hỏi của bạn hơi tối nghĩa! Bạn cần diễn giải thêm!

    Người ta cần convert từ định dạng này sang đinh dạng khác, block chỉ là một đối tượng trong AUTOCAD.

    point: là gì?

    Theo VDICT:

    * mũi nhọn (giùi...) mũi kim, đầu ngòi bút; nhánh gạc (hươu nai); cánh (sao)

     

    * dụng cụ có mũi nhọn, kim khắc, kim trổ

     

    * (địa lý,địa chất) mũi đất

     

    * (quân sự) đội mũi nhọn

     

    * mỏm nhọn

    ...

    Theo từ diển chuyên ngành đường sắt: Ghi

    :s_big:

    :blink:

    Có lẻ nghiahuu muốn biến khối đá (block) thành thanh ghi (points) làm đường tàu??? Chắc là nhờ Ông Thần Đèn thôi.

    Nói đùa thôi, theo thiep nghĩ, nghiahuu muốn thay đối tượng block thành đối tượng Point, tại vị tri insert block. Mục đích, có thể là để chuyển bản vẽ Cad sang một phần mềm khác. Sau đó, trong phần mềm khác này, sẽ chuyển các points này thành symbol theo yêu cầu người dùng??

×