Viết Lisp theo yêu cầu

[xuandao0708 9]

Hix, quên nữa Bác q228 ơi, còn cái vụ cho save lại bảng TĐGR bằng file text.txt ngay tại thư mục mở bản vẽ nữa. Thank Bác nhiều.

[nguyenkhoadung98 2]

chào các bạn, lại lên đây nhờ vả các bạn. xin nhờ các bạn cho mình cái lisp hăọc cách nào đó để đổi chiều của đường line,Pline, spline để cái chữ mình tạo trên đó nó kô bị ngược. mình gửi kèm bản vẽ, cảm ơn các bạn nhiều :s_big:

 

 

http://www.mediafire.com/?zkndmzdgu2m

[vnp84055 0]

Mình đang dùng các lisp như: tổng chiều dài đt line, pline; đo chiều dài đối tượng line, pline rùi ghi thành test + điểm chèn.

Vì để làm như mình muốn thì hơi lâu, phải vẽ pline trước, chọn, xong rùi mới gõ lệnh đo + ghi text.

 

Mình muốn nhờ các bạn giúp mình viết lại lisp có thể gộp các việc đó thành 1 lần:

- đánh lệnh của lisp (vd: pld),

- Nó sẽ cho phép mình vẽ pline theo ý muốn, >> Enter

- Nhập chiều cao của text + chọn điểm chèn text.

- Nó sẽ ghi chiều dài đoạn pline mà mình vẽ theo đúng chiều cao và điểm chèn text đã chọn.

Các thuộc tính: layer, color, style text theo hiện hành đã chọn trước.

 

Và một lisp thứ hai là mình muốn mở rộng lệnh giống như lệnh DIST (distance), thay vì chỉ đo bằng 2 điểm (điểm đầu và cuối), mình muốn khi gõ lệnh của lisp giống như vậy thì cho phép mình chọn nhiều điểm liên tục, sau khi enter thì nó sẽ hiện khoảng cách tổng chiều dài các điểm đó (từ điểm 1 sang 2, 2 sang 3,... giống như là pline)

 

Thanks.

[thiep 365]

chào các bạn, lại lên đây nhờ vả các bạn. xin nhờ các bạn cho mình cái lisp hăọc cách nào đó để đổi chiều của đường line,Pline, spline để cái chữ mình tạo trên đó nó kô bị ngược. mình gửi kèm bản vẽ, cảm ơn các bạn nhiều :s_big:

http://www.mediafire.com/?zkndmzdgu2m

Bạn tham khảo lisp PLREV.LSP, lisp này chỉ đổi chiều các LINE, POLYLINE, ARC, CIRCLE, nhưng chưa đổi chiều được SPLINE. Tải file ở đây:

http://www.cadviet.com/upfiles/Lisp_bo_sung_1.zỉp

Chắc bạn đang tạo một Lisp mà bị chướng ngại vật không đổi chiều Text được phải không?

[nguyenkhoadung98 2]

Bạn tham khảo lisp PLREV.LSP, lisp này chỉ đổi chiều các LINE, POLYLINE, ARC, CIRCLE, nhưng chưa đổi chiều được SPLINE. Tải file ở đây:

http://www.cadviet.com/upfiles/Lisp_bo_sung_1.zỉp

Chắc bạn đang tạo một Lisp mà bị chướng ngại vật không đổi chiều Text được phải không?

 

cảm ơn thiep, mình đang tạo 1 đuờng linetype theo ý mình thôi ( lenh mkltype), nhưng mà vẽ nguợc lại thì chữ nó cũng nguợc thành ra đành nhờ các bạn :blink:

link kia die rồi bạn ah :s_big: bạn cho mình link khác nhé, thanks

[Tue_NV 3912]

Mình đang dùng các lisp như: tổng chiều dài đt line, pline; đo chiều dài đối tượng line, pline rùi ghi thành test + điểm chèn.

Vì để làm như mình muốn thì hơi lâu, phải vẽ pline trước, chọn, xong rùi mới gõ lệnh đo + ghi text.

 

Mình muốn nhờ các bạn giúp mình viết lại lisp có thể gộp các việc đó thành 1 lần:

- đánh lệnh của lisp (vd: pld),

- Nó sẽ cho phép mình vẽ pline theo ý muốn, >> Enter

- Nhập chiều cao của text + chọn điểm chèn text.

- Nó sẽ ghi chiều dài đoạn pline mà mình vẽ theo đúng chiều cao và điểm chèn text đã chọn.

Các thuộc tính: layer, color, style text theo hiện hành đã chọn trước.

 

Và một lisp thứ hai là mình muốn mở rộng lệnh giống như lệnh DIST (distance), thay vì chỉ đo bằng 2 điểm (điểm đầu và cuối), mình muốn khi gõ lệnh của lisp giống như vậy thì cho phép mình chọn nhiều điểm liên tục, sau khi enter thì nó sẽ hiện khoảng cách tổng chiều dài các điểm đó (từ điểm 1 sang 2, 2 sang 3,... giống như là pline)

 

Thanks.

Đây bạn :

