Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Jin Yong

Hỏi về Lisp (thuật toán, ý tưởng, coding,...)

Các bài được khuyến nghị

Bee    108

Chào mọi người. Em có 1 yêu cầu cần giúp đỡ như sau:

- Em có list ban đầu ((5 (a1 a2 a4) ) (10 (b1 b3 b4))  (5 (a3)))

- Và e cần kết quả như sau: ((5 (a1 a2 a4 a3)) (10 (b1 b3 b4))).

Cho hỏi là có hàm nào thực hiện đc như trên ko a?

Thank.

Nghịch tí ^_^

 

(setq lst '((5 (a1 a2 a4) ) (10 (b1 b3 b4))  (5 (a3))))

 

(append (list (list (caar lst) (append (cadar lst) (car (cdaddr lst))))) (list (cadr lst)))

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
thanhduan2407    227

Chào các bác!

Từ ngày tham gia diễn đàn em đã học được rất nhiều điều bổ ích và cũng tự trau dồi kiến thức để tự viết Lisp. Hiện tại em viết cũng được 1 số lisp phục vụ cho công việc của mình và vì còn non kinh nghiệm nên em thường viết riêng lẻ từng lisp. Do nhiều chương trình em đã copy lại rất nhiều hàm dẫn đến hàm được lặp đi lặp lại rất nhiều lần (hàm giống hệt nhau).

Nay em muốn gộp tất cả các lisp với nhau và lọc loại bỏ các hàm giống nhau chỉ để lại 1 hàm để đóng gói thì có cách nào không ạ?

Thứ hai là em  muốn thống kê các tên lệnh thì có cách nào làm nhanh không ạ?

Em xin chân thành cảm ơn các bác nhiều!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Doan Van Ha    2.678

Notepad++ làm việc này rất đơn giản:

- Tìm 1 chuỗi trong tất cả file lisp muốn tìm.

- Trả về danh sách hàm, danh sách biến của 1 file lisp

- v.v...

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
thanhduan2407    227

Notepad++ làm việc này rất đơn giản:

- Tìm 1 chuỗi trong tất cả file lisp muốn tìm.

- Trả về danh sách hàm, danh sách biến của 1 file lisp

- v.v...

Cháu cảm ơn bác!

Cháu sẽ tìm hiểu bây giờ ạ!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Thaistreetz    515

Cháu cảm ơn bác!

Cháu sẽ tìm hiểu bây giờ ạ!

VLide của Cad làm việc này còn đơn giản và chuyên nghiệp hơn nữa.

Bạn tạo 1 project chứa tất cả các file lisp của bạn, tạo thêm 1 file là thư viện hàm con. gom hết các hàm con hay dùng vào đó. Dùng chức năng search để tìm và xóa các hàm con ở các lisp riêng lẻ sau khi đã đưa 1 hàm mẫu vào thư viện hàm con.

Project còn có tác dụng build toàn bộ file lisp của bạn thành 1 file mã hóa duy nhất chỉ với 1 cái click chuột. Sau khi build, nó xuất cho bạn danh sách toàn bộ hàm con (không khai báo hàm cục bộ) và toàn bộ tên lệnh mà project đó có. Ngoài ra còn 1 số thông báo lỗi khác nếu có.

 

 

 

Tiện toppic này nhiều cao thủ ghé qua nên cho mình hỏi. Trong Cad có lệnh nào quản lý việc hiển thị các đối tượng theo layer không nhỉ?

Đại loại là vầy: Mình có 1 bản vẽ rất nhiều layer nhưng có thể phân ra làm các nhóm: Nhóm layer Khảo sát, nhóm layer Thiết kế của từng hạng mục công trình.

Mình đang cần 1 lệnh để quản lý việc bật tắt các nhóm layer này. Mục đích để xem cho dễ. Ví dụ: khi muốn xem bản vẽ khảo sát, chỉ các layer khảo sát bật, còn lại tắt hết,

khi muốn xem bản vẽ điện nước, chỉ các layer nhóm thiết kế điện nước bật.... viêc thiết lập thế nào là do người dùng add vào danh sách quản lý.

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
gia_bach    1.442

...........

Tiện toppic này nhiều cao thủ ghé qua nên cho mình hỏi. Trong Cad có lệnh nào quản lý việc hiển thị các đối tượng theo layer không nhỉ?

Đại loại là vầy: Mình có 1 bản vẽ rất nhiều layer nhưng có thể phân ra làm các nhóm: Nhóm layer Khảo sát, nhóm layer Thiết kế của từng hạng mục công trình.

Mình đang cần 1 lệnh để quản lý việc bật tắt các nhóm layer này. Mục đích để xem cho dễ. Ví dụ: khi muốn xem bản vẽ khảo sát, chỉ các layer khảo sát bật, còn lại tắt hết,

khi muốn xem bản vẽ điện nước, chỉ các layer nhóm thiết kế điện nước bật.... viêc thiết lập thế nào là do người dùng add vào danh sách quản lý.

"Layer States Manager" làm được yêu cầu này.

CadViet có bài ở đây: http://www.cadviet.com/forum/topic/6337-layer-states-manager/

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
snowman.hms    30

Ai biết thuật toán này tên gì không mách bảo tí để tìm hiểu:

Cho n điểm A,B,C,D,E... (gọi chung là các điểm X) trên m.phẳng. M là điểm di động. Các chi phí đơn vị từ M đến X là kX (đã biết). MX là các khoảng cách từ M đến X.

Tìm vị trí điểm M sao cho tổng chi phí là nhỏ nhất:

(MA*kA+MB*kB+MC*kC+MD*kD+ME*kE+...) -> Min

;|Usage:
(setq p	 '(0. 0. 0.)
      ml '(3.3 2.4 4.0 5.0 3.1 2.6 4.7 5.2 1.3 3.1 2.6 3.1 1.8 3.3 2.4 3.0 4.0 5.0 3.1 2.6 4.7 1.7 1.3 3.3 5.0 3.1 2.6
	   4.7 1.3 5.0 3.1 2.6 4.7 3.1)
      pl '((6879.14 3202.63 0.0)
	   (6873.43 3210.3 0.0)
	   (6853.77 3208.42 0.0)
	   (6854.52 3200.9 0.0)
	   (6860.47 3194.65 0.0)
	   (6868.38 3197.28 0.0)
	   (6886.92 3201.2 0.0)
	   (6896.19 3209.7 0.0)
	   (6867.55 3203.61 0.0)
	   (6865.33 3205.73 0.0)
	   (6873.24 3208.37 0.0)
	   (6851.51 3208.83 0.0)
	   (6896.32 3207.22 0.0)
	   (6892.93 3197.81 0.0)
	   (6887.22 3205.49 0.0)
	   (6875.33 3206.84 0.0)
	   (6867.55 3203.61 0.0)
	   (6868.31 3196.08 0.0)
	   (6874.26 3189.83 0.0)
	   (6882.17 3192.47 0.0)
	   (6900.71 3196.38 0.0)
	   (6884.13 3211.28 0.0)
	   (6881.34 3198.79 0.0)
	   (6897.79 3208.9 0.0)
	   (6873.16 3207.16 0.0)
	   (6879.12 3200.91 0.0)
	   (6887.03 3203.55 0.0)
	   (6905.56 3207.46 0.0)
	   (6886.2 3209.87 0.0)
	   (6859.35 3210.26 0.0)
	   (6865.3 3204.02 0.0)
	   (6873.21 3206.65 0.0)
	   (6891.75 3210.56 0.0)
	   (6901.01 3208.31 0.0)
	  )
      s	 100.
)
(f p ml pl s) ---> (1637.54 (6877.03 3204.05))
|;
(defun f (p ml pl s / di d1 d m t0)
  ;; p : Initial point (should be "Geometric median")
  ;; ml: Factor list
  ;; pl: Point list
  ;; s : Initial step distance
  (setq	d  (f0 p ml pl)
	d1 d
	m  '((0 1) (1 1) (1 0) (1 -1) (0 -1) (-1 -1) (-1 0) (-1 1))
	t0 (getvar "MilliSecs")
  )
  (while (> s fuz)
    (setq l (mapcar (function (lambda (x) (mapcar (function +) p x))) (mxs m s)))
    (foreach p1	l
      (if (<= (setq di (f0 p1 ml pl)) d1)
	(setq d1 di
	      p	 p1
	)
      )
    )
    (if	(<= d d1)
      (setq s (/ s 2.))
      (setq d d1)
    )
  )
  (princ (strcat "\nTotal times: " (rtos (- (getvar "MilliSecs") t0)) " ms.\n"))
  (list d p)
)
;;--------------Sub Func----------------;;
(defun f0 (p ml pl)
  (apply (function +) (mapcar (function *) ml (mapcar (function (lambda (x) (distance p x))) pl)))
)
(defun mxs (m s) (mapcar (function (lambda (r) (mapcar (function (lambda (n) (* n s))) r))) m))
  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
