Đến nội dung


Hình ảnh
- - - - -

[Yêu cầu] Nhờ các bác viết lisp vẽ mắt lưới khung và ghi tọa độ khung HCN nghiêng


  • Please log in to reply
32 replies to this topic

#21 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 14 August 2011 - 08:31 PM

@bác Trung,a Duan : cái dấu thập tạo bằng hàm entmake-Point, có thể thay bằng bất cứ gì cũng được ạ, k khó khăn gì. Còn vấn đề bỏ sót là do vấn đề số vòng lặp e dùng hàm fix, có thể không được như ý, nếu cần a Duan có thể thay bằng while
@a Duan : bác chú ý hàm textbox là được, và chỉ cần xử lý với text ở bước chèn DoY.
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#22 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 14 August 2011 - 10:36 PM

Đồng ý với ý kiến của bác TRUNGNGAMY, chắc bác chạy nhiều lần và soi rất kỹ nên phát hiện ra điều đó. Còn với việc phân việc phân biệt với các đối tượng của bản đồ thì em có ý tưởng khác. Em chỉ làm mắt lưới cho việc in bình đồ thôi. Khi nào hoàn thành xong cái này thì em sẽ cho ra sản phẩm mới kết hợp giữa các Lisp. Em tạo mắt lưới và ghi tọa độ khung chỉ là tạo ra một Wblock để insert vào layout khi in ấn chứ ko để trong model thì nó sẽ đè lên các đối tượng của bản đồ. Do vậy mà em cố ý đưa text ra ngoài khung để ko bị trùng đè với các đối tượng khác trong bản đồ. Cảm ơn bác đã đóng góp ý kiến :)
P/s: Ketxu: Uhm, anh thử tìm tòi xem, không biết cái khung ngoài text nó như thế nào nhỉ? Để anh xem lại cái lisp của bác Gia_Bach về xóa text đè nhau xem sao. Hiii. Anh lười mà, hee :)

Hề hề hề,
Cái khung bao text nó ở đây nè:

textbox Function

Measures a specified text object, and returns the diagonal coordinates of a box that encloses the text

(textbox elist)

Arguments

elist

An entity definition list defining a text object, in the format returned by entget.

If fields that define text parameters other than the text itself are omitted from elist, the current (or default) settings are used.

The minimum list accepted by textbox is that of the text itself.

Return Values

A list of two points, if successful; otherwise nil.

The points returned by textbox describe the bounding box of the text object as if its insertion point is located at (0,0,0) and its rotation angle is 0. The first list returned is generally the point (0.0 0.0 0.0) unless the text object is oblique or vertical, or it contains letters with descenders (such as g and p). The value of the first point list specifies the offset from the text insertion point to the lower-left corner of the smallest rectangle enclosing the text. The second point list specifies the upper-right corner of that box. Regardless of the orientation of the text being measured, the point list returned always describes the lower-left and upper-right corners of this bounding box


Còn nếu chịu dùng acet thì: (acet-ent-geomextents ename)

@ Bác ketxu: Hề hề hề, đúng là dùng express tools thì nó ngắn hơn nhưng mà phải ngẫm nhiều hơn và người đi mót sẽ khó mót hơn. Tuy nhiên khi đã có mà không dùng thì nó cũng ..... ngơ ngơ thế nào ấy bác ạ. Vậy nên mình cũng chỉ dám dùng những thứ mà ít nhiều cũng đã được mọi người xài trên diễn đàn rồi thôi. (vì là mình mót được mà). Còn nhiều cái khác đọc chửa ngấm nên vẫn chả dám xài đành để làm vốn ngâm từ từ bác ạ.
Cái express tools này cũng lạ, có cái nó cho dùng với hàm command, còn có cái lại chỉ được dùng như hàm của lisp. Thật tức như bò đá. Bác có biết lý do thì giải thích giùm mình một chút. Tỷ như cái extrim chẳng hạn. Có lúc dùng (etrim .... ) thì Ok nhưng có lúc lại báo lỗi unknown command.
Như cái lisp mình viết gửi bác thanhduan2407, ở máy mình thì không sao nhưng sang máy của bác ấy thì cứ unknown hoài. Vậy nên mình mới điên tiết, copy luôn cả cái etrim vào cuối cho bác ấy mà chả biết có dùng được không nữa.
Hề hề hề, Như vậy đâm ra ngắn quá hóa dài bác ạ......
@ Bác Thanhduan2407: Mình đã sửa lại lisp để tránh hiện tượng bỏ sót râu mà bạn đã gặp, đồng thời bổ sung luôn cục lisp Etrim vào cuối lisp để bác dùng khỏi bị lỗi. Tuy nhiên có một cách là bác add luôn cai thằng lisp Extrim vào startup Suit của CAD để khỏi cần đoạn lisp Etrim bổ sung đó. Hoặc trước khi chạy lisp này bác thực hiện chơi một lệnh Extrim trong CAD là nó hết báo lỗi của hàm (etrim ..... ) bác ạ.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#23 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 14 August 2011 - 11:00 PM