Lệnh dipl Thực hiện bài toán thứ nhất của bạn

Lệnh mudi thực hiện bài toán thứ hai của bạn

 

(defun c:mudi(/ p1 p2 di L po)
(setq p1 (getpoint "\n Chon diem thu nhat can do :") L 0)

(while (setq p2 (getpoint p1"\n Chon diem tiep theo can do :"))
(if p2
(progn
(setq di (distance p1 p2))
(setq L (+ L di))
(setq p1 p2)
)
)
)
(setq po (getpoint "\n Chon diem chen Text :"))
(wtxt (strcat "Tong chieu dai khoang cach giua cac diem can do : " (rtos L 2 2)) po)

(princ)
)
;

(defun c:dipl(/ p1 p2 LA p3 L po)
(setq p1 (getpoint "\n First point:"))
(setq p2 (getpoint p1"\n Second point:"))
(command "pline" p1 p2 "")
(setq LA (entlast))

(while (setq p3 (getpoint p2"\n Second point:"))
(if p3
(progn
(command "pline" p2 p3 "")
(command "pedit" "m" LA "L" "" "j" "0" "")
(setq LA (entlast))
(setq p2 p3)
)
)
)
(setq L (vlax-curve-getDistAtPoint LA p2))
(setq po (getpoint "\n Chon diem chen Text :"))
(wtxt (strcat "Tong chieu dai Polyline vua ve : " (rtos L 2 2)) po)

(princ)
)
;
(defun wtxt (txt p / sty d h)
(setq
    sty (getvar "textstyle")
    d (tblsearch "style" sty)
    h (cdr (assoc 40 d))
)
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 11 p) (cons 72 1) (cons 73 2)
          (if (> h 0) (cons 40 h) (assoc 40 d)) (assoc 41 d))
)
)

 

@ NguyenKhoaDung : Lisp Này bác Hoành đã có viết rồi, bạn thử tìm kiếm xem

[vnp84055 0]

@Tue_NV: thanks.

Tại nhiều trang quá, mình tìm cả buổi mà không thấy đâu hết, nên mới nhờ. Nói chung lisp này ok, mình dùng nó để sửa lại cho đúng ý của mình.

Good luck for u.

[thiep 365]

cảm ơn thiep, mình đang tạo 1 đuờng linetype theo ý mình thôi ( lenh mkltype), nhưng mà vẽ nguợc lại thì chữ nó cũng nguợc thành ra đành nhờ các bạn :blink:

link kia die rồi bạn ah :s_big: bạn cho mình link khác nhé, thanks

Đây là lisp PLREV.LSP:

|

PLREV.LSP © 1999-2004 Tee Square Graphics

Version 2.03a - 11/15/2004

Used to reverse the direction in which Lines, Polylines, LWPolylines
 and other objects are drawn. Useful for correcting the "direction"
 of specialized complex linetypes.
____

Revision History:

Version 2.03a: problem with non-American English installations fixed
 (with thanks to Jürgen Palme); name changed from REV to PLREV to
 resolve conflict with shortcut for REVolve command. 11/15/2004

Version 2.03: problem with ByLayer linetype fixed. 9/18/2001

Version 2.02: revised to preserve layer property of selected object.
 8/17/2001

Version 2.01: error checking added; bug related to PLINEGEN system
 variable fixed. 3/27/2001

Version 2.0 updated to include Arcs and Circles. These will be
 converted to either Polylines or LWPolylines, depending on the
 current setting of the PLINETYPE variable. Circles and Arcs over
 180 may sometimes behave oddly; for best results, select these
 items by clicking on a point near the "quad" points, at 0, 90,
 180 or 270 degrees. If an Arc or Circle disappears during a REV
 operation, just enter a U (undo) command to bring back the object
 and try again by picking a different point on the object. 3/24/2001

Please report bugs and other difficulties, along with a detailed
 description of the steps leading up to the problem, via email to
 cadman@turvill.com.

|;

