Đến nội dung


Hình ảnh
- - - - -

trích do


  • Please log in to reply
55 replies to this topic

#21 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 25 September 2009 - 01:45 PM

Chào bác phamthanhbinh
Cám ơn Bác đã có nhã ý, nhưng thực sự Bài toán này cũng khá lớn mà lại không thuộc chuyên môn của mình nên đành "bó tay".
Chúc bác mạnh khỏe, luôn thăng tiến trong công việc.

Chào các bác phamthanhbinh, khaosat2009, gia_bach,
Nếu trích bản đồ theo 1 ô window nào đó thì có thể áp dụng 1 phần lisp break_with vào được mà. Thiep xin gánh 1 chút cho việc này nhé
  • 2

#22 khaosat2009

khaosat2009

    biết lệnh offset

  • Members
  • PipPipPip
  • 171 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 25 September 2009 - 09:13 PM

MÌnh sưu tam được file lisp có thể copy đồi tượng theo ô.
Mình có thể dùng lisp này cắt và scase.
Huy vọng chia sẻ được chút ít với các Bạn.
  • 0

#23 khaosat2009

khaosat2009

    biết lệnh offset

  • Members
  • PipPipPip
  • 171 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 25 September 2009 - 09:18 PM

Chào các bác phamthanhbinh, khaosat2009, gia_bach,
Nếu trích bản đồ theo 1 ô window nào đó thì có thể áp dụng 1 phần lisp break_with vào được mà. Thiep xin gánh 1 chút cho việc này nhé


Rất mong được bạn giúp đở và chia sẻ.
  • 0

#24 khaosat2009

khaosat2009

    biết lệnh offset

  • Members
  • PipPipPip
  • 171 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 28 September 2009 - 11:58 AM

MÌnh sưu tam được file lisp có thể copy đồi tượng theo ô.
Mình có thể dùng lisp này cắt và scase.
Huy vọng chia sẻ được chút ít với các Bạn.


  • 0

#25 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 28 September 2009 - 02:37 PM

MÌnh sưu tam được file lisp có thể copy đồi tượng theo ô.
Mình có thể dùng lisp này cắt và scase.
http://www.cadviet.c...files/2/cwb.rar
Huy vọng chia sẻ được chút ít với các Bạn.

