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

Tháng 12 12, 2016

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ý.

Tháng 12 13, 2016

...........

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/

Tháng 1 4, 2017

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))

Tháng 1 4, 2017

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á.

Tháng 1 4, 2017

;|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!

Tháng 1 5, 2017

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)
)

Tháng 1 21, 2017

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?

Tháng 2 3, 2017

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")

Tháng 2 3, 2017

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.

Tháng 3 1, 2017

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é.

Tháng 3 1, 2017

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)))))

Tháng 3 1, 2017

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)
)

Tháng 3 1, 2017

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)

Tháng 3 2, 2017

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

Tháng 3 4, 2017

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)))

Tháng 3 4, 2017

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

Tháng 3 4, 2017

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
	      )
       )
      )

Tháng 3 4, 2017

@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.

Tháng 3 4, 2017

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 :)

Tháng 3 4, 2017

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.

Tháng 3 5, 2017

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.

Cái này như quocmanh nói là gốc tọa độ block gốc là không trùng với 0. nên lisp tính toán sai. Em ít khi bị dính trường hợp này nên ko để ý. Mà có khi e còn không biết tạo cái block khác gốc tọa độ này ntn. ^_^

Cách sửa nếu chui vào BEDIT thì tất cả block đã chèn sẽ bị nhẩy sai hết. Vì vậy chỉ có cách là nổ block cũ và tạo 1 block mới với tọa độ chuẩn 0.. Sau đó thì lisp mới chèn ngược lại các block đã có trong bản vẽ. Đó là cách đơn giản nhất mà e nghĩ được.

Hi vọng ngóng được cách thay đổi tọa độ gốc trong block qua lisp của mọi người mà ko phải làm cách trên.

^_^

Tháng 3 5, 2017

@Bác Hạ: Thử dùng code này xem có được không??? (Dùng biện pháp nổ).

(defun c:tt (/ ble bln els i lst ss typ)

(if (setq ss (ssget '((0 . "INSERT"))))

(progn (repeat (setq i (sslength ss))

(setq ble (ssname ss (setq i (1- i)))

bln (cdr (assoc 2 (entget ble)))

lst nil)

(foreach e (mapcar 'vlax-vla-object->ename

(vlax-safearray->list (vlax-variant-value (vla-Explode (vlax-ename->vla-object ble)))))

(setq els (entget e)

typ (cdr (assoc 0 els)))

(cond ((= "LINE" typ)

(setq lst (cons (list typ (cdr (assoc 10 els)) (cdr (assoc 11 els))) lst)))

((= "LWPOLYLINE" typ)

(setq lst (cons (list typ (mapcar 'cdr (vl-remove-if-not '(lambda (x) (eq (car x) 10)) els))) lst)))

((member typ '("POINT" "TEXT")) (setq lst (cons (list typ (cdr (assoc 10 els))) lst))))

(entdel e))

(mapcar 'print (cons bln lst)))

(textscr)))

(princ))

Tháng 3 6, 2017

Cám ơn chú. Bác đã chọn giải pháp nổ này từ hôm qua rồi, mặc dầu cái bụng không ưa tí nào, vì cảm thấy bất lực trước một vấn đề không quá khó (?).

Tháng 3 6, 2017

Nếu cái bụng của bác ưa code của Giles ở trên thì sửa hàm Blk2Coord như sau:

Thêm: (setq bsp (cdr (assoc 10 (entget (tblobjname "BLOCK" (cdr (assoc 2 (entget ref))))))))

*** Line sửa:

((= "LINE" typ)
           (setq lst (cons (list typ
                                 (mapcar '+ ins (mxv mat (mapcar '(lambda (x y)(- x y)) (cdr (assoc 10 elst)) bsp)))
                                 (mapcar '+ ins (mxv mat (mapcar '(lambda (x y)(- x y)) (cdr (assoc 11 elst)) bsp))))
                           lst)))

*** LW:

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

Tháng 3 6, 2017

Các bác cũng cho em hỏi ngu tí ạ: Em muốn thay đổi giá trị hệ "Mét" hay "Milimeter" trong thiết lập Units thì biến hệ thống của nó là gì ạ . Em ko mò mẫm ko ra...

Đăng nhập

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

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

Thaistreetz 539

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.549

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 59

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 272

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 3.191

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 59

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 3.191

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 539

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 422

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 3.191

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 634

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 154

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 634

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 154

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 3.191

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

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 154

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 634

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 154

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 3.191