(defun C:PLREV (/ olderr cmde blip ltsc cclr snap pwid pgenen1 nam ent p obj ltp
               clr lts wid flgs first final next spl cur vert a clos zoomit clyr lyr)
 (setq olderr *error*)
 (defun *error* (x)
   (setvar "cmdecho" cmde)
   (setvar "blipmode" blip)
   (setvar "osmode" snap)
   (setvar "celtscale" ltsc)
   (setvar "cecolor" cclr)
   (setvar "plinewid" pwid)
   (setvar "plinegen" pgen)
   (setq *error* olderr)
   (princ)
 ) ;; end of *error* function
 (setq cmde (getvar "cmdecho")
       blip (getvar "blipmode")
       ltsc (getvar "celtscale")
       cclr (getvar "cecolor")
       snap (getvar "osmode")
       pwid (getvar "plinewid")
       clyr (getvar "clayer")
       pgen (getvar "plinegen"))
 (setvar "cmdecho" 0)
 (setvar "blipmode" 0)
 (setvar "osmode" 0)
 (setvar "plinewid" 0)
 (setvar "plinegen" 1)
 (command "_.undo" "_be")
 (while (null (setq en1 (entsel "\nPick an object to reverse: "))))
 (setq nam (car en1)
       ent (entget nam)
       p (cadr en1)
       obj (cdr (assoc 0 ent)))
 (cond
   ((= obj "CIRCLE")
     (setq ctr (cdr (assoc 10 ent))
           dia (* 2.0 (cdr (assoc 40 ent)))
           a (angle p ctr))
     (command "_.break" p (polar p (/ pi 4) 0.001)
              "_.pedit" p "_y" "_c" "_x")
     (carc))
   ((= obj "ARC")
     (command "_.break" p "@"
              "_.pedit" p "_y" "_j" nam (entlast) "" "_x")
     (carc))
   (T nil))
 (setq ltp (cdr (assoc 6 ent))
       lyr (cdr (assoc 8 ent))
       clr (cdr (assoc 62 ent))
       lts (cdr (assoc 48 ent))
       wid (cdr (assoc 40 ent))
       flgs (cdr (assoc 70 ent)))
 (if (not ltp)(setq ltp "bylayer"))
 (cond
   ((= obj "LINE")
     (setq first (assoc 10 ent)
           final (assoc 11 ent)
           ent (subst (cons 10 (cdr final)) first ent)
           ent (subst (cons 11 (cdr first)) final ent))
     (entmod ent))
   ((= obj "LWPOLYLINE")
     (setq final (cdr (assoc 10 (setq ent (reverse ent))))
           next (cdr (assoc 10 (cdr (member (assoc 10 ent) ent)))))
     (prev))
   ((= obj "POLYLINE")
     (setq spl (= (logand flgs 4) 4)
           cur (= (logand flgs 2) 2)
           vert (entnext nam))
     (if cur
       (command "_.pedit" p "_s" ""))
     (while (= (cdr (assoc 0 (entget (setq vert (entnext vert))))) "VERTEX")
       (setq next final
             final (cdr (assoc 10 (entget vert)))))
     (prev))
   (T (alert "Not a REVersible object.")))
 (command "_.undo" "_e")
 (setvar "cmdecho" cmde)
 (setvar "blipmode" blip)
 (setvar "osmode" snap)
 (setvar "celtscale" ltsc)
 (setvar "cecolor" cclr)
 (setvar "plinewid" pwid)
 (setvar "plinegen" pgen)
 (setvar "clayer" clyr)
 (setq *error* olderr)
 (princ)
)
(defun carc ()
 (setq ent (entget (entlast))
       nam (cdr (assoc -1 ent))
       obj (cdr (assoc 0 ent)))
)
(defun prev ()
 (setq a (angle next final)
       clos (= (logand flgs 1) 1))
 (if clos (command "_.pedit" nam "_o" ""))
 (setq zoomit (null (ssget "_c" final final)))
 (if zoomit (command "_.zoom" "_c" final ""))
 (if clr (command "_.color" clr))
 (if lts (setvar "celtscale" lts))
 (setvar "clayer" lyr)
 (command "_.pline" (polar final a 0.0001) final ""
          "_.chprop" (entlast) "" "_lt" ltp ""
          "_.pedit" (entlast) "_j" nam "" ""
          "_.break" final (polar final a 0.001))
 (if cur (command "_.pedit" (entlast) "_f" ""))
 (if spl (command "_.pedit" (entlast) "_s" ""))
 (if clos (command "_.pedit" (entlast) "_c" ""))
 (if wid (command "_.pedit" (entlast) "_w" wid ""))
 (if zoomit (command "_.zoom" "_p"))
)

(princ)

Khoadung tạo Linetype, Thiep gợi ý: nên nghiên cứu tạo 2 kiểu đường: + và -. Có nghĩa là kiểu CHIEUSANG+ và CHIEUSANG-. Khi đó: nếu vẽ đường từ phải sang trái thì dùng kiểu CHIEUSANG+, nếu vẽ đường từ trái sang phải thì dùng kiểu CHIEUSANG-

[Tue_NV 3912]

cảm ơn thiep, mình đang tạo 1 đuờng linetype theo ý mình thôi ( lenh mkltype), nhưng mà vẽ nguợc lại thì chữ nó cũng nguợc thành ra đành nhờ các bạn :blink:

link kia die rồi bạn ah :s_big: bạn cho mình link khác nhé, thanks

Chào KhoaDung.

Bạn hãy upload file .lin mà bạn tạo kiểu đường nét lên đây nhé. Để Tue_NV xem thử cấu trúc của nó.

[HoangSon614 66]

Chào bạn Tue_NV!

Mình muốn bạn viết dùm mình 1lisp như sau:

Khi chọn đối tượng thì lisp hỏi: bạn muốn bỏ dấu hay thêm dấu (chọn nhiều đối tượng cùng lúc) >> Enter thì dấu phía trước mất đi (VD: -0.123 -> 0.123)

(cái này mình sử dụng trong vẽ trắc dọc, khi chương trình chạy độ dốc âm nên phải đánh dấu trừ, xong xuôi ra ngoài mình làm thủ công chọn các giá trị âm muốn bỏ dấu là ok). Cố gắng giúp mình nha, mình đang rất cần. Cảm ơn bạn