Chào khaosat2009, Lisp cwb của bác Gia_bach viết rất tuyệt vời khi copy, xóa, move các đối tượng trong ngoài 1 vùng kín, hay giữa 2 vùng kín. Tuy nhiên, các đối tượng gốc bị bẻ gãy hết. Lisp Thiep viết sau đây sẽ trích thửa bản đồ, theo 1 ô vuông có kích thước cạnh do user tự chọn.
Sau khi tạo ô vuông xong, user rê ô vuông này vào khu vực cần trích thửa, nó sẽ copy các đối tượng bên trong và giao với ô vuông (ô vuông giống như 1 nam châm). Sau đó, user rê các đối tượng này đến vị trí cần đặt, ví dụ đặt ở giữa bản vẽ TRÍCH ĐO ĐỊA CHÍNH THỬA ĐẤT. Lisp sẽ cắt bỏ những đường bên ngoài ô vuông.
;;;-----------------------
(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 Text (model str po h ang / obj)
(setq obj (vla-AddText
*Model*
str
(vlax-3d-point po)
h
)
)
(vla-put-Alignment obj acAlignmentTopCenter)
(vla-put-TextAlignmentPoint obj (vlax-3d-point po))
)
;;;====================================================================
(defun break_with (Lstent enL / lst masterlist ss oc break_obj intpts)
(princ "\nCalculating Break Points, Please Wait.\n")

;;========================================
;; Break entity at break points in list
;;========================================

(defun break_obj (ent brkptlst / brkobjlst en
enttype maxparam closedobj minparam
obj obj2break p1param p2param
brkpt2 dlst idx brkptS
brkptE brkpt result result
ignore dist tmppt #ofpts
enddist lastent obj2break stdist
)
(setq obj2break ent
brkobjlst (list ent)
enttype (dxf 0 ent)
)
(if (not (or (eq (dxf 0 obj2break) "TEXT")
(eq (dxf 0 obj2break) "MTEXT")
)
)
(setq closedobj (vlax-curve-isclosed obj2break))
)
(setq spt (vlax-curve-getstartpoint ent)
ept (vlax-curve-getendpoint ent)
brkptlst (vl-remove-if
'(lambda (x)
(or (< (distance x spt) 0.0001)
(< (distance x ept) 0.0001)
)
)
brkptlst
)
)
(if (and brkptlst
(not (or (eq (dxf 0 obj2break) "TEXT")
(eq (dxf 0 obj2break) "MTEXT")
)
)
)
(progn
(setq brkptlst
(mapcar
'(lambda (x)
(list
x
(vlax-curve-getdistatparam
obj2break
(cond
((vlax-curve-getparamatpoint obj2break x)
)
((vlax-curve-getparamatpoint
obj2break
(vlax-curve-getclosestpointto
obj2break
x
)
)
)
)
)
)
)
brkptlst
)
)

(setq
brkptlst (vl-sort brkptlst
'(lambda (a1 a2) (< (cadr a1) (cadr a2)))
)
)

(foreach brkpt (reverse brkptlst)
(setq brkptS (car brkpt)
brkptE brkptS
)
;; get last entity created via break in case multiple breaks
(if brkobjlst
(progn
(setq tmppt brkptS) ; use only one of the pair of breakpoints
;; if pt not on object x, switch objects
(if (not (numberp (vl-catch-all-apply
'vlax-curve-getdistatpoint
(list obj2break tmppt)
)
)
)
(progn ; find the one that pt is on
(setq idx (length brkobjlst))
(while
(and (not (minusp (setq idx (1- idx))))
(setq obj (nth idx brkobjlst))
(if (numberp (vl-catch-all-apply
'vlax-curve-getdistatpoint
(list obj tmppt)
)
)
(null (setq obj2break obj))
; switch objects, null causes exit
t
)
)
)
)
)
)
); end (if brkobjlst

(if (not (or (eq (dxf 0 obj2break) "TEXT")
(eq (dxf 0 obj2break) "MTEXT")
)
)
(setq closedobj (vlax-curve-isclosed obj2break))
)
;;; single breakpoint ----------------------------------------------------
(if
(and closedobj
(not (setq
brkptE (vlax-curve-getPointAtDist
obj2break
(+ (vlax-curve-getdistatparam
obj2break
(cond
((vlax-curve-getparamatpoint
obj2break
brkpts
)
)
((vlax-curve-getparamatpoint
obj2break
(vlax-curve-getclosestpointto
obj2break
brkpts
)
)
)
)
)
0.00001
)
)
)
)
)
(setq
brkptE (vlax-curve-getPointAtDist
obj2break
(- (vlax-curve-getdistatparam
obj2break
(cond ((vlax-curve-getparamatpoint
obj2break
brkpts
)
)
((vlax-curve-getparamatpoint
obj2break
(vlax-curve-getclosestpointto
obj2break
brkpts
)
)
)
)
)
0.00001
)
)
); end setq brkptE
); end fi (and closedobj

;; (if (null brkptE) (princ)) ; debug
(setq LastEnt (GetLastEnt))
(if (not (or (eq (dxf 0 obj2break) "TEXT")
(eq (dxf 0 obj2break) "MTEXT")
)
)
(command "._break"
obj2break
"_non"
(trans brkptS 0 1)
"_non"
(trans brkptE 0 1)
)
)
(and (= "CIRCLE" enttype) (setq enttype "ARC"))
(if (and (not closedobj) ; new object was created
(not (equal LastEnt (entlast)))
)
(setq brkobjlst (cons (entlast) brkobjlst))
); end (if (and
); end (foreach brkpt
);end progn brkptlst
); end if brkptlst

); defun break_obj

;;====================================
;; CAB - get last entity in datatbase
(defun GetLastEnt (/ ename result)
(if (setq result (entlast))
(while (setq ename (entnext result))
(setq result ename)
)
)
result
)
;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;; S T A R T S U B R O U T I N E H E R E
;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(if (and Lstent enL)
(progn
;; CREATE a list of entity & it's break points
(foreach en Lstent
; check each object in Lstent
(if (not (acet-layer-locked (dxf 8 en)))
(progn
(setq lst nil)
;; check for break pts with other objects in Lstentwith
(if (and (not (equal en enint))
(setq intpts (acet-geom-intersectwith en enL 0))
)
(setq lst (append intpts lst))
; entity w/ break points
)
(if lst
(setq masterlist
(cons (cons en lst) masterlist)
)
)
)
)
)
(princ "\nBreaking Objects.\n")
(if masterlist
(progn
(acet-ui-progress "hoan thanh %" (length masterlist))
(foreach obj2brk masterlist
(break_obj (car obj2brk) (cdr obj2brk))
(acet-ui-progress -1)
)
(acet-ui-progress)
)
)
)
)
);end break_with
;;===========================================================================
;; get all objects touching entities in the sscross
;; limited obj types to "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"
;; returns a list of enames
;;===========================================================================
(defun gettouching (en / ss lst lstb lstc objl)
(and
(setq objl (vlax-ename->vla-object en))
(setq
ss
(ssget
"_A"
(list
(cons 0
"LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"
)
(cons 410 (getvar "ctab"))
)
)
)
(setq lst (SS-enlst ss)
lst (mapcar 'vlax-ename->vla-object lst))
(mapcar
'(lambda (x)
(if (not
(vl-catch-all-error-p
(vl-catch-all-apply
'(lambda ()
(vlax-safearray->list
(vlax-variant-value
(vla-intersectwith objl x acextendnone)
)
)
)
)
)
)
(setq lstc (cons (vlax-vla-object->ename x) lstc))
)
)
lst
)
)
lstc
)
;;;------------------------------------------------
(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 DXF (code en) (cdr (assoc code (entget en))))
;;;============================================================
;;;=======================MAIN LISP============================
;;;============================================================
(defun c:trichBD (/ ActDoc *Model* ss encur lsten p1 p2 p3 LenssBR lstp objCE)
(setq ActDoc (vla-get-ActiveDocument (vlax-get-acad-object))
*Model* (vla-get-ModelSpace ActDoc)
)
(setq bit1 (cond (bit1)
("Rectangle")
)
)
(initget "Square Rectangle Circle Ellipse Different")
(setq tmp (strcat "\nChon duong bao: [Square/Rectangle/Circle/Ellipse/Different] <" bit1 ">: ")
bit1 (cond ((getkword tmp))
(bit1)
)
)
(vla-StartUndoMark ActDoc)
(setvar "cecolor" "104")
(setq p1 (list (car (getvar "extmin")) (cadr (getvar "extmin"))))
(cond ((eq bit1 "Square")
(setq a (cond (a)
(50)
)
)
(setq olda a)
(setq a (getreal (strcat "\nChon kich thuoc canh Square <"
(rtos olda 2 1)
"> : "
)
)
)
(if (null a)
(setq a olda)
)
(setq lstp (list (list (car p1) (cadr p1) 0)
(list (+ (car p1) a) (cadr p1) 0)
(list (+ (car p1) a) (+ (cadr p1) a) 0)
(list (car p1) (+ (cadr p1) a) 0)
(list (car p1) (cadr p1) 0)
)
)
)
((eq bit1 "Rectangle")
(setq a (cond (a)
(50)
)
)
(setq olda a)
(setq a (getreal (strcat "\nChon chieu dai Rectangle <"
(rtos olda 2 1)
"> : "
)
)
)
(if (null a)
(setq a olda)
)
(setq b (cond ( b )
(50)
)
)
(setq oldb b )
(setq b (getreal (strcat "\nChon chieu rong Rectangle <"
(rtos oldb 2 1)
"> : "
)
)
)
(if (null b )
(setq b oldb)
)
(setq lstp (list (list (car p1) (cadr p1) 0)
(list (+ (car p1) a) (cadr p1) 0)
(list (+ (car p1) a) (+ (cadr p1) b ) 0)
(list (car p1) (+ (cadr p1) b ) 0)
(list (car p1) (cadr p1) 0)
)
)
)
((eq bit1 "Circle")
(setq a (cond (a)
(50)
)
)
(setq olda a)
(setq a (getreal (strcat "\nChon ban kinh Circle <"
(rtos olda 2 1)
"> : "
)
)
)
(if (null a)
(setq a olda)
)
(setq objCE (vla-addCircle *Model* (vlax-3d-point p1) a))
(setq cir (entlast))
(setq cv (* a 2 pi)
lstp (list (vlax-curve-getStartPoint cir))
d (/ cv 160)
l 0.0
)
(repeat 160
(setq l (+ l d)
p (vlax-curve-getPointAtDist cir l)
lstp (append lstp (List p))
)
)
);end bit1 "Circle"

;;; ((eq bit1 "Ellipse")
;;; (setq a (getpoint p1 "\nPick diem ban kinh lon cua Ellipse"))
;;; (vl-cmdf ".Ellipse" pause pause pause); erro ttuc
;;; (setq objCE (entlast)
;;; p1 (vlax-curve-getStartPoint objCE))
;;; (command ".LENGTHEN" objCE "")
;;; (setq cv (getvar "perimeter")
;;; lstp (list p1)
;;; d (/ cv 160)
;;; l 0.0
;;; )
;;; (repeat 160
;;; (setq l (+ l d)
;;; p (vlax-curve-getPointAtDist objCE l)
;;; lstp (append lstp (List p))
;;; )
;;; )
;;; );end bit1 "Ellipse"
;;; ((eq bit1 "Different")
;;; (prompt "\nchon 1 curve kin:")
;;; (setq ss (ssget)
;;; encur (ssname ss 0)
;;; objCE (vlax-ename->vla-object encur)
;;; p1 (vlax-curve-getStartPoint encur))
;;; (if (or (eq (dxf 0 encur) "LWPOLYLINE")
;;; (eq (dxf 0 encur) "POLYLINE")
;;; )
;;; (setq lstp (acet-geom-VERTEX-LIST encur))
;;; (progn
;;; (command ".LENGTHEN" encur "")
;;; (setq cv (getvar "perimeter")
;;; lstp (list p1)
;;; d (/ cv 160)
;;; l 0.0
;;; )
;;; (repeat 160
;;; (setq l (+ l d)
;;; p (vlax-curve-getPointAtDist encur l)
;;; lstp (append lstp (List p))
;;; )
;;; )
;;; )
;;; )
;;; )
);end cond
(vla-ZoomExtents (vlax-get-acad-object))
(ACET-LWPLINE-MAKE (list lstp))
(setq ss (ssadd (entlast) (ssadd)))
(setq p2 (ACET-SS-DRAG-MOVE
ss
(list (car p1) (cadr p1))
"Chon vi tri bat dau trich thua: "
)
)
(command ".move" ss "" p1 p2)
(setq encur (entlast)
lstp (acet-geom-VERTEX-LIST encur))
(setq ss (ssdel encur (ssget "_CP" lstp)))
(command ".copy" ss "" p2 p2)
(setq p3 (ACET-SS-DRAG-MOVE
(ssadd encur ss)
p2
"Chon vi tri dat ban do trich thua: "
)
)
(command ".move" ss encur "" p2 p3)
(setvar "cecolor" "0")
(setq lsten (vl-remove encur (gettouching encur)))
(break_with lsten encur)
(vlax-invoke-method ActDoc 'Regen acActiveViewport)
(vla-offset (vlax-ename->vla-object encur) (* (getvar "viewsize") 0.0001))
(setq lstp (acet-geom-vertex-list (entlast)))
(entdel (entlast))
(if (equal (vlax-curve-getEndParam encur) 160 1) (entdel encur))
(setq LenssBR (SS-enlst (ssget "F" lstp)))
(mapcar '(lambda (x)
(if (or (not (eq (dxf 0 x) "TEXT"))
(not (eq (dxf 0 x) "MTEXT"))
)
(entdel x)
)
)
LenssBR
)
(if objCE (vla-move objCE (vlax-3d-point p1) (vlax-3d-point p3)))
(vla-EndUndoMark ActDoc)
(princ "\nChuc cac ban gat hai nhieu thanh cong. Thiep")
(princ)
)

Bài viết đã được chỉnh sửa nội dung bởi phamthanhbinh: 19 November 2010 - 02:00 PM

  • 2

#26 khaosat2009

khaosat2009

    biết lệnh offset

  • Members
  • PipPipPip
  • 171 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 28 September 2009 - 03:09 PM

Cám ơn Anh Thiep nha.
Lisp của anh thể hiện hết sức tuyệt, Rất có ích .
Anh viết thêm cho phần tăng/ giãm theo yên cầu trích thửa của tỉ lệ bản đồ đi.
Lisp hỏi Bản đồ gốc tỉ lệ bao nhiêu ?
Trích ra tỉ lệ bao nhiêu ? Kết qủa Ghi ra ghi chú ở phần dưới giữa khung phía nam tỉ lệ trích.
Rất mong được anh giúp.
  • 0

#27 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 29 September 2009 - 06:54 PM

Chào khaosat2009, Lisp cwb của bác Gia_bach viết rất tuyệt vời khi copy, xóa, move các đối tượng trong ngoài 1 vùng kín, hay giữa 2 vùng kín. Tuy nhiên, các đối tượng gốc bị bẻ gãy hết. Lisp Thiep viết sau đây sẽ trích thửa bản đồ, theo 1 ô vuông có kích thước cạnh do user tự chọn.
Sau khi tạo ô vuông xong, user rê ô vuông này vào khu vực cần trích thửa, nó sẽ copy các đối tượng bên trong và giao với ô vuông (ô vuông giống như 1 nam châm). Sau đó, user rê các đối tượng này đến vị trí cần đặt, ví dụ đặt ở giữa bản vẽ TRÍCH ĐO ĐỊA CHÍNH THỬA ĐẤT. Lisp sẽ cắt bỏ những đường bên ngoài ô vuông.


Chào bạn khaosat 2009,
Hề hề, đúng như mình dự đoán các bác ấy mà rảnh tay là giúp bạn rất nhanh mà. Riêng mình do cái trình độ lisp còn hơi lùn nên loay hoay mãi bữa nay mới ra được cái coi có vẻ dùng được. Nhưng có lẽ có lỗi như bác Thiep đã nói là nó sẽ bẻ vụn các đường biên có giao với biên vùng chọn. Việc khắc phục cái lỗi này thì mình chưa nghĩ ra biện pháp nào hay hơn ngoài việc copy thằng cu gốc ra một file khác để xử lý nó cho khỏi bận tâm tới bản gốc nữa.
Hiện tại lisp này mình chỉ dừng ở việc copy cái khung có chứa thửa đất của bạn vào cilpboard, còn việc paste nó vào đâu là tùy bạn nhé. Do chưa rõ nó đã đạt yêu cầu của bạn chưa nên mình chưa giải quyết tiếp các việc như đánh số các góc ranh, ghi chiều dài các cạnh thửa đất, lập bảng tọa độ góc ranh ....... Những điều này không khó lắm nữa khi đã có cái lisp lần trước mình gửi. Việc chỉnh sửa và bổ sung nó vào cái lisp mới này nếu bạn có thể tự làm được thì quá tốt, còn không thì mình có thể giúp bạn sau nhé.
Bạn hãy xem thử cái kết quả của lisp này đã trúng ý bạn chưa nhé. Cần chỉnh sửa gì thì bạn cứ mạnh dạn cho mình biết để mình suy nghĩ thêm.
Lisp đây bạn:
http://www.cadviet.c.../trichdonew.lsp
Và đây là một cái kết quả mà mình đã chạy thử:
http://www.cadviet.c...c_4f135ivdm.dwg

Chúc bạn luôn vui.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#28 khaosat2009

khaosat2009

    biết lệnh offset

  • Members
  • PipPipPip
  • 171 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 30 September 2009 - 10:09 AM

Chào khaosat2009, Lisp cwb của bác Gia_bach viết rất tuyệt vời khi copy, xóa, move các đối tượng trong ngoài 1 vùng kín, hay giữa 2 vùng kín. Tuy nhiên, các đối tượng gốc bị bẻ gãy hết. Lisp Thiep viết sau đây sẽ trích thửa bản đồ, theo 1 ô vuông có kích thước cạnh do user tự chọn.
Sau khi tạo ô vuông xong, user rê ô vuông này vào khu vực cần trích thửa, nó sẽ copy các đối tượng bên trong và giao với ô vuông (ô vuông giống như 1 nam châm). Sau đó, user rê các đối tượng này đến vị trí cần đặt, ví dụ đặt ở giữa bản vẽ TRÍCH ĐO ĐỊA CHÍNH THỬA ĐẤT. Lisp sẽ cắt bỏ những đường bên ngoài ô vuông.

;;;-----------------------
(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 break_with (Lstent enL / lst masterlist ss oc break_obj intpts)
(princ "\nCalculating Break Points, Please Wait.\n")

;;========================================
;; Break entity at break points in list
;;========================================

(defun break_obj (ent brkptlst / brkobjlst en
enttype maxparam closedobj minparam
obj obj2break p1param p2param
brkpt2 dlst idx brkptS
brkptE brkpt result result
ignore dist tmppt #ofpts
enddist lastent obj2break stdist
)
(setq obj2break ent
brkobjlst (list ent)
enttype (dxf 0 ent)
)
(if (not (or (eq (dxf 0 obj2break) "TEXT")
(eq (dxf 0 obj2break) "MTEXT")
)
)
(setq closedobj (vlax-curve-isclosed obj2break))
)
(setq spt (vlax-curve-getstartpoint ent)
ept (vlax-curve-getendpoint ent)
brkptlst (vl-remove-if
'(lambda (x)
(or (< (distance x spt) 0.0001)
(< (distance x ept) 0.0001)
)
)
brkptlst
)
)
(if (and brkptlst
(not (or (eq (dxf 0 obj2break) "TEXT")
(eq (dxf 0 obj2break) "MTEXT")
)
)
)
(progn
(setq brkptlst
(mapcar
'(lambda (x)
(list
x
(vlax-curve-getdistatparam
obj2break
(cond
((vlax-curve-getparamatpoint obj2break x)
)
((vlax-curve-getparamatpoint
obj2break
(vlax-curve-getclosestpointto
obj2break
x
)
)
)
)
)
)
)
brkptlst
)
)

(setq
brkptlst (vl-sort brkptlst
'(lambda (a1 a2) (< (cadr a1) (cadr a2)))
)
)

(foreach brkpt (reverse brkptlst)
(setq brkptS (car brkpt)
brkptE brkptS
)
;; get last entity created via break in case multiple breaks
(if brkobjlst
(progn
(setq tmppt brkptS) ; use only one of the pair of breakpoints
;; if pt not on object x, switch objects
(if (not (numberp (vl-catch-all-apply
'vlax-curve-getdistatpoint
(list obj2break tmppt)
)
)
)
(progn ; find the one that pt is on
(setq idx (length brkobjlst))
(while
(and (not (minusp (setq idx (1- idx))))
(setq obj (nth idx brkobjlst))
(if (numberp (vl-catch-all-apply
'vlax-curve-getdistatpoint
(list obj tmppt)
)
)
(null (setq obj2break obj))
; switch objects, null causes exit
t
)
)
)
)
)
)
); end (if brkobjlst

;;; Handle any objects that can not be used with the Break Command
;;; using one point, gap of 0.000001 is used
(if (not (or (eq (dxf 0 obj2break) "TEXT")
(eq (dxf 0 obj2break) "MTEXT")
)
)
(setq closedobj (vlax-curve-isclosed obj2break))
)
;;; single breakpoint ----------------------------------------------------
(if
(and closedobj
(not (setq
brkptE (vlax-curve-getPointAtDist
obj2break
(+ (vlax-curve-getdistatparam
obj2break
;;(vlax-curve-getparamatpoint obj2break brkpts)) 0.00001))))
;; ver 2.0 fix
(cond
((vlax-curve-getparamatpoint
obj2break
brkpts
)
)
((vlax-curve-getparamatpoint
obj2break
(vlax-curve-getclosestpointto
obj2break
brkpts
)
)
)
)
)
0.00001
)
)
)
)
)
(setq
brkptE (vlax-curve-getPointAtDist
obj2break
(- (vlax-curve-getdistatparam
obj2break
(cond ((vlax-curve-getparamatpoint
obj2break
brkpts
)
)
((vlax-curve-getparamatpoint
obj2break
(vlax-curve-getclosestpointto
obj2break
brkpts
)
)
)
)
)
0.00001
)
)
); end setq brkptE
); end fi (and closedobj

;; (if (null brkptE) (princ)) ; debug
(setq LastEnt (GetLastEnt))
(if (not (or (eq (dxf 0 obj2break) "TEXT")
(eq (dxf 0 obj2break) "MTEXT")
)
)
(command "._break"
obj2break
"_non"
(trans brkptS 0 1)
"_non"
(trans brkptE 0 1)
)
)
(and (= "CIRCLE" enttype) (setq enttype "ARC"))
(if (and (not closedobj) ; new object was created
(not (equal LastEnt (entlast)))
)
(setq brkobjlst (cons (entlast) brkobjlst))
); end (if (and
); end (foreach brkpt
);end progn brkptlst
); end if brkptlst

); defun break_obj

;;====================================
;; CAB - get last entity in datatbase
(defun GetLastEnt (/ ename result)
(if (setq result (entlast))
(while (setq ename (entnext result))
(setq result ename)
)
)
result
)
;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;; S T A R T S U B R O U T I N E H E R E
;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(if (and Lstent enL)
(progn
;; CREATE a list of entity & it's break points
(foreach en Lstent
; check each object in Lstent
(if (not (acet-layer-locked (dxf 8 en)))
(progn
(setq lst nil)
;; check for break pts with other objects in Lstentwith
(if (and (not (equal en enint))
(setq intpts (acet-geom-intersectwith en enL 0))
)
(setq lst (append intpts lst))
; entity w/ break points
)
(if lst
(setq masterlist
(cons (cons en lst) masterlist)
)
)
)
)
)
(princ "\nBreaking Objects.\n")
(if masterlist
(foreach obj2brk masterlist
(break_obj (car obj2brk) (cdr obj2brk))
)
)
)
)
);end break_with
;;===========================================================================
;; get all objects touching entities in the sscross
;; limited obj types to "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"
;; returns a list of enames
;;===========================================================================
(defun gettouching (en / ss lst lstb lstc objl)
(and
(setq objl (vlax-ename->vla-object en))
(setq
ss
(ssget
"_A"
(list
(cons 0
"LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"
)
(cons 410 (getvar "ctab"))
)
)
)
(setq lst (SS-enlst ss)
lst (mapcar 'vlax-ename->vla-object lst))
(mapcar
'(lambda (x)
(if (not
(vl-catch-all-error-p
(vl-catch-all-apply
'(lambda ()
(vlax-safearray->list
(vlax-variant-value
(vla-intersectwith objl x acextendnone)
)
)
)
)
)
)
(setq lstc (cons (vlax-vla-object->ename x) lstc))
)
)
lst
)
)
lstc
)
;;;------------------------------------------------
(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 DXF (code en) (cdr (assoc code (entget en))))
;;;============================================================
;;;=======================MAIN LISP============================
;;;============================================================
(defun c:trichthua (/ ss p2 encur lstss1 emin emax p3 LenssBR)
(setq ActDoc (vla-get-ActiveDocument (vlax-get-acad-object))
*Model* (vla-get-ModelSpace ActDoc)
)
(vla-StartUndoMark ActDoc)
(setq a (cond (a)
(50)
)
)
(setq olda a)
(setq a (getreal (strcat "\nChon kich thuoc cat hinh vuong cat <"
(rtos olda 2 1)
"> : ")))
(if (null a) (setq a olda))
(setq emin (list (car (getvar "extmin")) (cadr (getvar "extmin"))))
(setvar "cecolor" "104")
(setq lstp (list (car emin)
(cadr emin)
(+ (car emin) a)
(cadr emin)
(+ (car emin) a)
(+ (cadr emin) a)
(car emin)
(+ (cadr emin) a)
)
)
(vla-put-closed (LWP lstp *Model*) :vlax-True)
(setq ss (ssadd (entlast) (ssadd)))
(setq p2 (ACET-SS-DRAG-MOVE
ss
(list (car emin) (cadr emin))
"Chon vi tri bat dau trich thua: "
)
)
(command ".move" ss "" emin p2)
(setq encur (entlast)
lstp (acet-geom-VERTEX-LIST encur))
(setq ss (ssdel encur (ssget "_CP" lstp)))
(command ".copy" ss "" p2 p2)
(setq p3 (ACET-SS-DRAG-MOVE
(ssadd encur ss)
p2
"Chon vi tri dat ban do trich thua: "
)
)
(command ".move" ss encur "" p2 p3)
(setvar "cecolor" "0")
(setq encur (ssname (ssget "X" '((62 . 104))) 0))
(setq lstobj1 (vl-remove encur (gettouching encur))
ss (acet-list-to-ss lstobj1)
)
(acet-ss-zoom-extents ss)
(break_with lstobj1 encur)
(vlax-invoke-method ActDoc 'Regen acActiveViewport)
(vla-offset (vlax-ename->vla-object encur) (* (getvar "viewsize") 0.002))
(setq lst3 (acet-geom-vertex-list (entlast)))
(entdel (entlast))
(setq LenssBR (SS-enlst (ssget "F" lst3)))
(foreach x LenssBR
(if (or (not (eq (dxf 0 x) "TEXT"))
(not (eq (dxf 0 x) "MTEXT"))
)
(entdel x)
)
)
(vla-EndUndoMark ActDoc)
(princ "\nChuc cac ban gat hai nhieu thanh cong. Thiep")
)

Hiên nay mình chạy Lisp Của Bạn nó lại báo lỗi này :
displacement or :
Command: ; error: bad argument type: lselsetp
Mong được Bạn giúp
  • 0

#29 khaosat2009

khaosat2009

    biết lệnh offset

  • Members
  • PipPipPip
  • 171 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 30 September 2009 - 10:12 AM

Chào bạn khaosat 2009,
Hề hề, đúng như mình dự đoán các bác ấy mà rảnh tay là giúp bạn rất nhanh mà. Riêng mình do cái trình độ lisp còn hơi lùn nên loay hoay mãi bữa nay mới ra được cái coi có vẻ dùng được. Nhưng có lẽ có lỗi như bác Thiep đã nói là nó sẽ bẻ vụn các đường biên có giao với biên vùng chọn. Việc khắc phục cái lỗi này thì mình chưa nghĩ ra biện pháp nào hay hơn ngoài việc copy thằng cu gốc ra một file khác để xử lý nó cho khỏi bận tâm tới bản gốc nữa.
Hiện tại lisp này mình chỉ dừng ở việc copy cái khung có chứa thửa đất của bạn vào cilpboard, còn việc paste nó vào đâu là tùy bạn nhé. Do chưa rõ nó đã đạt yêu cầu của bạn chưa nên mình chưa giải quyết tiếp các việc như đánh số các góc ranh, ghi chiều dài các cạnh thửa đất, lập bảng tọa độ góc ranh ....... Những điều này không khó lắm nữa khi đã có cái lisp lần trước mình gửi. Việc chỉnh sửa và bổ sung nó vào cái lisp mới này nếu bạn có thể tự làm được thì quá tốt, còn không thì mình có thể giúp bạn sau nhé.
Bạn hãy xem thử cái kết quả của lisp này đã trúng ý bạn chưa nhé. Cần chỉnh sửa gì thì bạn cứ mạnh dạn cho mình biết để mình suy nghĩ thêm.
Lisp đây bạn:
http://www.cadviet.c.../trichdonew.lsp
Và đây là một cái kết quả mà mình đã chạy thử:
http://www.cadviet.c...c_4f135ivdm.dwg

Chúc bạn luôn vui.

Sao nó chớp qúa lâu nhưng không ra kết qủa.
Mong được bạn chỉ bảo cho.
  • 0

#30 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 30 September 2009 - 10:21 AM

Hiên nay mình chạy Lisp Của Bạn nó lại báo lỗi này :
displacement or :
Command: ; error: bad argument type: lselsetp
Mong được Bạn giúp

Code bạn thiep không bị lỗi. -> vào codebox -> bị mã hoá.
Bạn thử cái mẹo này của Tue_NV xem sao :

Thế này nhé bạn nhấn nút Reply bài viết số 25 của Thiep -> Chép hết code của bạn thiep về chạy là được


(princ "\nChuc cac ban gat hai nhieu thanh cong. Thiep")
  • 1

#31 khaosat2009

khaosat2009

    biết lệnh offset

  • Members
  • PipPipPip
  • 171 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 30 September 2009 - 10:53 AM

Chào khaosat2009, Lisp cwb của bác Gia_bach viết rất tuyệt vời khi copy, xóa, move các đối tượng trong ngoài 1 vùng kín, hay giữa 2 vùng kín. Tuy nhiên, các đối tượng gốc bị bẻ gãy hết. Lisp Thiep viết sau đây sẽ trích thửa bản đồ, theo 1 ô vuông có kích thước cạnh do user tự chọn.
Sau khi tạo ô vuông xong, user rê ô vuông này vào khu vực cần trích thửa, nó sẽ copy các đối tượng bên trong và giao với ô vuông (ô vuông giống như 1 nam châm). Sau đó, user rê các đối tượng này đến vị trí cần đặt, ví dụ đặt ở giữa bản vẽ TRÍCH ĐO ĐỊA CHÍNH THỬA ĐẤT. Lisp sẽ cắt bỏ những đường bên ngoài ô vuông.

;;;-----------------------
(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 break_with (Lstent enL / lst masterlist ss oc break_obj intpts)
(princ "\nCalculating Break Points, Please Wait.\n")

;;========================================
;; Break entity at break points in list
;;========================================

(defun break_obj (ent brkptlst / brkobjlst en
enttype maxparam closedobj minparam
obj obj2break p1param p2param
brkpt2 dlst idx brkptS
brkptE brkpt result result
ignore dist tmppt #ofpts
enddist lastent obj2break stdist
)
(setq obj2break ent
brkobjlst (list ent)
enttype (dxf 0 ent)
)
(if (not (or (eq (dxf 0 obj2break) "TEXT")
(eq (dxf 0 obj2break) "MTEXT")
)
)
(setq closedobj (vlax-curve-isclosed obj2break))
)
(setq spt (vlax-curve-getstartpoint ent)
ept (vlax-curve-getendpoint ent)
brkptlst (vl-remove-if
'(lambda (x)
(or (< (distance x spt) 0.0001)
(< (distance x ept) 0.0001)
)
)
brkptlst
)
)
(if (and brkptlst
(not (or (eq (dxf 0 obj2break) "TEXT")
(eq (dxf 0 obj2break) "MTEXT")
)
)
)
(progn
(setq brkptlst
(mapcar
'(lambda (x)
(list
x
(vlax-curve-getdistatparam
obj2break
(cond
((vlax-curve-getparamatpoint obj2break x)
)
((vlax-curve-getparamatpoint
obj2break
(vlax-curve-getclosestpointto
obj2break
x
)
)
)
)
)
)
)
brkptlst
)
)

(setq
brkptlst (vl-sort brkptlst
'(lambda (a1 a2) (< (cadr a1) (cadr a2)))
)
)

(foreach brkpt (reverse brkptlst)
(setq brkptS (car brkpt)
brkptE brkptS
)
;; get last entity created via break in case multiple breaks
(if brkobjlst
(progn
(setq tmppt brkptS) ; use only one of the pair of breakpoints
;; if pt not on object x, switch objects
(if (not (numberp (vl-catch-all-apply
'vlax-curve-getdistatpoint
(list obj2break tmppt)
)
)
)
(progn ; find the one that pt is on
(setq idx (length brkobjlst))
(while
(and (not (minusp (setq idx (1- idx))))
(setq obj (nth idx brkobjlst))
(if (numberp (vl-catch-all-apply
'vlax-curve-getdistatpoint
(list obj tmppt)
)
)
(null (setq obj2break obj))
; switch objects, null causes exit
t
)
)
)
)
)
)
); end (if brkobjlst

;;; Handle any objects that can not be used with the Break Command
;;; using one point, gap of 0.000001 is used
(if (not (or (eq (dxf 0 obj2break) "TEXT")
(eq (dxf 0 obj2break) "MTEXT")
)
)
(setq closedobj (vlax-curve-isclosed obj2break))
)
;;; single breakpoint ----------------------------------------------------
(if
(and closedobj
(not (setq
brkptE (vlax-curve-getPointAtDist
obj2break
(+ (vlax-curve-getdistatparam
obj2break
;;(vlax-curve-getparamatpoint obj2break brkpts)) 0.00001))))
;; ver 2.0 fix
(cond
((vlax-curve-getparamatpoint
obj2break
brkpts
)
)
((vlax-curve-getparamatpoint
obj2break
(vlax-curve-getclosestpointto
obj2break
brkpts
)
)
)
)
)
0.00001
)
)
)
)
)
(setq
brkptE (vlax-curve-getPointAtDist
obj2break
(- (vlax-curve-getdistatparam
obj2break
(cond ((vlax-curve-getparamatpoint
obj2break
brkpts
)
)
((vlax-curve-getparamatpoint
obj2break
(vlax-curve-getclosestpointto
obj2break
brkpts
)
)
)
)
)
0.00001
)
)
); end setq brkptE
); end fi (and closedobj

;; (if (null brkptE) (princ)) ; debug
(setq LastEnt (GetLastEnt))
(if (not (or (eq (dxf 0 obj2break) "TEXT")
(eq (dxf 0 obj2break) "MTEXT")
)
)
(command "._break"
obj2break
"_non"
(trans brkptS 0 1)
"_non"
(trans brkptE 0 1)
)
)
(and (= "CIRCLE" enttype) (setq enttype "ARC"))
(if (and (not closedobj) ; new object was created
(not (equal LastEnt (entlast)))
)
(setq brkobjlst (cons (entlast) brkobjlst))
); end (if (and
); end (foreach brkpt
);end progn brkptlst
); end if brkptlst

); defun break_obj

;;====================================
;; CAB - get last entity in datatbase
(defun GetLastEnt (/ ename result)
(if (setq result (entlast))
(while (setq ename (entnext result))
(setq result ename)
)
)
result
)
;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;; S T A R T S U B R O U T I N E H E R E
;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(if (and Lstent enL)
(progn
;; CREATE a list of entity & it's break points
(foreach en Lstent
; check each object in Lstent
(if (not (acet-layer-locked (dxf 8 en)))
(progn
(setq lst nil)
;; check for break pts with other objects in Lstentwith
(if (and (not (equal en enint))
(setq intpts (acet-geom-intersectwith en enL 0))
)
(setq lst (append intpts lst))
; entity w/ break points
)
(if lst
(setq masterlist
(cons (cons en lst) masterlist)
)
)
)
)
)
(princ "\nBreaking Objects.\n")
(if masterlist
(foreach obj2brk masterlist
(break_obj (car obj2brk) (cdr obj2brk))
)
)
)
)
);end break_with
;;===========================================================================
;; get all objects touching entities in the sscross
;; limited obj types to "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"
;; returns a list of enames
;;===========================================================================
(defun gettouching (en / ss lst lstb lstc objl)
(and
(setq objl (vlax-ename->vla-object en))
(setq
ss
(ssget
"_A"
(list
(cons 0
"LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"
)
(cons 410 (getvar "ctab"))
)
)
)
(setq lst (SS-enlst ss)
lst (mapcar 'vlax-ename->vla-object lst))
(mapcar
'(lambda (x)
(if (not
(vl-catch-all-error-p
(vl-catch-all-apply
'(lambda ()
(vlax-safearray->list
(vlax-variant-value
(vla-intersectwith objl x acextendnone)
)
)
)
)
)
)
(setq lstc (cons (vlax-vla-object->ename x) lstc))
)
)
lst
)
)
lstc
)
;;;------------------------------------------------
(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 DXF (code en) (cdr (assoc code (entget en))))
;;;============================================================
;;;=======================MAIN LISP============================
;;;============================================================
(defun c:trichthua (/ ss p2 encur lstss1 emin emax p3 LenssBR)
(setq ActDoc (vla-get-ActiveDocument (vlax-get-acad-object))
*Model* (vla-get-ModelSpace ActDoc)
)
(vla-StartUndoMark ActDoc)
(setq a (cond (a)
(50)
)
)
(setq olda a)
(setq a (getreal (strcat "\nChon kich thuoc cat hinh vuong cat <"
(rtos olda 2 1)
"> : ")))
(if (null a) (setq a olda))
(setq emin (list (car (getvar "extmin")) (cadr (getvar "extmin"))))
(setvar "cecolor" "104")
(setq lstp (list (car emin)
(cadr emin)
(+ (car emin) a)
(cadr emin)
(+ (car emin) a)
(+ (cadr emin) a)
(car emin)
(+ (cadr emin) a)
)
)
(vla-put-closed (LWP lstp *Model*) :vlax-True)
(setq ss (ssadd (entlast) (ssadd)))
(setq p2 (ACET-SS-DRAG-MOVE
ss
(list (car emin) (cadr emin))
"Chon vi tri bat dau trich thua: "
)
)
(command ".move" ss "" emin p2)
(setq encur (entlast)
lstp (acet-geom-VERTEX-LIST encur))
(setq ss (ssdel encur (ssget "_CP" lstp)))
(command ".copy" ss "" p2 p2)
(setq p3 (ACET-SS-DRAG-MOVE
(ssadd encur ss)
p2
"Chon vi tri dat ban do trich thua: "
)
)
(command ".move" ss encur "" p2 p3)
(setvar "cecolor" "0")
(setq encur (ssname (ssget "X" '((62 . 104))) 0))
(setq lstobj1 (vl-remove encur (gettouching encur))
ss (acet-list-to-ss lstobj1)
)
(acet-ss-zoom-extents ss)
(break_with lstobj1 encur)
(vlax-invoke-method ActDoc 'Regen acActiveViewport)
(vla-offset (vlax-ename->vla-object encur) (* (getvar "viewsize") 0.002))
(setq lst3 (acet-geom-vertex-list (entlast)))
(entdel (entlast))
(setq LenssBR (SS-enlst (ssget "F" lst3)))
(foreach x LenssBR
(if (or (not (eq (dxf 0 x) "TEXT"))
(not (eq (dxf 0 x) "MTEXT"))
)
(entdel x)
)
)
(vla-EndUndoMark ActDoc)
(princ "\nChuc cac ban gat hai nhieu thanh cong. Thiep")
)

Anh Thiep ơi.
Qua Lisp của anh đã viết, anh giúp em thêm việc này nha:
Dựa vào bản đồ DC , mình chọn vào vị trí thửa thì nó trích ra thửa đó, cắt vùng bao quanh, ghi tọa độ , cạnh và chèn vào mẫu khung.
như file mẫu:
Rất mong được anh giúp
  • 0

#32 khaosat2009

khaosat2009

    biết lệnh offset

  • Members
  • PipPipPip
  • 171 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 30 September 2009 - 11:07 AM

Thế này nhé bạn nhấn nút Reply bài viết số 25 của Thiep -> Chép hết code của bạn thiep về chạy là được

Mình tìm không thấy bài của Bạn, mong được giúp
  • 0

#33 svba1608

svba1608

    Tưởng Thị Tú Khuyên

  • Moderator
  • PipPipPipPipPipPipPip
  • 601 Bài viết
Điểm đánh giá: 620 (tốt)

Đã gửi 30 September 2009 - 11:17 AM

Mình tìm không thấy bài của Bạn, mong được giúp

Bài viết số 25 của bạn thiệp là bài viết cùng trong trang này mà ở góc phía trên bên phải bài viết có dòng chữ "Gửi vào: #25"
  • 1
http://khuyen.space

#34 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 30 September 2009 - 11:28 AM

Sao nó chớp qúa lâu nhưng không ra kết qủa.
Mong được bạn chỉ bảo cho.

Khà khà,
Cái nhà bác này nóng ăn quá, nó chớp lâu là do bác chọn vùng quá lớn, chứa quá nhiều đường bao đó. Bác nói nó không ra kết quả thì bác phải cho biết nó báo cái lỗi gì chớ. Còn cái mình đã chạy bác xem chưa??? Nếu không ra kết quả thì sao mình có cái đó được.
Có thể do trình độ của mình còn kém nên cách viết lisp không được hay cho lắm nhưng cái kết quả thì mình phải nhắm đến chứ. Thực tế thì mình đã chạy thử rồi, tùy theo vùng chọn của bạn lớn hay bé mà nó nhanh hay chậm, tỷ dụ như cái hình mình gửi bạn thì nó chạy mất khoảng 30 giây. Qua theo dõi nó chạy mình thấy bản vẽ của bạn chứa rất nhiều đường lwpolyline chồng chéo lên nhau, do vậy nó có lâu cũng là điều phải chấp nhận thôi. Cũng có thể lisp của mình có lỗi mà mình chưa phát hiện ra, nhưng nói như bác thì mình chịu chết chả hiểu cái lỗi ấy ở đâu, giá bác chịu khó chờ cho nó chạy xong và đọc cái dòng báo lỗi của Cad thì may ra mình còn có tí chút manh mối mà gỡ rối bác ạ.
Cái việc nó chớp chớp khó chịu là do mình xài các lệnh của cad như erase, rectang,..... đó mà, nếu bạn hổng khoái nhìn thì cứ nhập xong kích thước vùng chọn thì đi ra ngoài làm điếu thuốc hay li cà phê gì đó, lúc vào là nó chạy xong mà, khỏi ngồi nhìn cho nó đau cái bụng bác ạ
Bác hãy thử lại nhé, hãy chọn vùng trích phù hợp và chịu khó chờ vài phút cho nó dừng chạy, khi đó trong clipboad đã có cái bác cần trích, chỉ việc dùng lệnh paste dán cái vùng trích đó vào chỗ bác cần. Nên nhớ là sau khi chạy lisp xong bác sẽ chả nhìn thấy gì đâu vì cái vùng chọn đó chỉ có trong clipboad thôi. Bác phải dùng tiếp lệnh paste thì mới nhòm thấy nó và đưa nó về đúng chỗ bác cần nha.
Hề hề, văn ngọng lisp nghịu, mong các bác thông cảm nha.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#35 trang7889

trang7889

    biết pan

  • Members
  • Pip
  • 6 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 30 September 2009 - 11:43 AM

xin chào tất cả các thành viên của cadviet!
mình thấy các bạn viết lisp rất hay, mình mới tập tành thôi mong các bạn dúp đỡ.
mình nhờ các thành viên giúp mình đọan lisp chèn khung tên tạo sẵn theo điểm pick vào bản vẽ hiện hành nhé.
thank!
  • 0

#36 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 30 September 2009 - 11:49 AM

Cám ơn Anh Thiep nha.
Lisp của anh thể hiện hết sức tuyệt, Rất có ích .
Anh viết thêm cho phần tăng/ giãm theo yên cầu trích thửa của tỉ lệ bản đồ đi.
Lisp hỏi Bản đồ gốc tỉ lệ bao nhiêu ?
Trích ra tỉ lệ bao nhiêu ? Kết qủa Ghi ra ghi chú ở phần dưới giữa khung phía nam tỉ lệ trích.
Rất mong được anh giúp.
http://www.cadviet.c.../trichthua1.rar

Hiên nay mình chạy Lisp Của Bạn nó lại báo lỗi này :
displacement or :
Command: ; error: bad argument type: lselsetp
Mong được Bạn giúp

Ủa, sao vừa nói "Lisp của anh thể hiện hết sức tuyệt, Rất có ích", lại vừa nói lại liền "Lisp Của Bạn nó lại báo lỗi" dậy cà? Mình test nhiều lần có lỗi gì đâu.
bạn chú ý có 1 dòng lạ trong textbox:
"http://img2.cadviet.com/forum/style_emoticons/default/wink.gif" style="vertical-align:middle" emoid=";)" border="0" alt="wink.gif">
và chép sửa lại cả đoạn bắt đầu từ (setq spt:
(setq spt (vlax-curve-getstartpoint ent)
ept (vlax-curve-getendpoint ent)
brkptlst (vl-remove-if
'(lambda (x)
(or (< (distance x spt) 0.0001)
(< (distance x ept) 0.0001)
)
)
brkptlst
)
)

Anh Thiep ơi.
Qua Lisp của anh đã viết, anh giúp em thêm việc này nha:
Dựa vào bản đồ DC , mình chọn vào vị trí thửa thì nó trích ra thửa đó, cắt vùng bao quanh, ghi tọa độ , cạnh và chèn vào mẫu khung.
như file mẫu:
http://www.cadviet.c...ch_thua_dat.rar
Rất mong được anh giúp

khaosat2009 sử dụng lisp của bác phamthanhbinh để trích thửa đất và tạo bảng tọa độ. Sau đó dùng lisp của thiep để trích bản đồ ra cũng được mà.
Theo mình nghĩ, lisp của Thiep cũng có có ích giúp cho các bạn cơ khí dùng để trích 1 phần chi tiết máy, giúp cho các bạn xây dựng trích các chi tiết kết cấu phức tạp để vẽ rõ thêm ... vì vậy không nên nhập 2 cái lisp này lại thành 1.
  • 0

#37 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 30 September 2009 - 12:06 PM

Anh Thiep ơi.
Qua Lisp của anh đã viết, anh giúp em thêm việc này nha:
Dựa vào bản đồ DC , mình chọn vào vị trí thửa thì nó trích ra thửa đó, cắt vùng bao quanh, ghi tọa độ , cạnh và chèn vào mẫu khung.
như file mẫu:
http://www.cadviet.c...ch_thua_dat.rar
Rất mong được anh giúp

Ối giời ơi là bác Khaosat 2009 ơi,
Bác là dân kỹ thuật mà bác trình bày yêu cầu của bác thế này có mà bố thằng Tây cũng thua chứ chả nói gì tới cư dân Cadviet nhà ta bác ạ. Cùng một vấn đề mà mỗi bài bác post là nó lại méo đi một tí. Đành rằng nó na ná như nhau nhưng cái thằng lisp nó chỉ có thể hiểu duy nhất một kiểu thôi chứ không thể đã bắt nó thế này giờ lại bắt nó thế khác. Như thế có mà nó kiện đến tận ông...... Khaosat 2009 ấy chứ.
Cái bản Sơ đồ trích thửa ban đầu của bác có mỗi trần xì cái ranh của thửa đất, giờ lại thêm hai cái ngoe nữa và thêm mấy cái text bên trong
Cái Họa đồ vị trí lúc trước thì là cái khung vùng trích với tất cả các đường bao và mọi thứ linh tinh nằm trong khung, bây giờ thì lại cắt bỏ vô khối các đường bao và mấy thứ linh tinh đó mà bác không khoái nữa.
Thú thật mình không thể hiểu nổi cái lý do mà bác ghét bỏ mấy thằng đó, phải chăng nó là con hoang hở bác. ??? Ghét nó cũng phải có cái lý gì đó thì thằng lisp nó mới chịu nghe chớ bác. Cái thằng lisp này nó có tình thương bao la lắm, con nuôi con đẻ con hoang nó đều thương hết bác ạ.
Lại nữa hai cái khung của Sơ đồ trích thửa và Họa đồ vì trí của bác là bác lấy như thế nào ạ, tùy cái sướng của bác hay phải có phép tắc đường hoàng ạ???

Tóm nó lại thì mong bác cố gắng suy nghĩ thật kỹ lưỡng và trình bày thật rõ cái thâm ý của bác, bác muốn hành cái thằng lisp này ra sao thì mọi người mới có cơ hội học tập bác bác ạ. Bằng không đẻ nó ra nó lại chả vừa ý bác, bác chả thèm thương quẳng nó vào sọt rác thì tội nghiệp nó lắm lắm.

Rất mong bác bình tâm xem xét lại bác nhé.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#38 khaosat2009

khaosat2009

    biết lệnh offset

  • Members
  • PipPipPip
  • 171 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 30 September 2009 - 12:20 PM

khaosat2009 sử dụng lisp của bác phamthanhbinh để trích thửa đất và tạo bảng tọa độ. Sau đó dùng lisp của thiep để trích bản đồ ra cũng được mà.
Theo mình nghĩ, lisp của Thiep cũng có có ích giúp cho các bạn cơ khí dùng để trích 1 phần chi tiết máy, giúp cho các bạn xây dựng trích các chi tiết kết cấu phức tạp để vẽ rõ thêm ... vì vậy không nên nhập 2 cái lisp này lại thành 1.

Không biết mình xem lisp có đụng gì nó không mà lúc đó chạy lại không đúng, tưởng cad lỗi cài lại nửa đó.
Lisp của anh Bình trích thửa ra và nhớ tọa độ rất hay, nhưng mình lại thường bị lỗi về đánh số thứ tự điểm và kẻ khung,
Phải anh phanthanhbinh kết họp của lisp trích của ảnh trích ra thủa và dùng lisp tạo hồ sơ kỹ thuật TĐất để ghi kích thuớc , điểm và Block bảng tọa độ là rất tuyệt.
Mình từng bước thực hiện được : trích Họa đồ vị trí, trích thửa thì đang bị lổi.
Mong được các anh giúp cho hoàn thiện.
Cám ơn
  • 0

#39 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 30 September 2009 - 12:36 PM

xin chào tất cả các thành viên của cadviet!
mình thấy các bạn viết lisp rất hay, mình mới tập tành thôi mong các bạn dúp đỡ.
mình nhờ các thành viên giúp mình đọan lisp chèn khung tên tạo sẵn theo điểm pick vào bản vẽ hiện hành nhé.
thank!

Chào bạn Trang 7889,
Lisp vẽ khung tên nếu mình không nhầm thì trên diễn đàn này đã có rồi bạn ạ. Bản thân mình cũng ti toe có tí. Tuy nhiên nó có thất sự đúng với ý bạn hay không thì mình chả biết được mà chỉ có bạn mới quyết định được điều đó.
Như bạn đã nói, bạn đang tập tành viết lisp, như vậy mình khuyên bạn nên lấy một lisp vẽ khung tên có sẵn, chạy thử và phát hiện những điều chưa hợp với ý bạn, sau đó nếu bạn có thể tự chỉnh sửa những chỗ chưa hợp ý thành hợp ý bạn thì thật là tuyệt diệu. Còn nếu như chưa hẳn đã được như vậy thì bạn hãy post cái chưa vừa ý đó lên và nói chính xác cái ý bạn muốn, mình tin là mọi người sẽ giúp bạn để hoàn thành cái lisp đó mỹ mãn theo ý bạn.
Bằng cách như vậy bạn vừa có lisp để xài theocái khẩu vị của bạn, lại vừa tập tành được khối thứ trong quá trình hoàn thiện cái lisp đó bạn ạ. Bạn thử chịu khó kiếm tìm tí ti trên diễn đàn này là có lisp vẽ khung tên ngay ý mà.
Chúc bạn thành công.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#40 khaosat2009

khaosat2009

    biết lệnh offset

  • Members
  • PipPipPip
  • 171 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 30 September 2009 - 12:49 PM

Chào bạn khaosat 2009,
Mình đã sửa lại cái lisp để trích thửa theo đúng cái mẫu bạn gửi. Bạn có thể so sánh cái lisp này với cái lisp trước để thấy phần mình bổ sung vào và rút ra kinh nghiệm để chỉnh sửa lisp sau này.
10/- Bạn nhập chiều cao của một dòng trong bảng. Ở đây bạn nên nhập là 5 do mình đã fix chiều cao text trong bảng, Còn chiều rộng các cột mình đã mặc định cho nó rồi theo kích thước chiều cao chữ.
11/- Lisp sẽ tự động tạo bảng, điền các tên cột và tên bảng, điền các tọa độ góc ranh và độ dài các cạnh cho bạn ở trong khung cũng như trên bản đồ trích thửa với các màu mà bạn đã cho mẫu.

Mình chạy lisp của Anh phamthanhbinh, thường bị lỗi về bảng và ghi tên điểm, cạnh như file gởi kèm.
Mong được anh giúp
  • 0