thanhduan2407    227

VLide của Cad làm việc này còn đơn giản và chuyên nghiệp hơn nữa.

Bạn tạo 1 project chứa tất cả các file lisp của bạn, tạo thêm 1 file là thư viện hàm con. gom hết các hàm con hay dùng vào đó. Dùng chức năng search để tìm và xóa các hàm con ở các lisp riêng lẻ sau khi đã đưa 1 hàm mẫu vào thư viện hàm con.

Project còn có tác dụng build toàn bộ file lisp của bạn thành 1 file mã hóa duy nhất chỉ với 1 cái click chuột. Sau khi build, nó xuất cho bạn danh sách toàn bộ hàm con (không khai báo hàm cục bộ) và toàn bộ tên lệnh mà project đó có. Ngoài ra còn 1 số thông báo lỗi khác nếu có.

 

Bác có tài liệu về cách sử dụng Project cho em tham khảo với. Em muốn quản lý và đóng gói nó gọn hơn bác ạ!

Cảm ơn bác nhiều!

P/s: Nếu có video thì tốt quá.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Doan Van Ha    2.678
;|Usage:
(setq p	 '(0. 0. 0.)
      ml '(3.3 2.4 4.0 5.0 3.1 2.6 4.7 5.2 1.3 3.1 2.6 3.1 1.8 3.3 2.4 3.0 4.0 5.0 3.1 2.6 4.7 1.7 1.3 3.3 5.0 3.1 2.6
	   4.7 1.3 5.0 3.1 2.6 4.7 3.1)
      pl '((6879.14 3202.63 0.0)
	   (6873.43 3210.3 0.0)
	   (6853.77 3208.42 0.0)
	   (6854.52 3200.9 0.0)
	   (6860.47 3194.65 0.0)
	   (6868.38 3197.28 0.0)
	   (6886.92 3201.2 0.0)
	   (6896.19 3209.7 0.0)
	   (6867.55 3203.61 0.0)
	   (6865.33 3205.73 0.0)
	   (6873.24 3208.37 0.0)
	   (6851.51 3208.83 0.0)
	   (6896.32 3207.22 0.0)
	   (6892.93 3197.81 0.0)
	   (6887.22 3205.49 0.0)
	   (6875.33 3206.84 0.0)
	   (6867.55 3203.61 0.0)
	   (6868.31 3196.08 0.0)
	   (6874.26 3189.83 0.0)
	   (6882.17 3192.47 0.0)
	   (6900.71 3196.38 0.0)
	   (6884.13 3211.28 0.0)
	   (6881.34 3198.79 0.0)
	   (6897.79 3208.9 0.0)
	   (6873.16 3207.16 0.0)
	   (6879.12 3200.91 0.0)
	   (6887.03 3203.55 0.0)
	   (6905.56 3207.46 0.0)
	   (6886.2 3209.87 0.0)
	   (6859.35 3210.26 0.0)
	   (6865.3 3204.02 0.0)
	   (6873.21 3206.65 0.0)
	   (6891.75 3210.56 0.0)
	   (6901.01 3208.31 0.0)
	  )
      s	 100.
)
(f p ml pl s) ---> (1637.54 (6877.03 3204.05))
|;
(defun f (p ml pl s / di d1 d m t0)
  ;; p : Initial point (should be "Geometric median")
  ;; ml: Factor list
  ;; pl: Point list
  ;; s : Initial step distance
  (setq	d  (f0 p ml pl)
	d1 d
	m  '((0 1) (1 1) (1 0) (1 -1) (0 -1) (-1 -1) (-1 0) (-1 1))
	t0 (getvar "MilliSecs")
  )
  (while (> s fuz)
    (setq l (mapcar (function (lambda (x) (mapcar (function +) p x))) (mxs m s)))
    (foreach p1	l
      (if (<= (setq di (f0 p1 ml pl)) d1)
	(setq d1 di
	      p	 p1
	)
      )
    )
    (if	(<= d d1)
      (setq s (/ s 2.))
      (setq d d1)
    )
  )
  (princ (strcat "\nTotal times: " (rtos (- (getvar "MilliSecs") t0)) " ms.\n"))
  (list d p)
)
;;--------------Sub Func----------------;;
(defun f0 (p ml pl)
  (apply (function +) (mapcar (function *) ml (mapcar (function (lambda (x) (distance p x))) pl)))
)
(defun mxs (m s) (mapcar (function (lambda (r) (mapcar (function (lambda (n) (* n s))) r))) m))