@ Bác ketxu: Hề hề hề, đúng là dùng express tools thì nó ngắn hơn nhưng mà phải ngẫm nhiều hơn và người đi mót sẽ khó mót hơn. Tuy nhiên khi đã có mà không dùng thì nó cũng ..... ngơ ngơ thế nào ấy bác ạ. Vậy nên mình cũng chỉ dám dùng những thứ mà ít nhiều cũng đã được mọi người xài trên diễn đàn rồi thôi. (vì là mình mót được mà). Còn nhiều cái khác đọc chửa ngấm nên vẫn chả dám xài đành để làm vốn ngâm từ từ bác ạ.
Cái express tools này cũng lạ, có cái nó cho dùng với hàm command, còn có cái lại chỉ được dùng như hàm của lisp. Thật tức như bò đá. Bác có biết lý do thì giải thích giùm mình một chút. Tỷ như cái extrim chẳng hạn. Có lúc dùng (etrim .... ) thì Ok nhưng có lúc lại báo lỗi unknown command.
Như cái lisp mình viết gửi bác thanhduan2407, ở máy mình thì không sao nhưng sang máy của bác ấy thì cứ unknown hoài. Vậy nên mình mới điên tiết, copy luôn cả cái etrim vào cuối cho bác ấy mà chả biết có dùng được không nữa.
Hề hề hề, Như vậy đâm ra ngắn quá hóa dài bác ạ......

- Em phát hiện ra là khá nhiều hàm ACET thực hiện trên cơ chế của (command...) , thành ra cũng hết mê tín nó ^^
=> Chịu khó dần dần viết lại được cái j ngắn ngắn thì viết ^^
Giả như cái thằng acet-ent-geomextents cũng có thể tạm hài lòng với :

(defun myself-ent-geomextents (ename / p1 p2)
(vla-getboundingbox (vlax-ename->vla-object ename) 'p1 'p2)
(mapcar '(lambda (a x) (* 0.5 (+ a x)))
(setq p1 (vlax-safearray->list p1)) (setq p2(vlax-safearray->list p2)))
(list p1 p2))

, mặc dù so về tốc độ thì không bằng ^^. Cứ dần dà như thế, ta sẽ bỏ được câu "Bạn nhớ là máy phải có Express rồi nhé ^^, nhất là viết chương trình mình dùng.

- Vụ Unknown thì e cũng không rõ ^^ Nếu dùng (etrim..) thì chỉ có thể báo chưa định nghĩa hàm thôi ạ.
Thường thì các lệnh ACET thực hiện rất quy củ theo bố cục :

(defun C:Lệnh (/ ...) ; Thủ tục
(defun Hàm (Đối số) ...)
(setq Đối số .......)
(Hàm Đối số) ;Hàm
)

Giả dụ như cái bạn Extrim, ta muốn gọi nó như 1 thủ tục thì gọi (c:Lệnh) ( ở đây là (c:extrim))
Muốn gọi nó như 1 hàm thì phải tìm code của nó để lôi ra cái tên Hàm + các đối số (ở đây là Etrim)
Vấn đề là tìm được code của nó. 1 số thứ trong file lisp thì ta có thể dùng chương trình tìm theo nội dung để lôi nó ra :)
- Ví dụ ở đây ta tìm được hàm etrim trong file Extrim.lsp, thư mục Expres với giải thích rõ ràng :