[duy782006 1559]

Chào KhoaDung.

Bạn hãy upload file .lin mà bạn tạo kiểu đường nét lên đây nhé. Để Tue_NV xem thử cấu trúc của nó.

Không cần xem file đâu tue à vì 1 dạng đường không mang tính đối xứng thì nếu vẽ từ trái qua phải cái text nằm đúng chiều thì vẽ từ phải qua trái cái text sẽ lôn ngược đó là hiển nhiên. Nên việc tạo ra kiểu đường thuận và nghịch là phù hợp nhất.

[phamthanhhungks 19]

Lâu lắm không gặp lại mấy vấn đề về CAD. Hum nay lại gặp bùn ghê.

Hum nay bên em đang đưa phương án cho 1 công trình chung cư ở Vũng Tàu. Nhưng hiện tại bên A chỉ giao cho bên em 1 bản vẽ tổng thể bằng A3, trong đó có hình tổng mặt bằng và diện tích khu đất. Em đã Scan bản vẽ và chuyển nó sang file dxf để có 1 bản vẽ CAD hiện trạng khu đất 1 cách tương đối nhất. Nhưng khi scale lại khu đất cho đúng diện tích với điện tích thực của khu đất thì không cách nào làm được (mệt mỏi ghê, thử mọi cách nhưng vẫn bó tay) Aem nào có cách nào scale 1 hình theo tỉ lệ diện tích không (Lưu ý: Diện tích chứ không phải theo 1 trục, hay tim) nếu có thì share em với. Còn nếu không ai có liệu bác Tue, hay bác Hoành có thể giúp em với được không? không biết vấn đề này Autolisp có thể giải quyết được ko đây? Nếu được thì cho em 1 cái Lisp scale bản vẽ theo diện tích dùm em với.

Em có Úp khu đất đính kèm vào có gì nhờ anh em tham khảo và góp ý tìm cách giải quyết giúp mình với nhé (mình đang cần khu đất này gấp)

Diện tích khu đất mà em cần là 12.934m2

Chân thành cảm ơn các aem đã đọc qua Reply này của mình và góp ý giúp đỡ mình. Thank

http://www.cadviet.com/upfiles/khu_dat_can...en_S12934m2.dwg

[Tue_NV 3912]

Chào bạn Tue_NV!

Mình muốn bạn viết dùm mình 1lisp như sau:

Khi chọn đối tượng thì lisp hỏi: bạn muốn bỏ dấu hay thêm dấu (chọn nhiều đối tượng cùng lúc) >> Enter thì dấu phía trước mất đi (VD: -0.123 -> 0.123)

(cái này mình sử dụng trong vẽ trắc dọc, khi chương trình chạy độ dốc âm nên phải đánh dấu trừ, xong xuôi ra ngoài mình làm thủ công chọn các giá trị âm muốn bỏ dấu là ok). Cố gắng giúp mình nha, mình đang rất cần. Cảm ơn bạn

Cái này anh Duy đã viết rồi bạn.

Lisp thêm text và bớt text đó

Đây :

http://www.cadviet.com/forum/index.php?showtopic=6991

 

Còn đây là Lisp themdau và botdau, Tue_NV viết theo ý của bạn :

Chú ý : Nếu Text đã có dấu trừ đằng trước thì chạy Lisp Themdau sẽ không có tác dụng vì đã có dấu trừ đằng trước

Nếu Text không có dấu trừ đằng trước thì chạy Lisp botdau sẽ không có tác dụng vì Text đã là số dương (không thể bớt số)

 