Thuật toán hay quá. Thanks!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
snowman.hms    30

Thuật toán hay quá. Thanks!

Thank you! This one could be faster with long list:

(defun f2 (p ml pl s / di d1 d n t0 m)
  ;; p : Initial point
  ;; ml: Factor list
  ;; pl: Point list
  ;; s : Initial step distance
  (setq	d  (f0 p ml pl)
	d1 d
	n  0
	m  '((0 1) (1 1) (1 0) (1 -1) (0 -1) (-1 -1) (-1 0) (-1 1))
	t0 (getvar "MilliSecs")
  )
  (while (> s fuz)
    (setq l (mapcar (function (lambda (x) (mapcar (function +) p x))) (mxs m s)))
    (while (and l (>= (setq d1 (f0 (car l) ml pl)) d))
      (setq l (cdr l))
    )
    (if	(and l (> d d1))
      (setq d d1 p (car l))
      (setq s (/ s 2.))
    )
  )
  (princ (strcat "\nTotal times: " (rtos (- (getvar "MilliSecs") t0)) " ms.\n"))
  (list d p)
)
  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Doan Van Ha    2.678

Hình như không thể tạo block anon với attdef có dxf 70 bằng 2?

Diễn giải: tôi muốn tạo block không tên, chứa 3 đối tượng sau:

