Move Blocks về point gần nhất tương ứng.

[amateurday 16]

Chào các bác,

Em muốn nhờ các bác cho em cái code, quét chọn cả vùng, và code tự động move block (insert point) về với point gần nhất của nó.

Em xin cảm ơn.

 

FILE TEST.dwg

Chỉnh sửa Tháng 6 1 theo amateurday
Sửa lại ảnh

[Nguyen Hoanh 4668]

Bạn thử dùng đoạn code này:

(defun c:ChangeTextCoords (/ points texts nPoints nTexts)

  (setq points (ssget "_X" '((0 . "POINT")))) ; Chọn các đối tượng POINT

  (setq texts (ssget "_X" '((0 . "TEXT")))) ; Chọn các đối tượng TEXT

  

  (setq nPoints (sslength points)) ; Số lượng POINT

  (setq nTexts (sslength texts)) ; Số lượng TEXT

 

  (if (/= nPoints nTexts)

    (progn

      (prompt "\nDoi tuong POINT va TEXT khong bang nhau.")

      (exit)

    )

  )

 

  (defun find-nearest-point (text)

    (setq min-dist nil)

    (setq nearest-point nil)

    (foreach point (vl-remove-if 'null (mapcar 'cdr (ssnamex points)))

      (setq dist (distance (cdr (assoc 10 (entget point))) (cdr (assoc 10 (entget text)))))

      (if (or (null min-dist) (< dist min-dist))

        (progn

          (setq min-dist dist)

          (setq nearest-point point)

        )

      )

    )

    nearest-point

  )

 

  (foreach text (vl-remove-if 'null (mapcar 'cdr (ssnamex texts)))

    (setq nearest-point (find-nearest-point text))

    (if nearest-point

      (progn

        (setq point-coord (cdr (assoc 10 (entget nearest-point))))

        (entmod (subst (cons 10 point-coord) (assoc 10 (entget text)) (entget text)))

      )

    )

  )

  (princ)

)

 

(defun c:chgtxtpt ()

  (c:ChangeTextCoords)

)

(princ "\nSu dung lenh 'chgtxtpt' de chay chuong trinh.")

(princ)

 

[amateurday 16]

17 phút trước, Nguyen Hoanh đã nói:

Bạn thử dùng đoạn code này:

 

(defun c:ChangeTextCoords (/ points texts nPoints nTexts)

  (setq points (ssget "_X" '((0 . "POINT")))) ; Chọn các đối tượng POINT

  (setq texts (ssget "_X" '((0 . "TEXT")))) ; Chọn các đối tượng TEXT

  

  (setq nPoints (sslength points)) ; Số lượng POINT

  (setq nTexts (sslength texts)) ; Số lượng TEXT

 

  (if (/= nPoints nTexts)

    (progn

      (prompt "\nDoi tuong POINT va TEXT khong bang nhau.")

      (exit)

    )

  )

 

  (defun find-nearest-point (text)

    (setq min-dist nil)

    (setq nearest-point nil)

    (foreach point (vl-remove-if 'null (mapcar 'cdr (ssnamex points)))

      (setq dist (distance (cdr (assoc 10 (entget point))) (cdr (assoc 10 (entget text)))))

      (if (or (null min-dist) (< dist min-dist))

        (progn

          (setq min-dist dist)

          (setq nearest-point point)

        )

      )

    )

    nearest-point

  )

 

  (foreach text (vl-remove-if 'null (mapcar 'cdr (ssnamex texts)))

    (setq nearest-point (find-nearest-point text))

    (if nearest-point

      (progn

        (setq point-coord (cdr (assoc 10 (entget nearest-point))))

        (entmod (subst (cons 10 point-coord) (assoc 10 (entget text)) (entget text)))

      )

    )

  )

  (princ)

)

 

(defun c:chgtxtpt ()

  (c:ChangeTextCoords)

)

(princ "\nSu dung lenh 'chgtxtpt' de chay chuong trinh.")

(princ)

 

 

Vâng, để em mò sửa cho block xem sao. Hic.

Cảm ơn bác ạ.

[limfx 32]

Hy vọng đáp ứng nhu cầu của bạn lệnh MPP

Block move to Point (MPP).lsp

[amateurday 16]

8 giờ trước, limfx đã nói:

Hy vọng đáp ứng nhu cầu của bạn lệnh MPP

Block move to Point (MPP).lsp

Cảm ơn bạn nhé, quá chuẩn luôn bạn ạ.