(defun c:themdau()
(setq ss (ssget '((0 . "TEXT,MTEXT")))
n (sslength ss) i 0)

(while ((setq ent (entget(ssname ss i)))
(setq chuoi (cdr(assoc 1 ent)))

(if (/= (substr chuoi 1 1) "-")
(progn
(setq chuoitach (strcat "-" (cdr(assoc 1 ent))))
(setq ent (subst (cons 1 chuoitach) (assoc 1 ent) ent))
(entmod ent)
)
)
(setq i (1+ i))
)
(princ)
)
;
(defun c:botdau()
(setq ss (ssget '((0 . "TEXT,MTEXT")))
n (sslength ss) i 0)

(while ((setq ent (entget(ssname ss i)))

(setq chuoi (cdr(assoc 1 ent)))

(if (= (substr chuoi 1 1) "-")
(progn
(setq chuoitach (substr chuoi 2 (strlen chuoi)))
(setq ent (subst (cons 1 chuoitach) (assoc 1 ent) ent))
(entmod ent)
)
)
(setq i (1+ i))
)
(princ)
)

Chỉnh sửa Tháng 6 24, 2009 theo Tue_NV

[HoangSon614 66]

Cái này anh Duy đã viết rồi bạn.

Lisp thêm text và bớt text đó

Đây :

http://www.cadviet.com/forum/index.php?showtopic=6991

 

Còn đây là Lisp themdau và botdau, Tue_NV viết theo ý của bạn :

Chú ý : Nếu Text đã có dấu trừ đằng trước thì chạy Lisp Themdau sẽ không có tác dụng vì đã có dấu trừ đằng trước

Nếu Text không có dấu trừ đằng trước thì chạy Lisp botdau sẽ không có tác dụng vì Text đã là số dương (không thể bớt số)

 

(defun c:themdau()
(setq ss (ssget '((0 . "TEXT,MTEXT")))
n (sslength ss) i 0)

(while (< i n)
(setq ent (entget(ssname ss i)))
(setq chuoi (cdr(assoc 1 ent)))

(if (/= (substr chuoi 1 1) "-")
(progn
(setq chuoitach (strcat "-" (cdr(assoc 1 ent))))
(setq ent (subst (cons 1 chuoitach) (assoc 1 ent) ent))
(entmod ent)
)
)
(setq i (1+ i))
)
(princ)
)
;
(defun c:botdau()
(setq ss (ssget '((0 . "TEXT,MTEXT")))
n (sslength ss) i 0)

(while (< i n)
(setq ent (entget(ssname ss i)))

(setq chuoi (cdr(assoc 1 ent)))

(if (= (substr chuoi 1 1) "-")
(progn
(setq chuoitach (substr chuoi 2 (strlen chuoi)))
(setq ent (subst (cons 1 chuoitach) (assoc 1 ent) ent))
(entmod ent)
)
)
(setq i (1+ i))
)
(princ)
)

Xin lỗi bạn Tue_NV, mong bạn thông cảm, mình quên một chi tiết, trước dấu âm là 1 text nên lisp không thực hiện được (VD: i=-0.123)

Bạn sửa lại giúp mình. Cảm ơn bạn

[duy782006 1559]

Xin lỗi bạn Tue_NV, mong bạn thông cảm, mình quên một chi tiết, trước dấu âm là 1 text nên lisp không thực hiện được (VD: i=-0.123)

Bạn sửa lại giúp mình. Cảm ơn bạn

Khi yêu cầu viết lisp thì cần cụ thể chứ không ví dụ. Về nhu cầu của bạn thì theo mình nghỉ dùng 2 cái lisp của mình mà bạn tue đã chỉ để thực hiện là được: cách làm:

Ví dụ bạn có i=-123456 thì :

-Dùng lisp bớt text bỏ đi 3 ký tự phía trước.

-Dùng lisi thêm text thêm i= vào là được.

Nó tổng quát được cho nhiều trường hợp.

Yêu cầu cảu bạn sẽ đặt ra cho người viết lisp câu hỏi:

-Phía trước dấu trừ cố định là nội dung i= hay thay đổi theo thời gian và tình cảm của bạn.

-Cứ sau dấy = thì bỏ dấu trừ đi.

-Cứ gặp dấu trừ là bỏ đi.

Đấy ít nhứt là có 3 thắc mắc vậy lại phải hỏi lại bạn nửa mệt. <_<

[HoangSon614 66]

Khi yêu cầu viết lisp thì cần cụ thể chứ không ví dụ. Về nhu cầu của bạn thì theo mình nghỉ dùng 2 cái lisp của mình mà bạn tue đã chỉ để thực hiện là được: cách làm:

Ví dụ bạn có i=-123456 thì :

-Dùng lisp bớt text bỏ đi 3 ký tự phía trước.

-Dùng lisi thêm text thêm i= vào là được.

Nó tổng quát được cho nhiều trường hợp.

Yêu cầu cảu bạn sẽ đặt ra cho người viết lisp câu hỏi:

-Phía trước dấu trừ cố định là nội dung i= hay thay đổi theo thời gian và tình cảm của bạn.

-Cứ sau dấy = thì bỏ dấu trừ đi.

-Cứ gặp dấu trừ là bỏ đi.

Đấy ít nhứt là có 3 thắc mắc vậy lại phải hỏi lại bạn nửa mệt. <_<

Xin lỗi bạn, mình sẽ rút kinh nghiệm cho lần sau. Mình muốn cố định cụm i=, bỏ dấu trừ đi

[q288 166]

Lâu lắm không gặp lại mấy vấn đề về CAD. Hum nay lại gặp bùn ghê.

Hum nay bên em đang đưa phương án cho 1 công trình chung cư ở Vũng Tàu. Nhưng hiện tại bên A chỉ giao cho bên em 1 bản vẽ tổng thể bằng A3, trong đó có hình tổng mặt bằng và diện tích khu đất. Em đã Scan bản vẽ và chuyển nó sang file dxf để có 1 bản vẽ CAD hiện trạng khu đất 1 cách tương đối nhất. Nhưng khi scale lại khu đất cho đúng diện tích với điện tích thực của khu đất thì không cách nào làm được (mệt mỏi ghê, thử mọi cách nhưng vẫn bó tay) Aem nào có cách nào scale 1 hình theo tỉ lệ diện tích không (Lưu ý: Diện tích chứ không phải theo 1 trục, hay tim) nếu có thì share em với. Còn nếu không ai có liệu bác Tue, hay bác Hoành có thể giúp em với được không? không biết vấn đề này Autolisp có thể giải quyết được ko đây? Nếu được thì cho em 1 cái Lisp scale bản vẽ theo diện tích dùm em với.

Em có Úp khu đất đính kèm vào có gì nhờ anh em tham khảo và góp ý tìm cách giải quyết giúp mình với nhé (mình đang cần khu đất này gấp)

Diện tích khu đất mà em cần là 12.934m2

Chân thành cảm ơn các aem đã đọc qua Reply này của mình và góp ý giúp đỡ mình. Thank

http://www.cadviet.com/upfiles/khu_dat_can...en_S12934m2.dwg

 

Chắc bạn bức xúc lắm hay sao mà xài chữ vừa to vừa đỏ thế.

Bạn thử cái này xem sao. Mình chưa nghĩ ra cái gì hay nên xài tạm cái này nhé.

(defun c:sca()
 (setvar "cmdecho" 0)  
 (setq dt1 (entsel "Chon doi tuong scale :")
dt (car dt1)
vt (cadr dt1)
dtt (getreal "\nDien tich muon sau khi scale(m2) :"))

 (command "undo" "begin")
 (command "area" "o" dt)
 (setq av (* 0.000001 (getvar "area")))

 (while (not (equal dtt av 0.1))
   (setq sc (/ (sqrt dtt ) (sqrt av)))
   (command "scale" dt "" vt sc)
   (command "area" "o" dt)
   (setq av (* 0.000001 (getvar "area")))          
 )
 (command "undo" "end")
 (setvar "cmdecho" 1)
 (princ)
)

[Tue_NV 3912]

Xin lỗi bạn Tue_NV, mong bạn thông cảm, mình quên một chi tiết, trước dấu âm là 1 text nên lisp không thực hiện được (VD: i=-0.123)

Bạn sửa lại giúp mình. Cảm ơn bạn

Tue_NV viết trong trường hợp tổng quát :

Khi chạy Lisp hỏi :

Ban muon bot chuoi cach vi tri dau bao nhieu ki tu : (1)

So ki tu can bo bot : (2)

 

trong trường hợp của HoangSon thì :

Ban muon bot chuoi cach vi tri dau bao nhieu ki tu : 3

So ki tu can bo bot : 1

(defun c:bgtext()
(setq vitri (getint "\n Ban muon bot chuoi cach vi tri dau bao nhieu ki tu :"))
(setq skt (getint "\n So ki tu can bo bot :"))
(prompt "\nChon chu muon chinh.")
(setq ss (ssget '((0 . "TEXT,MTEXT"))) n (sslength ss) i 0)

(while ((setq e (entget(ssname ss i)))
(setq chuoicu (cdr(assoc 1 e)))

(setq tachdau (substr chuoicu 1 (- vitri 1)))
(setq tachcuoi (substr chuoicu (+ vitri skt) (+ (- (strlen chuoicu) vitri skt) 1)))
(setq chunoi (strcat tachdau tachcuoi))
(setq e (subst (cons 1 chunoi) (assoc 1 e) e))
(entmod e)
(setq i (1+ i))
)
(princ)
)

[gia_bach 1553]

Chắc bạn bức xúc lắm hay sao mà xài chữ vừa to vừa đỏ thế.

Bạn thử cái này xem sao. Mình chưa nghĩ ra cái gì hay nên xài tạm cái này nhé.

................

Sorry q288

Xin giới thiệu cách tiếp cận khác, LISP gán (thay đổi) diện tích cho các đối tuợng có diện tích : CIRCLE, ELLIPSE, PLINE, HATCH, ...

(defun c:GDT (/ ent e newVal)
 (vl-load-com)
 (command "UNDO" "begin")
 (or *dt* (setq *dt* 12934e6))
 (while
   (and
     (setq ent (entsel "\nChon doi tuong can thay doi Dien tich :") )
     (setq e (vlax-Ename->Vla-Object (car ent)) )
     )
   (if (vlax-property-available-p e 'Area)
     (progn
(setq newVal (getreal (strcat "\nNhap dien tich mong muon <" (rtos *dt*) "> :")) )
(if newVal (setq *dt* newVal) (setq newVal *dt*))
(vlax-invoke e 'ScaleEntity (vlax-curve-getStartPoint e) (sqrt(/ newVal (vla-get-Area e ))))
)
     (princ "\n Doi tuong vua chon khong co dien tich. Chon lai ....")
     )
   )
 (command "UNDO" "end")   
)

[toai 1]

Bạn có thể post yêu cầu về autolisp ở topic này.

\

Chào bác Hoành. Tôi có một ý định là sau khi ghi kích thước cho bản vẽ rồi thì sẽ điều chỉnh toàn bộ khoảng cách từ đường ghi KT tới đối tượng cần ghi KT trong BV về một giá trị chung (như ví dụ tôi gửi kèm). Tôi đã tìm trong diiễn đàn nhưng chưa có chủ đề nào đúng ý định của tôi cả. Bác xem xét và giúp đỡ nhé. Thank!

http://www.cadviet.com/upfiles/VD_1.dwg

[q288 166]

Sorry q288

Xin giới thiệu cách tiếp cận khác, LISP gán (thay đổi) diện tích cho các đối tuợng có diện tích : CIRCLE, ELLIPSE, PLINE, HATCH, ...

(defun c:GDT (/ ent e newVal)
 (vl-load-com)
 (command "UNDO" "begin")
 (or *dt* (setq *dt* 12934e6))
 (while
   (and
     (setq ent (entsel "\nChon doi tuong can thay doi Dien tich :") )
     (setq e (vlax-Ename->Vla-Object (car ent)) )
     )
   (if (vlax-property-available-p e 'Area)
     (progn
(setq newVal (getreal (strcat "\nNhap dien tich mong muon <" (rtos *dt*) "> :")) )
(if newVal (setq *dt* newVal) (setq newVal *dt*))
(vlax-invoke e 'ScaleEntity (vlax-curve-getStartPoint e) (sqrt(/ newVal (vla-get-Area e ))))
)
     (princ "\n Doi tuong vua chon khong co dien tich. Chon lai ....")
     )
   )
 (command "UNDO" "end")   
)

 

Thật ra scale theo diện tích ko cần viết lisp cũng có thể làm đc, chỉ cần tính ra tỷ lệ scale là có thể scale thủ công là xong.

Vấn đề là tìm công thức tính tỷ lệ.

Thuật toán của mình là qui đổi diện tích hình bất kỳ thành diện tích tương ứng của 1 hình vuông -> cạnh (lấy căn bậc 2)

tỷ lệ diện tích khi đó là tỷ lệ 2 cạnh của 2 hình vuông.

[q288 166]

Trước tiên xin cá mon Bác q228 đã chỉnh sữa đoạn lisp vc dùm em, sau khi chạy thử thì em thấy chạy rất tốt, như bên cạnh đó còn một số thắc mắc sau nhờ Bác chỉnh thêm dùm em 1 chút.

- Những thửa nhỏ thì chạy rất tốt, còn thửa lớn như trong file mẫu thì chạy xong rồi mất ranh luôn Bác oi.

- Trước khi chạy thì nó kiểm tra xem có layer kichthuoc, stt, bangtd, nếu có rồi thì thôi, nếu chư có thì tạo. Kích thước thửa đất thì gán cho layer: kichthuoc, số TT và vòng tròn thì gán cho layer: stt và bảng TĐGR thì gán cho layer: bangtd

- Vị trí điểm thứ tự đầu tiên thì cho người sử dụng được chọn. ( do đôi lúc có những thửa đất nằm ngay mặt tiền đường thỉ phải chạy từ hướng mặt tiền rồi mới đến các vị trí khác trên thửa đất )

- Thêm chử : < BẢNG LIỆT KÊ TỌA ĐỘ GÓC RANH> phía trên bảng tọa độ

- Khung text STT thì để nguyên, khung tọa độ x-y thì cho khoảng cách 10, còn khung khoảng cách thì cho 8 ( để bảng TĐGr được đẹp hơn )

 

File dwg mẫu:

http://www.cadviet.com/upfiles/mau_2.dwg

 

Cái hình trong file mau_2.dwg là hình 3d và có elevation khác 0, hình đó khi lấy boundary sẽ báo lỗi nên ct chạy ko đc.

Còn hình trong file mẫu trước các đg ranh là line thì chạy ok.

Vậy trong thực tế thì bạn dùng line hay pline2d hay pline3d?

[HoangSon614 66]

Tue_NV viết trong trường hợp tổng quát :

Khi chạy Lisp hỏi :

Ban muon bot chuoi cach vi tri dau bao nhieu ki tu : (1)

So ki tu can bo bot : (2)

 

trong trường hợp của HoangSon thì :

Ban muon bot chuoi cach vi tri dau bao nhieu ki tu : 3

So ki tu can bo bot : 1

(defun c:bgtext()
(setq vitri (getint "\n Ban muon bot chuoi cach vi tri dau bao nhieu ki tu :"))
(setq skt (getint "\n So ki tu can bo bot :"))
(prompt "\nChon chu muon chinh.")
(setq ss (ssget '((0 . "TEXT,MTEXT"))) n (sslength ss) i 0)

(while (< i n)
(setq e (entget(ssname ss i)))
(setq chuoicu (cdr(assoc 1 e)))

(setq tachdau (substr chuoicu 1 (- vitri 1)))
(setq tachcuoi (substr chuoicu (+ vitri skt) (+ (- (strlen chuoicu) vitri skt) 1)))
(setq chunoi (strcat tachdau tachcuoi))
(setq e (subst (cons 1 chunoi) (assoc 1 e) e))
(entmod e)
(setq i (1+ i))
)
(princ)
)

Cảm ơn Tue_NV nhiều lắm, thật là tuyệt vời.

[shinnikel 1]

Tue_NV viết trong trường hợp tổng quát :

Khi chạy Lisp hỏi :

Ban muon bot chuoi cach vi tri dau bao nhieu ki tu : (1)

So ki tu can bo bot : (2)

 

trong trường hợp của HoangSon thì :

Ban muon bot chuoi cach vi tri dau bao nhieu ki tu : 3

So ki tu can bo bot : 1

 

 

Tue có thể bổ xung them tính năng thêm kí tự và thai đổi kí tự dưạ trên lisp bạn mới tạo không đôi lúc cũng rất cần thiết đó. :s_big:

[gia_bach 1553]

..........................

Mình đang cần lish

đưa các pline thẳng hàng nhau thành 1 pline

và lish Nhập tỷ lệ Standard Scale của khung viewport bên layout bằng bàn phím

...................

Chào ph168xd

Bạn có thể dùng lệnh Overkill của Express Tools để đưa các pline thẳng hàng nhau thành 1 pline .

Nhớ chọn Option : PLINEs, OVERLAP, END to END

 

đây là LISP Nhập tỷ lệ Standard Scale của khung viewport bên layout, do không có thời gian nhờ bạn chạy và kiểm tra dùm.

;SVP : Scale ViewPort
(defun c:svp(/ ent dz Viewport newVal)
 (if (/= (getvar "cvport") 1)
   (alert "\nChi co the chay tren khong gian giay (Layout).")
   (progn
     (while
(not (and
       (setq ent (car (entsel "\nChon Viewport : ")))
       (if ent (= (cdr (assoc 0 (entget ent))) "VIEWPORT") )
       )
     )
(princ "\nkhong phai Viewport. Chon lai : ")
)
     (setq dz (getvar "dimzin"))
     (setvar "dimzin" 8 )
     (setq Viewport (vlax-Ename->Vla-Object ent)
    newVal (GetScale (getstring(strcat "\nNhap Scale Standard (vd. 1/50, 1:50, 50 ) <" ( getvport_scale Viewport)"> :")) ))
     (if newVal (vla-put-CustomScale Viewport newVal))
     (setvar "dimzin" dz )
     )
   )
 (princ)
 )

(defun GetScale (Str  / Sc)
 (cond
   ((/= (type Str) 'STR) nil)
   ((or (setq Pos (vl-string-search ":" Str))(setq Pos (vl-string-search "/" Str)))
    (setq Sc (vl-catch-all-apply
	'(lambda () (/ (distof (substr Str 1 Pos)) (distof (substr Str (+ 2 Pos)))) ) ) ) )
   ((setq Sc (vl-catch-all-apply '(lambda () (/ 1 (distof Str))))))
   )
 (if (vl-catch-all-error-p Sc)
   (setq Sc nil)
   )
 Sc
 )

(defun getvport_scale (viewport / sc csc)
 (setq sc (vla-get-StandardScale viewport))
   (cond
     ((= sc acVpScaleToFit)
      (setq csc 1.0)
     )
     ((= sc acVpCustomScale)
      (setq csc (/ 1 (vla-get-CustomScale viewport)))
      (if (= csc 0.0) (setq csc 1.0))
     )
     ((= sc acVp1_128in_1ft) (setq csc 1536.0))
     ((= sc acVp1_64in_1ft) (setq csc 768.0))
     ((= sc acVp1_32in_1ft) (setq csc 384.0))
     ((= sc acVp1_16in_1ft) (setq csc 192.0))
     ((= sc acVp3_32in_1ft) (setq csc 128.0))
     ((= sc acVp1_8in_1ft) (setq csc 96.0))
     ((= sc acVp3_16in_1ft)(setq csc 64.0))
     ((= sc acVp1_4in_1ft) (setq csc 48.0))
     ((= sc acVp3_8in_1ft) (setq csc 32.0))
     ((= sc acVp1_2in_1ft) (setq csc 24.0))
     ((= sc acVp3_4in_1ft) (setq csc 16.0))
     ((= sc acVp1in_1ft) (setq csc 12.0))
     ((= sc acVp3in_1ft)(setq csc 4.0))
     ((= sc acVp6in_1ft)(setq csc 2.0))
     ((= sc acVp1ft_1ft)(setq csc 1.0))
     ((= sc acVp1_1) (setq csc 1.0))
     ((= sc acVp1_2) (setq csc 2.0))
     ((= sc acVp1_4) (setq csc 4.0))
     ((= sc acVp1_8) (setq csc 8.0))
     ((= sc acVp1_10) (setq csc 10.0))
     ((= sc acVp1_16) (setq csc 16.0))
     ((= sc acVp1_20) (setq csc 20.0))
     ((= sc acVp1_30) (setq csc 30.0))
     ((= sc acVp1_40) (setq csc 40.0))
     ((= sc acVp1_50) (setq csc 50.0))
     ((= sc acVp1_100)(setq csc 100.0))
     ((= sc acVp2_1) (setq csc 0.5))
     ((= sc acVp4_1) (setq csc 0.25))
     ((= sc acVp8_1) (setq csc 0.125))
     ((= sc acVp10_1) (setq csc 0.1))
     ((= sc acVp100_1) (setq csc 0.01))
   )
 (if (member (getvar "lunits") '(1 2 3 5))
    (strcat "1:" (rtos csc ))
    (strcat (rtos (/ 12 csc) 4 5) "=" (rtos 12 4))
   )
 )