1 pline

1 attdef ẩn

1 attdef hiện

Khi double click vào block thì sẽ biết được 2 tag của 2 attdef.

Ai biết xin chỉ giùm?

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Thaistreetz    515

Hỏi ngu chút: block anon là block gì vậy ạ? có phải là loại có tên loằng ngoằng kiểu thế này: (2 . "A$C7DF70B66")

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Danh Cong    113

Hỏi ngu chút: block anon là block gì vậy ạ? có phải là loại có tên loằng ngoằng kiểu thế này: (2 . "A$C7DF70B66")

 

Anh #Thaistreetz đọc thử bài này coi thế nào: http://www.draftsperson.net/index.php?title=Anonymous_Blocks_in_AutoCAD

 Và https://knowledge.autodesk.com/support/autocad/troubleshooting/caas/sfdcarticles/sfdcarticles/Anonymous-blocks-explained.html

 

1 ví dụ để xuất hiện block Anonymous như sau:

Anh Purger hết bản vẽ

---> Sau đó tạo ra 1 đường Dimention 1

---> Anh copy nó sang 1 chỗ khác thành Dimention 2.

----> Xóa đường Dimention 2 đi

----> Giờ  anh gõ lại lệnh Purge  sẽ thấy mục Block xuất hiện 1 block dạng *D???. Block này chính là block Anonymous.

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Doan Van Ha    2.678

Mọi người cho hỏi ngu tí:

Tôi có 1 block_att chứa 1 pline và 1 att, đem chèn nó vào điểm A, sau đó move qua điểm B. Làm thế nào để lấy tọa độ các đỉnh pline khi chọn block đã move? Vì khi lấy entget của các đối tượng con của block thì tọa độ pline nó lấy tọa độ lúc chèn (điểm A) chứ không phải tọa độ sau move (điểm 'B). Không nổ block nhé.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
quocmanh04tt    385

Bác thử dùng đoạn code này xem (chú sưu tầm):

 

(defun TranslateObjectToWorld  (objBlock PointInBlock / lstInsertion lstPoint lstPointInWorld sngTheta varReturn)
  (if (not objDocument)
    (setq objDocument (vla-get-activedocument (vlax-get-acad-object))))
  (setq lstInsertion    (vlax-get objBlock "insertionpoint")
        sngTheta        (vla-get-rotation objBlock)
        PointInBlock    (list (* (vla-get-XEffectiveScaleFactor objBlock)
                                 (+ (* (cos sngTheta) (car PointInBlock)) (* -1 (sin sngTheta) (cadr PointInBlock))))
                              (* (vla-get-YEffectiveScaleFactor objBlock)
                                 (+ (* (sin sngTheta) (car PointInBlock)) (* (cos sngTheta) (cadr PointInBlock))))
                              (* (vla-get-ZEffectiveScaleFactor objBlock) (caddr PointInBlock)))
        varReturn       (vla-translateCoordinates
                          (vla-get-utility objDocument)
                          (vlax-3d-point PointInBlock)
                          acOCS
                          acWorld
                          :vlax-false
                          (vla-get-normal objBlock))
        lstPointInWorld (mapcar '+ lstInsertion (vlax-safearray->list (variant-value varReturn)))))

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Bee    108

Mọi người cho hỏi ngu tí:

Tôi có 1 block_att chứa 1 pline và 1 att, đem chèn nó vào điểm A, sau đó move qua điểm B. Làm thế nào để lấy tọa độ các đỉnh pline khi chọn block đã move? Vì khi lấy entget của các đối tượng con của block thì tọa độ pline nó lấy tọa độ lúc chèn (điểm A) chứ không phải tọa độ sau move (điểm 'B). Không nổ block nhé.

Cách khác,

Bác Hạ tham khảo code này của Giles, pline thì bác thay ngon lành qua matrix ^_^

;; Entmatrix
;; Returns a list which first item is the 3X3 tranformation matrix and second item
;; the insertion point of a block refernce in its owner (space or block definition)
(defun EntMatrix (ename / elst ang norm)
  (setq	elst (entget ename)
	ang  (cdr (assoc 50 elst))
	norm (cdr (assoc 210 elst))
  )
  (list
    (mxm
      (mapcar (function (lambda (v) (trans v 0 norm T)))
	      '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
      )
      (mxm
	(list (list (cos ang) (- (sin ang)) 0.0)
	      (list (sin ang) (cos ang) 0.0)
	      '(0.0 0.0 1.0)
	)
	(list (list (cdr (assoc 41 elst)) 0.0 0.0)
	      (list 0.0 (cdr (assoc 42 elst)) 0.0)
	      (list 0.0 0.0 (cdr (assoc 43 elst)))
	)
      )
    )
    (trans (cdr (assoc 10 elst)) norm 0)
  )
)

;; Blk2Coord
;; Returns a list of a block reference entities coordinates
(defun Blk2Coord (ref mat ins / blk ent lst)
  (setq blk (tblsearch "BLOCK" (cdr (assoc 2 (entget ref)))))
  (setq ent (cdr (assoc -2 blk)))
  (while ent
    (setq elst (entget ent)
	  typ  (cdr (assoc 0 elst))
    )
    (cond
      ((= "LINE" typ)
       (setq lst (cons (list typ
			     (mapcar '+ ins (mxv mat (cdr (assoc 10 elst))))
			     (mapcar '+ ins (mxv mat (cdr (assoc 11 elst))))
		       )
		       lst
		 )
       )
      )
      ((member typ '("POINT" "TEXT"))
       (setq lst (cons (list typ
			     (mapcar '+ ins (mxv mat (cdr (assoc 10 elst))))
		       )
		       lst
		 )
       )
      )
      ((= "INSERT" typ)
       (setq nent (EntMatrix ent))
       (setq lst
	      (append
		lst
		(Blk2Coord ent
			   (mxm  mat (car nent))
			   (mapcar '+ ins (mxv mat (cadr nent)))
		)
	      )
       )
      )
      (T nil)
    )
    (setq ent (entnext ent))
  )
  (cons (list (cdr (assoc 2 blk)) ins) lst)
)

;; Transpose a matrix Doug Wilson
(defun trp (m)
  (apply 'mapcar (cons 'list m))
)

;; Apply a transformation matrix to a vector by Vladimir Nesterovsky
(defun mxv (m v)
  (mapcar (function (lambda (r) (apply '+ (mapcar '* r v))))
	  m
  )
)

;; Multiply two matrices by Vladimir Nesterovsky
(defun mxm (m q)
  (mapcar (function (lambda (r) (mxv (trp q) r))) m)
)

;; Main function

(defun c:test (/ ss n ent mtx lst)
  (if (setq ss (ssget '((0 . "INSERT"))))
    (repeat (setq n (sslength ss))
      (setq ent	(ssname ss (setq n (1- n)))
	    mtx	(EntMatrix ent)
	    lst	(append (Blk2Coord ent (car mtx) (cadr mtx)) lst)
      )
    )
  )
  (mapcar 'print lst)
  (textscr)
  (princ)
)
  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
quocmanh04tt    385

Có cái này đơn giản hơn này:

(defun c:tt (/ a b c l)

(cond ((setq a (entsel))

(and (eq (cdr (assoc 0 (entget (car a)))) "INSERT")

(setq b (nentselp (cadr a)))

(eq (cdr (assoc 0 (entget (car B)))) "LWPOLYLINE")

(setq c (entmakex (entget (car B))))

(not (vla-transformby (vlax-ename->vla-object c) (vlax-tmatrix (caddr B))))

(setq l (mapcar 'cdr (vl-remove-if-not '(lambda (x) (eq (car x) 10)) (entget c))))

(entdel c))))

l)

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Bee    108

Có cái này đơn giản hơn này:

(defun c:tt (/ a b c l)

(cond ((setq a (entsel))

(and (eq (cdr (assoc 0 (entget (car a)))) "INSERT")

(setq b (nentselp (cadr a)))

(eq (cdr (assoc 0 (entget (car B)))) "LWPOLYLINE")

(setq c (entmakex (entget (car B))))

(not (vla-transformby (vlax-ename->vla-object c) (vlax-tmatrix (caddr B))))

(setq l (mapcar 'cdr (vl-remove-if-not '(lambda (x) (eq (car x) 10)) (entget c))))

(entdel c))))

l)

:D

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Doan Van Ha    2.678

 

Cách khác,

Bác Hạ tham khảo code này của Giles, pline thì bác thay ngon lành qua matrix ^_^

;; Entmatrix
;; Returns a list which first item is the 3X3 tranformation matrix and second item
;; the insertion point of a block refernce in its owner (space or block definition)
(defun EntMatrix (ename / elst ang norm)
  (setq	elst (entget ename)
	ang  (cdr (assoc 50 elst))
	norm (cdr (assoc 210 elst))
  )
  (list
    (mxm
      (mapcar (function (lambda (v) (trans v 0 norm T)))
	      '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
      )
      (mxm
	(list (list (cos ang) (- (sin ang)) 0.0)
	      (list (sin ang) (cos ang) 0.0)
	      '(0.0 0.0 1.0)
	)
	(list (list (cdr (assoc 41 elst)) 0.0 0.0)
	      (list 0.0 (cdr (assoc 42 elst)) 0.0)
	      (list 0.0 0.0 (cdr (assoc 43 elst)))
	)
      )
    )
    (trans (cdr (assoc 10 elst)) norm 0)
  )
)

;; Blk2Coord
;; Returns a list of a block reference entities coordinates
(defun Blk2Coord (ref mat ins / blk ent lst)
  (setq blk (tblsearch "BLOCK" (cdr (assoc 2 (entget ref)))))
  (setq ent (cdr (assoc -2 blk)))
  (while ent
    (setq elst (entget ent)
	  typ  (cdr (assoc 0 elst))
    )
    (cond
      ((= "LINE" typ)
       (setq lst (cons (list typ
			     (mapcar '+ ins (mxv mat (cdr (assoc 10 elst))))
			     (mapcar '+ ins (mxv mat (cdr (assoc 11 elst))))
		       )
		       lst
		 )
       )
      )
      ((member typ '("POINT" "TEXT"))
       (setq lst (cons (list typ
			     (mapcar '+ ins (mxv mat (cdr (assoc 10 elst))))
		       )
		       lst
		 )
       )
      )
      ((= "INSERT" typ)
       (setq nent (EntMatrix ent))
       (setq lst
	      (append
		lst
		(Blk2Coord ent
			   (mxm  mat (car nent))
			   (mapcar '+ ins (mxv mat (cadr nent)))
		)
	      )
       )
      )
      (T nil)
    )
    (setq ent (entnext ent))
  )
  (cons (list (cdr (assoc 2 blk)) ins) lst)
)

;; Transpose a matrix Doug Wilson
(defun trp (m)
  (apply 'mapcar (cons 'list m))
)

;; Apply a transformation matrix to a vector by Vladimir Nesterovsky
(defun mxv (m v)
  (mapcar (function (lambda (r) (apply '+ (mapcar '* r v))))
	  m
  )
)

;; Multiply two matrices by Vladimir Nesterovsky
(defun mxm (m q)
  (mapcar (function (lambda (r) (mxv (trp q) r))) m)
)

;; Main function

(defun c:test (/ ss n ent mtx lst)
  (if (setq ss (ssget '((0 . "INSERT"))))
    (repeat (setq n (sslength ss))
      (setq ent	(ssname ss (setq n (1- n)))
	    mtx	(EntMatrix ent)
	    lst	(append (Blk2Coord ent (car mtx) (cadr mtx)) lst)
      )
    )
  )
  (mapcar 'print lst)
  (textscr)
  (princ)
)

Dùng cho LWPOLYLINE như thế này mà sao nó chuyển sai Bee nhỉ (Line thì OK):

File test:

http://www.mediafire.com/file/vdcdleyjkxd08gz/Test.dwg

   ((= "LWPOLYLINE" typ)
    (setq lst
     (cons 
 (list 
  typ 
       (mapcar '(lambda(p) (mapcar '+ ins (mxv mat p))) (mapcar 'cdr (vl-remove-if-not '(lambda(x) (eq (car x) 10)) elst))))
      lst)))

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Buggy    2

Xin chào Các cậu các mợ trong diễn đàn Auto Cad...Em có câu hỏi... "Trích lục thửa đất bằng Cad khi lấy file vẽ từ bên ngoài... Có 1 số điểm đỉnh được vẽ bằng HATCH khác với quy phạm bên em. Nên mỗi lần phải đánh lại đỉnh.... CCCM có thể cho em xin cách khắc phục được không ạ."

Em đang học việc trong ngành địa chính nên còn nhiều khúc mắc mong được CCCM và anh chị giải đáp. EM cảm ơn

  • Vote giảm 2

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Bee    108

 

Dùng cho LWPOLYLINE như thế này mà sao nó chuyển sai Bee nhỉ (Line thì OK):

File test:

http://www.mediafire.com/file/vdcdleyjkxd08gz/Test.dwg

   ((= "LWPOLYLINE" typ)
    (setq lst
     (cons 
 (list 
  typ 
       (mapcar '(lambda(p) (mapcar '+ ins (mxv mat p))) (mapcar 'cdr (vl-remove-if-not '(lambda(x) (eq (car x) 10)) elst))))
      lst)))

Hì bác cứ đùa e. LW thì ko có z nên nó hiểu sai mà. :) Thêm cho nó 1 mapcar nữa là chuẩn.

((= "LWPOLYLINE" typ)
       (setq lst
	      (cons
		(list
		  typ
		  (mapcar
		    '(lambda (p) (mapcar '+ ins (mxv mat p)))
		    (mapcar '(lambda (aa) (append aa (list 0.)))
			    (mapcar 'cdr (vl-remove-if-not '(lambda (x) (eq (car x) 10)) elst)
				    )
			    )
		    )
		)
		lst
	      )
       )
      )

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
quocmanh04tt    385

@Bee: Chưa được, bạn thử test trên file của bác Hạ xem...! (Block có LW).

Theo kiểm tra sơ bộ thì thấy rằng:

- 2 Block trong file của bác Hạ có đặc điểm khác nhau: Khi quét chọn (không lệnh) thì Block có LW thấy Grip của Insertionpoint, Block có Line thì không.

- Block có Line (block tên a) luôn đúng, chứ không phải chỉ đúng với Line, thử bằng cách vẽ thêm LW trong Block này.

- Block có Lw luôn sai, thử vẽ thêm Line trong Block này...

- Nổ block có LW, xong block lại =>  cho kết quả đúng.

- Block có Basepoint giống như block a, hoặc Block có basepoint trùng với 0,0,0 trong môi trường BEDIT => cho kết quả đúng.

*** Tóm lại Block có chứa Lw nói trên chưa phù hợp với code, hoặc code chưa giải quyết được các trường hợp.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Bee    108

Uhm, đúng mà không test trên file bác Hạ. 

Và cũng đúng theo ý kiến quocmanh.  :o

 

Bác Hạ soi được lỗi ở đâu chỉ cho e biết với :)

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Doan Van Ha    2.678

Uhm, đúng mà không test trên file bác Hạ. 

Và cũng đúng theo ý kiến quocmanh.  :o

 

Bác Hạ soi được lỗi ở đâu chỉ cho e biết với :)

Cá tính của tôi không bao giờ chơi khăm người khác, trừ khi nó nằm trong mục "đố vui".

Rất cám ơn Bee và Quocmanh04tt, nhưng tôi chịu, dù cả ngày nay cố gắng GG.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay


×