;Entity-TRIM function
;takes: na - entity name
; a - a point, the side to trim on
;NOTE: This function does not allow for the possible miss of
; non-continuous linetypes.
(defun etrim ( na a / ....)
;

^^
  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#24 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 15 August 2011 - 01:04 AM

@bác Trung,a Duan : cái dấu thập tạo bằng hàm entmake-Point, có thể thay bằng bất cứ gì cũng được ạ, k khó khăn gì. Còn vấn đề bỏ sót là do vấn đề số vòng lặp e dùng hàm fix, có thể không được như ý, nếu cần a Duan có thể thay bằng while
@a Duan : bác chú ý hàm textbox là được, và chỉ cần xử lý với text ở bước chèn DoY.

Hề hề hề,
Không phải dùng while dâu bác Ketxu ơi, bác cứ nhớ bài toán trồng cây hồi lớp 4 là giải được cái vụ thiếu grid ấy mà. Số line phải là số khoảng cách cộng 1 bác ạ.
Việc các text cưỡi lên nhau thì move cũng được nhưng như vậy thì các text sẽ cách khung không đều nhau -> hơi xấu trai bác ạ. Giá có cách nào để cho các text này cứ đều tăm tắp thì hay quá. Chiều dài text lại không hẳn là cố định nên hơi khó xác định cái khoảng cách này. Vả lại còn cái góc xoay của khung nữa. Hề hề hề, khó quá.....
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#25 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 15 August 2011 - 10:39 PM

Giúp anh thì giúp cho chót với ketxu. Lại mày mò lisp của người khác thì đó là 1 cực hình đối với anh. Cái miss lúc nãy thì dễ phát hiện chứ cái này anh chả biết. Nhón tay giúp anh tí nha. Hii. :D .

Hề hề hế,
Nhón thế này có được không hè???


(defun c:khbd (/ k kg pls1 pls2 xmin ymin xmax ymax pmin pmax
l1 l2 sh sc ss ss1 ss2 i pls3 lx ly pc stxt1 stxt2 ltxt ltx stx)
(vl-load-com)
(Command "undo" "be")
(command "ucs" "w")
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
;;;;;;(alert "\n Chon khung trong cua vung ban do")
;;;;;;(setq p1 (getpoint "\n Nhap diem goc ban do"))
(setq kg (car (entsel "\n Chon khung trong cua vung ban do")))

;;;;;;(command "pline" p1 (setq p2 (polar p1 g d))
;;;;;; (setq p3 (polar p2 (+ g (/ pi 2)) r))
;;;;;; (setq p4 (polar p3 (+ g pi) d))
;;;;;; "c"
;;;;;;)
;;;;(setq kg (entlast))
(setq pls1 (acet-ent-geomextents kg))
(setq pls2 (acet-geom-vertex-list kg))
(command "zoom" "W" (car pls1) (cadr pls1))
(setq xmin (* (fix (/ (car (vl-sort (mapcar '(lambda (x) (car x)) pls2) '(lambda (a B) (< a B)))) 100)) 100))
(setq ymin (* (fix (/ (car (vl-sort (mapcar '(lambda (y) (cadr y)) pls2) '(lambda (a B) (< a B)))) 100)) 100))
(setq xmax (* (fix (/ (car (vl-sort (mapcar '(lambda (x) (car x)) pls2) '(lambda (a B) (> a B)))) 100)) 100))
(setq ymax (* (fix (/ (car (vl-sort (mapcar '(lambda (y) (cadr y)) pls2) '(lambda (a B) (> a B)))) 100)) 100))
(setq pmin (list xmin ymin))
(setq pmax (list xmax ymax))
(setq ;;;;;d (getreal "\n Nhap chieu dai vung ban do: ")
;;;;;r (getreal "\n Nhap chieu rong vung ban do: ")
;;;;;g (getangle p1 "\n Nhap goc quay ban do: ")
k (getreal "\n Nhap ty le ban do: ")
)
(setq sh (+ 2 (fix (/ (- ymax ymin) (/ k 10)))))
(setq sc (+ 2 (fix (/ (- xmax xmin) (/ k 10)))))
;;;;; Tao luoi diem
(linepx (list (- xmin (/ k 200)) ymin) (/ k 100))
(setq l1 (entlast))
(linepy (list xmin (- ymin (/ k 200))) (/ k 100))
(setq l2 (entlast))
(command "array" l1 l2 "" "r" sh sc (/ k 10) (/ k 10))
(setq ss1 (ssget "cp" pls2))
(command "zoom" "e")
(setq ss (ssget "c" pmin (list (+ xmax k) (+ ymax k)) (list (cons 0 "line"))))
(setq ss2 (subss ss ss1))
(command "erase" ss2 "")
(command "zoom" "p")
;;;;;;;;Ket thuc tao luoi diem
(setq ss2 (acet-ss-to-list (ssget "f" pls2 (list (cons 0 "line")))))
(foreach e ss2
(setq pc (car (acet-geom-intersectwith e kg 0)))
(if (= (cadr (assoc 10 (entget e))) (cadr (assoc 11 (entget e))))
(if (setq sp (ssget "c" (list (- (cadr (assoc 10 (entget e))) (/ k 200)) (+ (caddr (assoc 10 (entget e))) (/ k 10)))
(list (+ (cadr (assoc 10 (entget e))) (/ k 200)) (+ (caddr (assoc 11 (entget e))) (/ k 10)))
(list (cons 0 "line")) ))
(command "break" e pc (cdr (assoc 10 (entget e))))
(command "break" e pc (cdr (assoc 11 (entget e))))
)
)
(if (= (caddr (assoc 10 (entget e))) (caddr (assoc 11 (entget e))))
(if (setq sp (ssget "c" (list (+ (cadr (assoc 10 (entget e))) (/ k 10)) (- (caddr (assoc 10 (entget e))) (/ k 200)))
(list (+ (cadr (assoc 11 (entget e))) (/ k 10)) (+ (caddr (assoc 11 (entget e))) (/ k 200)))
(list (cons 0 "line")) ))
(command "break" e pc (cdr (assoc 10 (entget e))))
(command "break" e pc (cdr (assoc 11 (entget e))))
)
)
)

;;;;;; Ve rau danh so toa do
(setq i 0)
(repeat sh
(linepx (list (- xmin k) (+ ymin (* i (/ k 10)))) (+ (- xmax xmin) (* 2 k)))
(setq lx (entlast))
(setq pls3 (vl-sort (acet-geom-intersectwith lx kg 0) '(lambda (a B) (< (car a) (car B)))))
(if pls3
(progn
(linepx (car pls3) (/ k 200))
;;;;;(entmake (list (cons 0 "text") (cons 40 (/ k 200)) (cons 50 0.0)
;;;;; (cons 8 "GRD_UTMGRID") (cons 1 (rtos (cadar pls3) 2 0))
;;;;; (cons 72 2) (cons 11 (car pls3)) (cons 73 2))
;;;;;)
(command "text" "j" "mr" (list (- (caar pls3) (/ k 200)) (cadar pls3)) (/ k 200) 0 (rtos (cadar pls3) 2 0))
(if (cadr pls3)
(progn
(linepx (cadr pls3) (- (/ k 200)))
(command "text" "j" "ml" (list (+ (caadr pls3) (/ k 200)) (cadadr pls3)) (/ k 200) 0 (rtos (cadadr pls3) 2 0))
)

)
)
)
(command "erase" lx "")
(setq i (1+ i))
)
(setq i 0)
(repeat sc
(linepy (list (+ xmin (* i (/ k 10))) (- ymin k )) (+ (- ymax ymin) (* 2 k)))
(setq ly (entlast))
(setq pls3 (vl-sort (acet-geom-intersectwith ly kg 0) '(lambda (a B) (< (cadr a) (cadr B)))))
(if pls3
(progn
(linepy (car pls3) (/ k 200))
(command "text" "j" "mr" (list (caar pls3) (- (cadar pls3) (/ k 200))) (/ k 200) 90 (rtos (caar pls3) 2 0))
(if (cadr pls3)
(progn
(linepy (cadr pls3) (- (/ k 200)))
(command "text" "j" "ml" (list (caadr pls3) (+ (cadadr pls3) (/ k 200))) (/ k 200) 90 (rtos (caadr pls3) 2 0))
)
)
)
)
(command "erase" ly "")
(setq i (1+ i))
)

;;;;(etrim kg (list (+ xmax k) (+ ymax k)))
;;;;;; Ket thuc ve rau danh so toa do

(setq stxt1 (acet-ss-to-list (ssget "x" (list (cons 0 "text") (cons 50 (/ pi 2)) (cons 72 2)))))
(foreach txt stxt1
(setq ltxt (acet-ent-geomextents txt))
(setq stx (acet-ss-to-list (ssget "c" (car ltxt) (cadr ltxt) (list (cons 0 "text")))))
(if (> (length stx) 1)
(progn
(foreach tx stx
(if (not (eq tx txt))
(progn
(setq ltx (acet-ent-geomextents tx))
(command "move" txt "" (cadr ltxt) (list (caadr ltxt) (- (cadar ltx) (/ k 100))))
)
)
)
)
)
)
(setq stxt2 (acet-ss-to-list (ssget "x" (list (cons 0 "text") (cons 50 (/ pi 2)) (cons 72 0)))))
(foreach txt stxt2
(setq ltxt (acet-ent-geomextents txt))
(setq stx (acet-ss-to-list (ssget "c" (car ltxt) (cadr ltxt) (list (cons 0 "text")))))
(if (> (length stx) 1)
(foreach tx stx
(if (not (eq tx txt))
(progn
(setq ltx (acet-ent-geomextents tx))
(command "move" txt "" (car ltxt) (list (caar ltxt) (+ (cadadr ltx) (/ k 100))))
)
)
)
;;;;;;;;;; (command "move" txt "" (car ltxt) (list (caar ltxt) (cadadr ltxt)))
)
)


(setvar "osmode" oldos)
(command "undo" "e")
(princ)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;-------------------------------------------------------------------------------
(Defun DTR(x) (/ (* x pi) 180) ) ;;;change degree to radian, return REAL
;;;-------------------------------------------------------------------------------
(defun lineP (p0 a r / p1) ;;;Line polar: point, degree angle, radius
(setq p1 (polar p0 (dtr a) r))
(command "line" p0 p1 "")
)
;;;-------------------------------------------------------------------------------
(defun linePX (p0 x) (lineP p0 0 x)) ;;;Horizontal line: length x, from p0
;;;-------------------------------------------------------------------------------
(defun linePY (p0 y) (lineP p0 90 y)) ;;;Vertical line: length y, from p0
;;;-------------------------------------------------------------------------------

(defun subss ( ss1 ss2 / lst1 lst2)
(setq lst1 (acet-ss-to-list ss1))

(setq lst2 (acet-ss-to-list ss2))

(foreach x lst2
(if (member x lst1)
(setq lst1 (vl-remove x lst1))
)
)
(setq ss3 (acet-list-to-ss lst1))
ss3
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


Hề hề hề, nếu vẫn chưa ưng thì bác nhón tay post lên để mình sửa lại nhé.......
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#26 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 16 August 2011 - 07:17 AM

@Phamthanhbinh: Hic hic, em cảm ơn bác nhiều. Rất vừa với ý của em.
@Ketxu: Cảm ơn Ketxu nhé
Cả hai đều rất nhiệt tình, em sẽ cố gắng nghiên cứu. Cảm ơn các bác
Mạo muội Bác Bình và Ketxu, em tự sửa cho tốc độ nó nhanh hơn một chút cho cái viết text nó nhanh. Hề hề hề.
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=52041&st=20

(defun c:khbd (/ k kg pls1 pls2 xmin ymin xmax ymax pmin pmax
l1 l2 sh sc ss ss1 ss2 i pls3 lx ly pc stxt1 stxt2 ltxt ltx stx)
(vl-load-com)
(Command "undo" "be")
(command "ucs" "w")
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq kg (car (entsel "\n Chon khung trong cua vung ban do")))
(setq pls1 (acet-ent-geomextents kg))
(setq pls2 (acet-geom-vertex-list kg))
(command "zoom" "W" (car pls1) (cadr pls1))
(setq xmin (* (fix (/ (car (vl-sort (mapcar '(lambda (x) (car x)) pls2) '(lambda (a B) (< a B)))) 100)) 100))
(setq ymin (* (fix (/ (car (vl-sort (mapcar '(lambda (y) (cadr y)) pls2) '(lambda (a B) (< a B)))) 100)) 100))
(setq xmax (* (fix (/ (car (vl-sort (mapcar '(lambda (x) (car x)) pls2) '(lambda (a B) (> a B)))) 100)) 100))
(setq ymax (* (fix (/ (car (vl-sort (mapcar '(lambda (y) (cadr y)) pls2) '(lambda (a B) (> a B)))) 100)) 100))
(setq pmin (list xmin ymin))
(setq pmax (list xmax ymax))
(setq k (getreal "\n Nhap ty le ban do: ")
)
(setq sh (+ 2 (fix (/ (- ymax ymin) (/ k 10)))))
(setq sc (+ 2 (fix (/ (- xmax xmin) (/ k 10)))))
;;;;; Tao luoi diem
(linepx (list (- xmin (/ k 200)) ymin) (/ k 100))
(setq l1 (entlast))
(linepy (list xmin (- ymin (/ k 200))) (/ k 100))
(setq l2 (entlast))
(command "array" l1 l2 "" "r" sh sc (/ k 10) (/ k 10))
(setq ss1 (ssget "cp" pls2))
(command "zoom" "e")
(setq ss (ssget "c" pmin (list (+ xmax k) (+ ymax k)) (list (cons 0 "line"))))
(setq ss2 (subss ss ss1))
(command "erase" ss2 "")
(command "zoom" "p")
;;;;;;;;Ket thuc tao luoi diem
(setq ss2 (acet-ss-to-list (ssget "f" pls2 (list (cons 0 "line")))))
(setq s1 ((lambda (sec) (+ (* 86400 (- sec (fix sec))) 60)) (getvar "DATE")))
(foreach e ss2
(setq pc (car (acet-geom-intersectwith e kg 0)))
(if (= (cadr (assoc 10 (entget e))) (cadr (assoc 11 (entget e))))
(if (setq sp (ssget "c" (list (- (cadr (assoc 10 (entget e))) (/ k 200)) (+ (caddr (assoc 10 (entget e))) (/ k 10)))
(list (+ (cadr (assoc 10 (entget e))) (/ k 200)) (+ (caddr (assoc 11 (entget e))) (/ k 10)))
(list (cons 0 "line")) ))
(command "break" e pc (cdr (assoc 10 (entget e))))
(command "break" e pc (cdr (assoc 11 (entget e))))
)
)
(if (= (caddr (assoc 10 (entget e))) (caddr (assoc 11 (entget e))))
(if (setq sp (ssget "c" (list (+ (cadr (assoc 10 (entget e))) (/ k 10)) (- (caddr (assoc 10 (entget e))) (/ k 200)))
(list (+ (cadr (assoc 11 (entget e))) (/ k 10)) (+ (caddr (assoc 11 (entget e))) (/ k 200)))
(list (cons 0 "line")) ))
(command "break" e pc (cdr (assoc 10 (entget e))))
(command "break" e pc (cdr (assoc 11 (entget e))))
)
)
)

;;;;;; Ve rau danh so toa do
(setq i 0)
(repeat sh
(linepx (list (- xmin k) (+ ymin (* i (/ k 10)))) (+ (- xmax xmin) (* 2 k)))
(setq lx (entlast))
(setq pls3 (vl-sort (acet-geom-intersectwith lx kg 0) '(lambda (a B) (< (car a) (car B)))))
(if pls3
(progn
(linepx (car pls3) (/ k 200))
;;; (command "text" "j" "mr" (list (- (caar pls3) (/ k 200)) (cadar pls3)) (/ k 200) 0 (rtos (cadar pls3) 2 0))
(wtxt "MR" (list (- (caar pls3) (/ k 200)) (cadar pls3)) (/ k 200) 0 (rtos (cadar pls3) 2 0))
(if (cadr pls3)
(progn
(linepx (cadr pls3) (- (/ k 200)))
;;; (command "text" "j" "ml" (list (+ (caadr pls3) (/ k 200)) (cadadr pls3)) (/ k 200) 0 (rtos (cadadr pls3) 2 0))
(wtxt "ML" (list (+ (caadr pls3) (/ k 200)) (cadadr pls3)) (/ k 200) 0 (rtos (cadadr pls3) 2 0))
)

)
)
)
(command "erase" lx "")
(setq i (1+ i))
)
(setq i 0)
(repeat sc
(linepy (list (+ xmin (* i (/ k 10))) (- ymin k )) (+ (- ymax ymin) (* 2 k)))
(setq ly (entlast))
(setq pls3 (vl-sort (acet-geom-intersectwith ly kg 0) '(lambda (a B) (< (cadr a) (cadr B)))))
(if pls3
(progn
(linepy (car pls3) (/ k 200))
;;; (command "text" "j" "mr" (list (caar pls3) (- (cadar pls3) (/ k 200))) (/ k 200) 90 (rtos (caar pls3) 2 0))
(wtxt "MR" (list (caar pls3) (- (cadar pls3) (/ k 200))) (/ k 200) (/ pi 2) (rtos (caar pls3) 2 0))
(if (cadr pls3)
(progn
(linepy (cadr pls3) (- (/ k 200)))
;;; (command "text" "j" "ml" (list (caadr pls3) (+ (cadadr pls3) (/ k 200))) (/ k 200) 90 (rtos (caadr pls3) 2 0))
(wtxt "ML" (list (caadr pls3) (+ (cadadr pls3) (/ k 200))) (/ k 200) (/ pi 2) (rtos (caar pls3) 2 0))
)
)
)
)
(command "erase" ly "")
(setq i (1+ i))
)

;;;;;; Ket thuc ve rau danh so toa do

(setq stxt1 (acet-ss-to-list (ssget "x" (list (cons 0 "text") (cons 50 (/ pi 2)) (cons 72 2)))))
(foreach txt stxt1
(setq ltxt (acet-ent-geomextents txt))
(setq stx (acet-ss-to-list (ssget "c" (car ltxt) (cadr ltxt) (list (cons 0 "text")))))
(if (> (length stx) 1)
(progn
(foreach tx stx
(if (not (eq tx txt))
(progn
(setq ltx (acet-ent-geomextents tx))
(command "move" txt "" (cadr ltxt) (list (caadr ltxt) (- (cadar ltx) (/ k 100))))
)
)
)
)
)
)
(setq stxt2 (acet-ss-to-list (ssget "x" (list (cons 0 "text") (cons 50 (/ pi 2)) (cons 72 0)))))
(foreach txt stxt2
(setq ltxt (acet-ent-geomextents txt))
(setq stx (acet-ss-to-list (ssget "c" (car ltxt) (cadr ltxt) (list (cons 0 "text")))))
(if (> (length stx) 1)
(foreach tx stx
(if (not (eq tx txt))
(progn
(setq ltx (acet-ent-geomextents tx))
(command "move" txt "" (car ltxt) (list (caar ltxt) (+ (cadadr ltx) (/ k 100))))
)
)
)
)
)
(setvar "osmode" oldos)
(command "undo" "e")
(setq s2 ((lambda (sec) (+ (* 86400 (- sec (fix sec))) 60)) (getvar "DATE")))
(prompt (strcat "Thoi gian thuc hien chuong trinh la: " (rtos (- s2 s1) 2 3) " giay"))
(princ)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;-------------------------------------------------------------------------------
(Defun DTR(x) (/ (* x pi) 180) ) ;;;change degree to radian, return REAL
;;;-------------------------------------------------------------------------------
(defun lineP (p0 a r / p1) ;;;Line polar: point, degree angle, radius
(setq p1 (polar p0 (dtr a) r))
(command "line" p0 p1 "")
)
;;;-------------------------------------------------------------------------------
(defun linePX (p0 x) (lineP p0 0 x)) ;;;Horizontal line: length x, from p0
;;;-------------------------------------------------------------------------------
(defun linePY (p0 y) (lineP p0 90 y)) ;;;Vertical line: length y, from p0
;;;-------------------------------------------------------------------------------

(defun subss ( ss1 ss2 / lst1 lst2)
(setq lst1 (acet-ss-to-list ss1))

(setq lst2 (acet-ss-to-list ss2))

(foreach x lst2
(if (member x lst1)
(setq lst1 (vl-remove x lst1))
)
)
(setq ss3 (acet-list-to-ss lst1))
ss3
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun wtxt(jt p h tAng txt / sty d h1 h2 wf h) ;;;Write txt on graphic screen at p
(setq sty (getvar "textstyle") )
(entmakex (list (cons 0 "TEXT") (cons 7 sty) (cons 40 h)(cons 1 txt) (cons 10 p)(cons 73 2)(cons 11 p)(cons 50 tAng)
(cons 72 (cond ((= jt "R") 2) (T 0)))))
)

  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#27 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 16 August 2011 - 08:36 AM

^^ @ a Duân : Hàm viết text chỉ cond "R" và T, mà bác chơi cả "MR" với "ML" mần chi để nó chui vào trong HCN thế ạ ^^ Và nếu tiện entmake thì cố entmake hết tất tần tật luôn đi ạ. Hề hề.
  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#28 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 16 August 2011 - 09:41 AM

^^ @ a Duân : Hàm viết text chỉ cond "R" và T, mà bác chơi cả "MR" với "ML" mần chi để nó chui vào trong HCN thế ạ ^^ Và nếu tiện entmake thì cố entmake hết tất tần tật luôn đi ạ. Hề hề.

Hê hê hê, biết là sai rồi nhưng cứ cho vào đấy, có thấy sai đâu. Hê hê, Ketxu chỉnh lại cái hàm tạo text ấy đi, cái thuộc tính "ML, MC, MB, MR ... " anh chả tìm thấy chỗ phân biệt để chui vào đó nhặt. Hic
  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#29 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 16 August 2011 - 12:47 PM

Cái "R" của e thực chất là Midle Right, còn T là midle Left, vì vậy mới có mã 72, 73. A dùng mà k thấy là nó đã ở chế độ midle rồi sao :o.Trong trường hợp e giải quyết bài toán chỉ dùng 2 chế độ đó, viết hết ra mần chi cho hàm nó dài ạ. A muốn có thêm các cái khác thì phải đổi rồi xem entget của nó thôi, hoặc là tìm hàm Make_text bác Thái Bụi viết trên 4r rồi.
  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#30 trungphuong145

trungphuong145

    biết zoom

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

Đã gửi 08 January 2013 - 05:07 PM

cái này đúng thật sự dúp ích rât nhiều cho n ace trắc địa, cảm ơn cute, nhưng cho mình xin góp thêm chút ý kến. nếu có chuyển khung in và xoay ngang vào Layout thì thật ko còn gi tuyệt vời hơn. tks mọi người
  • 0

#31 mingduk

mingduk

    biết zoom

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

Đã gửi 21 November 2013 - 02:44 PM

Các bác có thể viết lại lips này giúp em theo biên chế bản vẽ như sau được không ạ

Với tỉ lệ 1:1000  thì khung theo trục Y có chiều rộng là 25, theo trục X có chiều rộng là 5

Với tỉ lệ 1:2000  thì khung theo trục Y có chiều rộng là 50, theo trục X có chiều rộng là 10

Em chân thành cảm ơn ạ. 


  • 0

#32 mingduk

mingduk

    biết zoom

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

Đã gửi 10 March 2015 - 01:35 PM

bac phamthanhbinh cho em hỏi chút ạ
Khi em sd lips của bác em chọn khung trong xong thì command hiện Command: ; error: too many arguments
Bác cho em hỏi cách khắc phục ạ
  • 0

#33 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 10 March 2015 - 03:36 PM

bac phamthanhbinh cho em hỏi chút ạ
Khi em sd lips của bác em chọn khung trong xong thì command hiện Command: ; error: too many arguments
Bác cho em hỏi cách khắc phục ạ

Hề hề hề,

 Ây da, cái ni ngộ việt lâu lâu rồi há, chả piết nị dùng lisp nào nữa vì nó đã được chỉnh sửa nhiều nhiều rồi á. vậy nên nị thử post cái lisp mà nị dùng lên coi sao nhé. Lâu nay ngộ cũng không chuyên tâm lắm với nó nên chắc cũng phải mất nhiều nhiều thời gian mới tìm ra cái lỗi à. Nị cứ post cái lisp của nị dùng lên có khi các bác khác sẽ giúp nị nhanh hơn là ngộ đó.

Hề hề hề , thông cảm cho ngộ nhen.


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