Viết lisp theo yêu cầu [phần 2]

[kamezoko 3]

@kamezoko : Ở dòng Select object : Bạn nhấn P (Previous) thì Lisp sẽ chọn lại đối tượng trước đó

Select object : P

:cheers:

cám ơn anh TUE_NV nhiều lắm... :cheers:

[Tue_NV 3.912]

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

Chào Tuynh

Lisp này Tue_NV dựa trên nền mà Lisp bạn Thiep viết mà hoàn thành lại theo ý của bạn

Ban đầu Bạn dùng Lisp của Tue_NV để làm. Các cao độ 3dPLINE sẽ dàn trên các Vertex của 3dPline.

Sau này muốn hiệu chỉnh thì dùng Lisp này

Khi chạy Lisp hỏi :

Pick a point on Polyine: -> Bạn Pick vào điểm cần thay đổi độ cao

Pick chon chu thay doi do cao : -> Pick chọn chữ ngay tại điểm cần thay đổi độ cao

 

-> Lisp sẽ hiệu chỉnh độ cao theo ý của bạn . Chúc vui vẻ

 
;; free lisp from cadviet.com
;;; Lisp thay doi do cao cac node cua POLYLINE
;;; copyright by Thiep 7/2009
;;; yeu cau: cai dat day du Expresstools 
;;;--------------------------
(defun DXF (code en) (cdr (assoc code (entget en))))
;;;---------------------
(defun SAVE_MODE ()
(command "UCS" "W" "")
(setq OLD_OSMODE (getvar "OSMODE")
OLD_CECOLOR (getvar "CECOLOR")
OLD_AUTOSNAP (getvar "AUTOSNAP")
OLD_ORTHOMODE (getvar "ORTHOMODE")
)
(setvar "cmdecho" 0)
(setvar "plinegen" 1)

)
(defun RESTORE ()
(setvar "osmode" OLD_OSMODE)
(setvar "AUTOSNAP" OLD_AUTOSNAP)
(setvar "ORTHOMODE" OLD_ORTHOMODE)
(setvar "CECOLOR" OLD_CECOLOR)
(setvar "cmdecho" 1)
)
;;;--------------------------
;;;----------------------------------------
(defun 3DPoly (Lp *ModelSpace* / PntArr)
(setq PntArr (vlax-make-safearray
vlax-vbDouble
(cons 0 (1- (length Lp)))
)
)
(vlax-safearray-fill PntArr Lp)
(vla-Add3Dpoly *ModelSpace* PntArr)
)
;;;-----------------------------------
(vl-load-com)
(defun c:3dp (/ ActDoc *Model* wp lwp Obj n pn pcl Pe lstP Elev lt lstN te ptc ptm)
(SAVE_MODE)
(setvar "osmode" 1)
(setq ActDoc (vla-get-ActiveDocument (vlax-get-acad-object))
*Model* (vla-get-ModelSpace ActDoc)
)
(while (setq pn (getpoint "\nPick a point on Polyine: "))
(setq lwp (ssname (ssget pn) 0))
(redraw lwp 3)

(setq te (car(entsel "\n Pick chon chu thay doi do cao :")))

(command "ddedit" te "")
(setq ptc (cdr(assoc 10 (entget te)))) 

(setq heinode (atof(cdr(assoc 1 (entget te)))))
(setq ptm (list (car ptc) (cadr ptc) heinode))
(setvar "osmode" 0)
(command "move" te "" ptc ptm)
(setvar "osmode" 1)
;(setq heinode (getreal "\nEnter height of node: ")
(setq obj (vlax-ename->vla-object lwp)
lstP (ACET-GEOM-VERTEX-LIST lwp)
)
(if (eq (dxf 0 lwp) "LWPOLYLINE")
(progn
(setq Elev (vla-get-Elevation obj))
(setq lstN nil)
(foreach lt lstP
(if (and (eq (car lt) (car pn)) (eq (cadr lt) (cadr pn)))
(setq lt (list (car lt) (cadr lt) heinode))
(setq lt (list (car lt) (cadr lt) Elev))
)
(setq lstN (append lt lstN))
)
(vla-update (3DPoly lstN *Model*))
(vla-delete obj)
)
(progn
(setq lstP (ACET-GEOM-VERTEX-LIST lwp))
(setq lstN nil)
(foreach lt lstP
(if (and (eq (car lt) (car pn)) (eq (cadr lt) (cadr pn)))
(setq lt (list (car lt) (cadr lt) heinode))
)
(setq lstN (append lt lstN))
)
(vla-update (3DPoly lstN *Model*))
(vla-delete obj)
)
)
)
(RESTORE)
(princ "\nChuc cac ban vui ve! Thiep")
(princ)
)

@thiep : Mạn phép bạn nhé :cheers:

[khaosat2009 11]

Chào bạn khaosat2009

Yêu cầu của bạn có thể nói là tương đương phần mềm vẽ. thực tế bản vẽ của bạn có lẽ cũng đã được bạn vẽ bằng một phần mềm nào đó. Việc này mình có thể làm được nhưng sẽ tốn rất nhiều thời gian của mình. vì thế mình không thể hứa giúp bạn ngay được, bạn có thể nhờ thêm nhiều cao thủ khác trên diễn đàn.

Cám ơn Bạn.

Rất mong được Bạn và các anh giúp đỡ.

Mong tin

[trieubb 5]

Đây là phần tiếp theo của topic Viết lisp theo yêu cầu, mời các bạn tiếp tục thảo luận.

 

 

Xin bác Nguyen Hoanh và các cao thủ giúp em viết cái LISP thực hiện công việc sau:

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

[phamthanhbinh 3.146]

Minh có một bản vẽ lớn, muốn trích một phần của khu đó ra và save ra bản vẽ mới với tên khác.

Nhờ các anh giúp cho lisp chọn khu vực cần trích ( góc trên bên trái đến góc dưới bên phải ). Líp sẻ chọn tất cả đồi tượng trên, save qua bản vẽ mới, yêu cầu đặt tên file mới và khu vực trích đó được cắt theo hình chử nhật vừa chọn.

Rất mong được giúp đở,

Hề hề,

Chả biết bác Khaosat2009 có quên không chứ theo mình trong lúc chờ cái lisp hay cái gì đo hiện đại hơn, bác thử xài copyclip và pasteclip là Ok mà. Cũng chả chậm lắm đâu vì dùng kiểu gì bác cũng phải nhập mấy cái nội dung phụ bằng tay mà. Hề hề.

[khaosat2009 11]

Hề hề,

Chả biết bác Khaosat2009 có quên không chứ theo mình trong lúc chờ cái lisp hay cái gì đo hiện đại hơn, bác thử xài copyclip và pasteclip là Ok mà. Cũng chả chậm lắm đâu vì dùng kiểu gì bác cũng phải nhập mấy cái nội dung phụ bằng tay mà. Hề hề.

Mình không hiểu lệnh này lắm, mong được anh chỉ giúp

[Tuynh 1]

Chào Tuynh

Lisp này Tue_NV dựa trên nền mà Lisp bạn Thiep viết mà hoàn thành lại theo ý của bạn

Ban đầu Bạn dùng Lisp của Tue_NV để làm. Các cao độ 3dPLINE sẽ dàn trên các Vertex của 3dPline.

Sau này muốn hiệu chỉnh thì dùng Lisp này

Khi chạy Lisp hỏi :

Pick a point on Polyine: -> Bạn Pick vào điểm cần thay đổi độ cao

Pick chon chu thay doi do cao : -> Pick chọn chữ ngay tại điểm cần thay đổi độ cao

 

-> Lisp sẽ hiệu chỉnh độ cao theo ý của bạn . Chúc vui vẻ

OK bác Tuệ ạ, thanks bác nhé. Rất khâm phục bác

Chúc Tuệ sức khỏe, thành công.

[Thaistreetz 539]

Mình không hiểu lệnh này lắm, mong được anh chỉ giúp

Có nghĩa là bạn copy những gì bạn cần sang một bản vẽ mới và lưu bản vẽ này với một tên mới. Ý của anh Thanh Bình là vậy. Chỉ thêm một vài cái click chuột so với yêu cầu trên của bạn :cheers:

[khaosat2009 11]

Có nghĩa là bạn copy những gì bạn cần sang một bản vẽ mới và lưu bản vẽ này với một tên mới. Ý của anh Thanh Bình là vậy. Chỉ thêm một vài cái click chuột so với yêu cầu trên của bạn :cheers:

Đúng rồi đó bạn Thaistreetz, nhưng save bản vẻ khác ,tọa độ các đối tượng đó không thay đổi nha....!!

[Thaistreetz 539]

Thật khó tin bạn là dân khảo sát đấy.

Paste to original coordnates bạn không biết ah? :cheers:

[khaosat2009 11]

Thật khó tin bạn là dân khảo sát đấy.

Paste to original coordnates bạn không biết ah? :cheers:

Ờ, việc ấy thì mình hiểu. Nhưng làm thủ công thôi. Mở file này copy và paste file kia với lệnh .Paste to original coordnates.

Nhưng ý mình là : Trong bản vẽ lớn đó, phải chia ra nhiều mảnh bản đồ với các khung hình chử nhật ( ví dụ như 4 khung ) Nhờ bạn giúp Lisp khi chọn vào vị trí khung 1 , thì sẻ thực hiện save đó với tên đặt mới và sẻ tự động cắt tất cà các đối tượng ngoài khung. Nghĩa là chì còn các đối đượng ở khung 1 đó. ta lần lược chọn tiếp.....

*** Nếu được cao siêu hơn, thì Lisp thực hiện yêu cầu phân khung theo chiều dài x rộng ...> tạo các lưới ô.

đánh số khung, như K1, K2,...

Phân mảnh......> thì tự động save file theo tên khung K1, k2 ... và cắt hết các đối tượng ngoài khung, Tạo lưới khung bản đồ.

Mục đích cuối của mình nhờ bạn và cấc anh giúp là thế đó.

rất mong được giúp đở.

[moihoclisp 0]

Xin lỗi mình đã post bài này rồi nhưng không ai trả lời nên mình post lại mong các cao thủ giúp đỡ

trên bản vẽ có các text thuộc các layer khác nhau.

VD:

Họ tên ---------> layer: hten

Địa chỉ ---------> layer: dchi

số dt ---------> layer: dthoai

bây giờ em muốn cái Lisp khi chạy sẽ tự động gán text "Họ tên" vào biến hoten ; "Địa chỉ" vào biến diachi ; "số dt" -> biến sdthoai.

Thanks các Bác nhiều!

[gia_bach 1.549]

Xin lỗi mình đã post bài này rồi nhưng không ai trả lời nên mình post lại mong các cao thủ giúp đỡ

trên bản vẽ có các text thuộc các layer khác nhau.

VD:

Họ tên ---------> layer: hten

Địa chỉ ---------> layer: dchi

số dt ---------> layer: dthoai

bây giờ em muốn cái Lisp khi chạy sẽ tự động gán text "Họ tên" vào biến hoten ; "Địa chỉ" vào biến diachi ; "số dt" -> biến sdthoai.

Thanks các Bác nhiều!

Chào moihoclisp

Đúng là truớc đây tui có đọc đuợc 1 nôi dung yêu cầu tuơng tự, nhưng thực sự đọc đi đọc lại chẳng hiểu đuợc yêu cầu của bạn là gì !

Chắc mọi nguời cũng vậy thôi, không hiểu làm sao trả lời bạn đuợc.

Bạn có thể mô tả chi tiết hơn ?

Cách tốt nhất là đưa file có minh họa truớc và sau khi dùng LISP.

[TRUNGNGAMY 91]

Chào moihoclisp

Đúng là truớc đây tui có đọc đuợc 1 nôi dung yêu cầu tuơng tự, nhưng thực sự đọc đi đọc lại chẳng hiểu đuợc yêu cầu của bạn là gì !

Chắc mọi nguời cũng vậy thôi, không hiểu làm sao trả lời bạn đuợc.

Bạn có thể mô tả chi tiết hơn ?

Cách tốt nhất là đưa file có minh họa truớc và sau khi dùng LISP.

ý bạn này chắc muốn tạo 1 danh sách trong đó mỗi phần tử gồm có 3 thành phần như trên đó mà.

[master_worse 88]

- Bản vẽ A có một Text (gọi là nguồn)

- Bản vẽ B, C ... có rất nhiều text (gọi là đích) có các nội dung không giống nhau

- Sau khi thực hiện lệnh [chọn đối tượng nguồn >enter> chọn các đối tựong đích >enter> ]thì các đối tượng đích sẽ có nội dung của đối tượng nguồn.

(giống lệnh lisp match text trên diễn đàn nhưng cho dùng tổ hợp phím CTRL+Tab để chọn đối tượng trên bản vẽ khác)

Các tiền bối giúp em được không

[dvdcad 1]

Chào chandatn

Cập nhật Lisp chọn các đối tượng theo màu hay linetype

download here

;;;;;;;

Tôi thử lisp của bạn rồi

nhưng ko dc

khi tôi chọn đối tương có màu 6 chẳn hạn thì tất cảc các đối tượng có màu 6 phải chọn chứ đây lại thoat luôn ra

[moihoclisp 0]

Chào moihoclisp

Đúng là truớc đây tui có đọc đuợc 1 nôi dung yêu cầu tuơng tự, nhưng thực sự đọc đi đọc lại chẳng hiểu đuợc yêu cầu của bạn là gì !

Chắc mọi nguời cũng vậy thôi, không hiểu làm sao trả lời bạn đuợc.

Bạn có thể mô tả chi tiết hơn ?

Cách tốt nhất là đưa file có minh họa truớc và sau khi dùng LISP.

Vậy mình UP bản vẽ và 1 đọan Lisp minh họa mong ban giabach giúp mình nhé. Thanks

http://www.cadviet.com/upfiles/2/gan.rar

[conghoan1003 0]

Xin bác Nguyen Hoanh và các cao thủ giúp em viết cái LISP thực hiện công việc sau:

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

Chào trieubb!

Mình có xem file cad của bạn, đó là mặt cắt ngang, có phải là bạn làm bên cầu đường không? Bạn dùng chương trình gì chạy trắc nagng mà nó chẳng có thẳng hàng gì hết vậy? Mình cũng dùng nhiều chương trình mà chẳng có cái nào lại xuất ra kiểu như bạn cả. Mà hơn nữa bản vẽ của bạn có tới 1000 mặt cắt, không biết bạn có phóng đại lên không nữa. Mình làm đường mấy chục KM thì cũng phải chia hồ sơ ra nhiều đoạn nên mỗi File cũng không đến nỗi nhiều như thế. Bạn có thể up file của bạn lên để bác để mọi người tham khảo nhé. Hơn nữa lisp dùng để làm đi làm lại nhiều lần cho khỏi tốn nhiều thời gian, nếu công việc của bạn có nhiều bản vẽ như thế thì yêu cầu chứ có một file duy nhất thì bạn nên MOVE còn nhanh hơn thời gian viết lisp nhiều đó.

Mình chỉ góp ý không có ý gì khác mong ban tiếp thu nhé. Chúc bạn thành công!

[master_worse 88]

Vậy mình UP bản vẽ và 1 đọan Lisp minh họa mong ban giabach giúp mình nhé. Thanks

http://www.cadviet.com/upfiles/2/gan.rar

(defun c:gan (/ hoten diachi sdthoai)
(setq hoten(ssget "X"(list (cons 0 "Text")(cons 8 "tchu"))))
(setq diachi(ssget "X"(list(cons 0 "Text")(cons 8 "dchi"))))
(setq sdthoai(ssget "X"(list(cons 0 "Text")(cons 8 "dthoai"))))
(princ hoten ",   " diachi ",   " sdthoai)
)

Xin phép lão tiền tiền bối giabach nha!

Có phải ý bạn là

TRUNGNGAMY Gửi vào Sep 25 2009, 16:0

bạn này chắc muốn tạo 1 danh sách trong đó mỗi phần tử gồm có 3 thành phần như trên đó mà.

hay ...

Bạn Up file chi có

NGUYỄN VĂN A

QUẬN 10-TP HCM

0909999999

và đọn code trên thì lão giabach chắc cũng không hiểu đâu :cheers:

[gia_bach 1.549]

....

lão giabach chắc cũng không hiểu đâu :cheers:

To master_worse

he he : đồng ý với bạn là tui cũng có tí tuổi nhưng chưa đến độ lão đâu. <_<

 

Vậy mình UP bản vẽ và 1 đọan Lisp minh họa mong ban giabach giúp mình nhé. Thanks

http://www.cadviet.com/upfiles/2/gan.rar

To moihoclisp

Như bạn master_worse nhận xét, file Upload của bạn không có ý nghĩa trong thực tế !

Tuy nhiên gửi bạn đoạn code tham khảo.

Lisp chọn tất cả các Text trên lớp tchu,dchi,dthoai -> in ra màn hình.

Coi chừng Tên ông này cắm nhầm địa chỉ bà kia. :cheers:

(defun c:gan (/ hoten diachi sdthoai DATABASE I LAY_NAME NOIDUNG)
 (setq hoten (list) diachi(list) sdthoai (list) i 0)
 ; chon tat ca cac Text tren lop tchu,dchi,dthoai
 (if (setq database (ssget "X" '((-4 . "< AND")(0 . "Text")(8 . "tchu,dchi,dthoai")(-4 . "AND >"))))
   (foreach e (mapcar 'entget (mapcar 'cadr (ssnamex database)))
     (setq lay_name (cdr (assoc 8 e));ten lop
    noidung (cdr (assoc 1 e)))
     (cond
((= lay_name "TCHU")   (setq hoten   (append (list noidung) hoten)))
((= lay_name "DCHI")   (setq diachi  (append (list noidung) diachi)))
((= lay_name "DTHOAI") (setq sdthoai (append (list noidung) sdthoai)))
)
     )
   )
 (princ "\nBang thong ke :")
 (repeat (min (length hoten) (length diachi) (length diachi))
   (princ (strcat "\n" (nth i hoten) " " (nth i diachi) " " (nth i sdthoai)) )
   (setq i (1+ i))
   )
 (princ)
)

[gia_bach 1.549]

;;;;;;;

Tôi thử lisp của bạn rồi

nhưng ko dc

khi tôi chọn đối tương có màu 6 chẳn hạn thì tất cảc các đối tượng có màu 6 phải chọn chứ đây lại thoat luôn ra

Tại dòng nhắc : Chon doi tuong mau :

-> bạn phải chọn đối tuợng có màu(color) mong muốn.

Có phải bạn đã nhập số 6 tại dòng nhắc này ?

[thuyvan0210 0]

Xin nhờ các bạn viết giúp mình đoạn lisp như sau:

- mình muốn tính tổng diện tích các region đang lựa chọn.

[gia_bach 1.549]

Xin nhờ các bạn viết giúp mình đoạn lisp như sau:

- mình muốn tính tổng diện tích các region đang lựa chọn.

Bạn chạy thử Lisp tính diện tích các region

(defun c:AreaR (/ cnt tot ss obj );Region Area
 (vl-load-com)
 (princ "\nChon doi tuong Region de tinh dien tich : ")
 (if (setq ss (ssget '((0 . "REGION"))))
   (progn
     (setq cnt 0 tot 0)
     (foreach e (mapcar 'vlax-ename->vla-Object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(if (vlax-property-available-p e 'Area)
  (setq cnt (1+ cnt)
	tot (+ tot (vla-get-Area e))
	)))
     (princ (strcat "\nTong dien tich cua "(itoa cnt) " Region la : " (rtos tot) ))
     (if (and
    (setq obj (entsel "\nChon text de ghi ket qua hay Enter de ket thuc."))
    (setq obj (vlax-ename->vla-object (car obj)))
    (eq (vlax-get obj 'ObjectName) "AcDbText")
    )
(vla-put-TextString obj (rtos tot))
)
     (princ)
     )
   (princ "\nKhong co doi tuong Region nao duoc chon." )
   )
 (princ)
 )

[moihoclisp 0]

To master_worse

he he : đồng ý với bạn là tui cũng có tí tuổi nhưng chưa đến độ lão đâu. <_<

To master_worse

Như bạn master_worse nhận xét, file Upload của bạn không có ý nghĩa trong thực tế !

Tuy nhiên gửi bạn đoạn code tham khảo.

Lisp chọn tất cả các Text trên lớp tchu,dchi,dthoai -> in ra màn hình.

Coi chừng Tên ông này cắm nhầm địa chỉ bà kia. :cheers:

(defun c:gan (/ hoten diachi sdthoai DATABASE I LAY_NAME NOIDUNG)
 (setq hoten (list) diachi(list) sdthoai (list) i 0)
 ; chon tat ca cac Text tren lop tchu,dchi,dthoai
 (if (setq database (ssget "X" '((-4 . "< AND")(0 . "Text")(8 . "tchu,dchi,dthoai")(-4 . "AND >"))))
   (foreach e (mapcar 'entget (mapcar 'cadr (ssnamex database)))
     (setq lay_name (cdr (assoc 8 e));ten lop
    noidung (cdr (assoc 1 e)))
     (cond
((= lay_name "TCHU")   (setq hoten   (append (list noidung) hoten)))
((= lay_name "DCHI")   (setq diachi  (append (list noidung) diachi)))
((= lay_name "DTHOAI") (setq sdthoai (append (list noidung) sdthoai)))
)
     )
   )
 (princ "\nBang thong ke :")
 (repeat (min (length hoten) (length diachi) (length diachi))
   (princ (strcat "\n" (nth i hoten) " " (nth i diachi) " " (nth i sdthoai)) )
   (setq i (1+ i))
   )
 (princ)
)

Cám ơn bác Giabach. Đúng là đoạn code trên khong có ý nghĩa trong thực tế nhưng em cần có nó để phát triển cái Lisp của em.

Ví dụ như trên bản đồ địa chính có các layer tên chủ, loại đất, diện tích bây giờ em muốn lập bảng thống kê gồm 1 cột tên chủ, 1 cột diện tích, 1 cột loại đất thì phải có đoạn code này. Mong bác giúp

Cái lisp của bác hình như còn lỗi gì đó. Nó chạy đến chỗ "bảng thống kê" rồi trở về dòng Command. Bác xem lại dùm em nhé.

[truongthanh 7]

Xin nhờ các bạn viết giúp mình đoạn lisp như sau:

- mình muốn tính tổng diện tích các region đang lựa chọn.

sao ko dùng lệnh UNI vậy bạn?