Chuyển đến nội dung
Diễn đàn CADViet

tannguyen291

Thành viên
 Xem Hồ Sơ  Xem hoạt động của họ

  • Số lượng nội dung

    449

  • Đã tham gia

  • Lần ghé thăm cuối

  • Ngày trúng

    43

Bài đăng được đăng bởi tannguyen291

  1. Đã đăng · Trả lời báo cáo

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

    Mã căn đã bán ký hiệu khác với căn chưa bán ngay trên bản vẽ cad rồi ạ, Nếu thế thì dùng lệnh find của cad lọc xong đổi tên lớp là xong, mình đang hiểu là chỉ mới note trên excel giờ muốn đổi tên lớp trên cad (đổi lớp của khu đất bao quanh chứ không phải lớp của text)

    Vãi chấy, bạn không hiểu mình viết gì thật à. :) 

    Biến txt kia là đọc từ file exel.

    sau một hồi xử lý tính toán thì nó thành dạng "BX-01,BX-02,BX-03........"

    chứ không hề khác nhau gì tại bản cad cả.

    từ đó chọn được hết các đối tượng text  là tên mã căn đã bán.

    bạn có danh sách đối tượng rồi thì làm gì tiếp theo đều được.

     

    Còn đề bài là đổi layer hoặc màu của mã căn đó chứ đổi đường boundary làm gì đâu. bạn đọc lại đi kìa.

    mục đích đánh dấu lại các căn đã bán. thuận tiện trong việc kinh doanh thôi.

     

    • Vote giảm 1

  2. Đã đăng · Trả lời báo cáo

    40 phút trước, mdchuyen đã nói:

    PS: Mình đã gửi tin nhắn để xin bản vẽ và file excel khi test không phải đoán để làm mà bạn không hồi trả lời 

    Bạn này đã liên lạc với mình rồi.

    Và bạn nghĩ sao về phương thức này :))

    (setq ss (ssget "ALL" (list  '(0 . "TEXT") (cons 1 txt))))

    (vl-cmdf "laycur" ss "")

    txt là tên mã căn đã bán dạng như thế này "BX-01,BX-02,BX-03........"

    Không cần thao tác nhiều, không cần xóa đối tượng trong bản vẽ.

    Trực tiếp đổi layer đối tượng.

    • Vote giảm 1

  5. Đã đăng · Trả lời báo cáo

    Em cũng gửi 1 hàm mình viết 

    ;bul = t : bulge extend
;bul = nil : tanget extend
(defun PointPerpendicular (ent point bul / para startpt endpt pt0 lstex lst lstpt obj cen )
  (setq
    ent (vlax-ename->vla-object ent)
    pt0 (vlax-curve-getclosestpointto ent point)
    para (vlax-curve-getparamatpoint ent pt0)
    startpt (vlax-curve-getstartpoint ent)
    endpt (vlax-curve-getendpoint ent)
  )
  (setq lstex (vlax-safearray->list (vlax-variant-value (vla-Explode ent))))
  (cond
    ( (equal pt0 startpt 1e-8)
      (setq lst (list (car lstex)))
    )
    ( (equal pt0 endpt 1e-8)
      (setq lst (list (last lstex)))
    )
    ((= para (fix para))
      (setq 
        para (fix para)
        lst (list (nth (1- para) lstex) (nth para lstex))
      )
    )
  )
  (foreach item lst
    (if (eq (vla-get-Objectname item) "AcDbLine")
      (setq 
        obj (vlax-ename->vla-object (makeXline (vlax-curve-getstartpoint item) (vlax-curve-getendpoint item))) 
        lstpt (cons (vlax-curve-getclosestpointto obj point) lstpt)
        obj (vla-delete obj)
      )
      (if bul
        (setq
          obj (entget (vlax-vla-object->ename item))
          obj (vlax-ename->vla-object (entmakex (list '(0 . "CIRCLE") (assoc 10 obj) (assoc 40 obj))))
          lstpt (cons (vlax-curve-getclosestpointto obj point) lstpt)
          obj (vla-delete obj)
        )
        (setq 
          cen (vlax-safearray->list (variant-value (vla-get-Center item)))
          obj (polar pt0 (+ (/ pi 2) (angle cen pt0)) 1)
          obj (vlax-ename->vla-object (makeXline pt0 obj))
          lstpt (cons (vlax-curve-getclosestpointto obj point) lstpt)
          obj (vla-delete obj)
        )
      )
    )
  )
  (if lstpt
    (setq 
      lstpt (vl-sort lstpt '(lambda (a b) (< (distance a point) (distance b point))))
      pt0 (car lstpt)
      lst nil
    )
  )
  (mapcar 'vla-delete lstex)
  pt0
)

(defun makeXline (p1 p2 / p3 )
  (entmakex
    (list '(0 . "XLINE") '(100 . "AcDbEntity") '(100 . "AcDbXline") 
      (cons 10 p1) (cons 11 (mapcar '(lambda (a b) (/ (- a b) (distance p1 p2))) p1 p2)))
  )
)

    và một hàm test  

    (defun c:test (/ cur pt px)
  (setq
    cur (car (entsel "\nSelect Pline"))
    pt (getpoint "\nPick point")
    px (PointPerpendicular cur pt nil) ;extend tanget nil ;extend bulge t
  )
  (entmake (list '(0 . "LINE") (cons 10 pt) (cons 11 px)) )
  (princ)
)

    tuy nhiên sảy ra vấn đề khi dùng phương thức bulge 

    1854123961_Screenshot2023-03-31093256.png.7b64a820fd52ee83f0513e28ebfdb500.png

     

    không sai nhưng nhìn cứ lạ lắm :))

    Nên em cho rằng dùng phương thức tanget extend là tốt nhất.

    471732059_Screenshot2023-03-31093521.png.e65856f05a3ded0a47ca781d5961c48e.png

     

     

    • Like 2

  6. Đã đăng · Trả lời báo cáo

    13 giờ trước, cuongtk2 đã nói:

    Giờ mới thấy nó là GetClosedPointTo chứ không phải là GetPerpendicularTo.

    mình đang cố gắng viết hàm này nhưng kết quả chưa đúng với pline có cung tròn.

      

    vuonggocpline.lsp

    hàm của bác gặp vấn đề rồi

    Select object: ; error: bad argument type: 2D/3D point: nil

     

    image.png.55b66a0096494dfe300e1a1d859ed02a.png

      

    (defun point-perpen-to-circle (pt seg / BULGE CENT D PE PS R X X1 X2 Y Y1 Y2)
  (setq ps (nth 0  seg)
        pe (nth 1 seg)
        bulge (nth 2 seg))
  (setq cent (calcCenPt ps pe bulge)
        r (DISTANCE ps cent)
        d (DISTANCE pt cent)
        ang (angle p1 cent)  ;; <<<<<======= p1 này không biết ở đâu ra
        pv (polar p1 ang (if (> d r)
                           (- d r)
                           (- r d)
                           )
                  )
        )
  
  pv
  )

     

  9. Đã đăng · Trả lời báo cáo

    10 giờ trước, 7o7 đã nói:

    Bác nghĩ ra hàm như vậy cũng rất hay, nhưng tôi thấy xài lệnh SPLINEDIT với precision 10 cũng ra kết quả tương tự.

     Tôi nghĩ bác nên viết cho pline thì hay hơn cho spline.

    Tại em đang viết hàm boundary hatch và hàm convert này là 1 hàm con trong lisp nên không muốn dùng command.

    ngoài ra Lệnh SPLINEDIT không có độ phình (arc bulge) nên đường cong không mượt. 

    image.thumb.png.6437340079fe99c6c3e6aa3393188536.png

    • Like 1

  10. Đã đăng · Trả lời báo cáo

     

    image.thumb.png.cfb8da035f856492c0a9c6903c3f92c6.png

    cảm ơn 2 đại hiệp trợ giúp

    em tạo ra pline cong nên cũng không bị cứng đâu ạ 

    Thân tặng anh em 1 hàm lấy tọa độ và độ phình theo đường cong 2d ạ 

    (defun ObjToLstPointBugle (obj / lenobj space lst i0 i1 i3 i2 i ck1 ck2)
  (setq 
    lenobj (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj))
    space (/ (vla-get-area obj) lenobj 20) i 0)
  (while (< i lenobj)
    (setq i0 (vlax-curve-getpointatdist obj i) ang 0 ck1 t ck2 0 )
    (while (and 
             (< i lenobj)
             (equal ck2 0 0.02)
             ck1
           )
      (setq i (+ i space))
      (if (> i lenobj)
        (setq 
          i2 (vlax-curve-getdistatpoint obj i0)
          i1 (vlax-curve-getpointatdist obj (- i2 1e-4))
          i3 (vlax-curve-getpointatdist obj (+ i2 1e-4))
          i2 (vlax-curve-getendpoint obj)
          ck2 (- (angle i0 i2) (angle i1 i3))
        )
        (setq 
          i1 (vlax-curve-getpointatdist obj (+ i 1e-4))
          i3 (vlax-curve-getpointatdist obj (+ i -1e-4))
          i2 (vlax-curve-getpointatdist obj i)
          ck2 (- (angle i1 i3) (angle i2 i0))
        )
      )
      (setq ck2 (/ (sin ck2) (cos ck2) 2))
      (if (< (* ck2 ang) 0)
        (setq 
          i (- i space )
          ck1 nil
        )
        (setq ang ck2)
      )
    )
    (setq lst (append lst (list (list 10 (car i0) (cadr i0)) (cons 42 ang))))
  )
  (setq i0 (vlax-curve-getendpoint obj))
  (append lst (list (list 10 (car i0) (cadr i0))) )
)

    Đây là hàm test ạ

      

    (defun c:CurveToPlineBugle (/ ss i lst object numvetex)
  (setq ss (ssget '((0 . "ELLIPSE,SPLINE"))))
  (repeat (setq i (sslength ss))
    (setq 
      i (1- i)
      object (vlax-ename->vla-object (ssname ss i))
      lst (ObjToLstPointBugle object)
      numvetex (cons 90 (apply '+ (mapcar '(lambda (x) (if (= 10 (car x)) 1 0)) lst)))
    )
    (vla-delete object)
    (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") numvetex) lst))
  )
  (princ)
)

     

     

    • Like 1
    • Vote tăng 1

  12. Đã đăng · Trả lời báo cáo

    Chào anh em. dạo này em đang viết một chương trình boundary hatch.

    Vì muốn đường boundary là một polyline close nên buộc phải convert elipse, spline thành polyline.

    Có một vấn đề em mắc phải là khi convert thì nhiều điểm thì nặng, ít điểm thì độ chính xác không cao.

    em không muốn dùng command trong lisp

    Các bác gợi ý cho em về một thuật toán giản lược điểm tại các đoạn có độ cong ít với ạ:

    image.thumb.png.e0372ea088885c366d729ea22c53565e.png

     

    xin phép gửi kèm đoạn code đang viết ạ. 

    (defun ObjToLstPointBugle (obj / lenobj space lst i0 i1 i3 i2 i )
  (setq 
    lenobj (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj))
    space (if (< lenobj 25) 0.5 (/ lenobj 50))
    i 0 
  )
  (repeat (1+ (fix (/ lenobj space)))
    (setq i0 (vlax-curve-getpointatdist obj i))
    (cond
      ( (= i 0)
        (setq 
          i1 (vlax-curve-getpointatdist obj (+ i space 1e-4))
          i3 (vlax-curve-getpointatdist obj (+ i space -1e-4))
          i2 (vlax-curve-getpointatdist obj (+ i space))
          ang (- (angle i1 i3) (angle i2 i0))
        )
      )
      ( (> (+ i space) lenobj)
        (setq 
          i1 (vlax-curve-getpointatdist obj (- i 1e-4))
          i3 (vlax-curve-getpointatdist obj (+ i 1e-4))
          i2 (vlax-curve-getendpoint obj)
          ang (-  (angle i0 i2) (angle i1 i3))
        )
      )
      (t 
        (setq 
          i1 (vlax-curve-getpointatdist obj (- i 1e-4))
          i3 (vlax-curve-getpointatdist obj (+ i 1e-4))
          i2 (vlax-curve-getpointatdist obj (+ i space))
          ang (- (angle i0 i2) (angle i1 i3) )
        )
      )
    )
    (setq 
      i (+ i space)
      ang (/ (sin ang) (cos ang) 2)
      lst (append lst (list (list 10 (car i0) (cadr i0)) (cons 42 ang)))
    )
  )
  (vla-delete obj)
  lst
)

     

     

     

  15. Đã đăng · Trả lời báo cáo

    11 giờ trước, cuongtk2 đã nói:

    Thử coi (setq ls ( list 1111))

    (Setq ls (subst 2 (nth 2 ls) ls))

    Vậy ls là (1121) hay là (2222)

    có một hàm acet rất hay cho ví dụ này ạ

    (acet-list-put-nth a lst n)

    a là phần tử mới

    n là vị trí của phần tử trong danh sách. 

    (defun pline-setvetex-at (ent pt n / plst)
  (setq 
    ent (entget ent)
    plst (vl-remove-if-not '(lambda (x) (member (car x) '(10 42))) ent)
    pt (list 10 (car pt) (cadr pt))
    plst (acet-list-put-nth pt plst (* 2 n))
    ent (append (reverse (member (assoc 70 ent) (reverse ent))) plst)
  )
  (entmod ent)
)

     

  17. Đã đăng · Trả lời báo cáo

    4 phút trước, Nguyễn Hà Huy đã nói:

    lisp chạy quá ngon luôn bác, em thử dim cùng chiều kim đồng hồ mà vẫn được bác ạ. Em dùng bao giờ có lỗi phát sinh gì thì bác lại giúp em với nhé <3 cảm ơn bác nhiều

    Mình chỉnh lại lisp 1 chút. bạn lấy lại lisp mới đi.

    • Vote tăng 2

  18. Đã đăng · Trả lời báo cáo

    33 phút trước, Bee đã nói:

    Gì mà cực lisp làm gì. Trong setting có đặt mà.  DIMSTYLE/ Symbols and Arrows/ Arc length symbol/ NONE

    Không phải chỉ đơn giản là tắt cái symbols mà là nhìn hình thức dimarc với dimangular nó khác nhau. nhìn dimangular rất đẹp. nên mình cũng muốn giúp.

    MÌnh viết cho bạn 1 cái lệnh DIM. DLA

    Đầu tiên chọn ARC trước.

    sau đó pick điểm 1 điểm 2 (dim ngược chiều kim đồng hồ nhé)

    pick vị trí chèn text dim

    sau đó các điểm 3 4 5 ... sẽ giống lệnh dimcontinue.

    dùng thử xem oke không. 

    (defun c:DLA (/ asin arc p1 p2 p3 ent modelSpace txt)
  (defun asin (sine) (atan sine (sqrt (- 1 (expt sine 2)))))
  (setq 
    modelSpace (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
    arc (entget (car (entsel "\nSelect Arc")))
    arc (list (cdr (assoc 10 arc)) (cdr (assoc 40 arc)))
    p1 (getpoint "\nStart Dim")
  )
  (while (setq p2 (getpoint p1 "\nDim continue"))
    (if (not p3) (setq p3 (getpoint p2 "\nText Dim")))
    (setq 
      p3 (polar (car arc) (angle (car arc) (mapcar '(lambda (a b) (/ (+ a b) 2)) p1 p2)) (distance p3 (car arc)))
      txt (* (cadr arc) 2 (asin (/ (distance p1 p2) 2 (cadr arc))))
      txt (rtos txt 2 (getvar "DIMDEC"))
      ent (vla-adddim3pointangular modelSpace (vlax-3d-point (car arc)) (vlax-3d-point p1) (vlax-3d-point p2) (vlax-3d-point p3))
      ent (entget (vlax-vla-object->ename ent))
      ent (subst (cons 1 txt ) (assoc 1 ent) ent)
      p1 p2
    )
    (entmod ent)
  )
  (princ)
)

    giphy.gif

    • Vote tăng 1

  21. Đã đăng · Trả lời báo cáo

    Nhìn cái DIMARC cứ xấu xấu k đẹp bằng DIMANGULAR thật.

    LISP đổi dimarc thành dimangular và face giá trị bằng chiều dài cong. 

    (defun c:RAL (/ ss i lst modelSpace txt obj dimsty layer )
  (setq 
    ss (ssget '((0 . "ARC_DIMENSION")))
    doc (vla-get-ActiveDocument (vlax-get-acad-object))
    modelSpace (vla-get-ModelSpace doc)
  )
  (repeat (setq i (sslength ss))
    (setq 
      i (1- i) 
      lst (entget (ssname ss i))
      dimsty (tblobjname "DIMSTYLE" (cdr (assoc 3 lst)))
      layer (cdr (assoc 8 lst))
    )
    (setvar "CLAYER" layer)
    (vla-put-activedimstyle doc (vlax-ename->vla-object dimsty))
    (setq
      txt (rtos (cdr (assoc 42 lst)) 2 (getvar "DIMDEC"))
      lst (list (cdr (assoc 15 lst)) (cdr (assoc 13 lst)) (cdr (assoc 14 lst)) (cdr (assoc 10 lst)))
      lst (cons modelSpace (mapcar 'vlax-3d-point lst))
      obj (entget (vlax-vla-object->ename (apply 'vla-adddim3pointangular lst)))
      obj (subst (cons 1 txt) (assoc 1 obj) obj)
    )
    (entmod obj)
    (entdel (ssname ss i))
  )
  (princ)
)

     

×