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

taipham

Thành viên
  • Số lượng nội dung

    57
  • Đã tham gia

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

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


  1. Cẩn tắc khi đặt Block vào điểm G, hậu họa khôn lường! :D

    Haha, em mò trúng điểm G rồi, chạy ngon lành, sử dụng ssname lấy đường đầu và đường cuối là xong. Cảm ơn anh đã nhiệt tình giúp đỡ nhé! 

    Hẹn gặp anh và diễn đàn ở điểm G tiếp theo. Haha!!!!! Thanks a lot!!!!!


  2. Test thử nhé!

    (defun c:tt (/ setdynblk_propvalue getangle_pl ang blk ent lfilter laylist ss)

    (defun setdynblk_propvalue (blk prp val / vtw ang val prp)

    (vla-put-rotation blk 0)

    (setq prp (strcase prp))

    (vl-some '(lambda (x)

    (if (= prp (strcase (vla-get-propertyname x)))

    (progn (vla-put-value x (vlax-make-variant val (vlax-variant-type (vla-get-value x))))

    (cond (val)

    (t)))))

    (vlax-invoke blk 'getdynamicblockproperties))

    (setq val (rem val (* 2 pi))

    vtw (rem (getvar "viewtwist") (* 2 pi))

    ang (rem (+ val vtw) (* 2 pi)))

    (cond ((< (* 0.5 pi) ang (* 1.5 pi)) (setq val (+ val pi))))

    (mapcar '(lambda (a) (vla-put-rotation a val)) (vlax-invoke blk 'getAttributes)))

    ;;-----------------------------------------

    (defun getangle_pl (ent / el p1 p2 ang pl)

    (setq el (entget ent)

    p1 (cdr (assoc 10 el))

    p2 (cdr (assoc 10 (reverse el)))

    ang (+ (angle p2 p1) (* 0.5 pi)))

    (cond ((and (> ang (* 0.5 pi)) (< ang (* 1.5 pi))) (setq ang (+ ang pi)))

    ((equal ang (* 1.5 pi) 1e-6) (setq ang (* 0.5 pi))))

    ang)

    ;; Main

    (setq laylist '("00-VT" "00-D195" "00-D130 TT" "00-D130 HT" "00-D65 MD")

    laylist (mapcar '(lambda (x) (strcase x)) laylist))

    (setq lfilter (apply 'strcat (mapcar '(lambda (x) (strcat x ",")) laylist)))

    (while (setq ss (ssget (list (cons 0 "LWPOLYLINE")(cons 8 lfilter))))

    (setq ent (car (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))

    ang (getangle_pl ent))

    (while (and (setq blk (car (entsel "\nPick Block: "))) (eq (cdr (assoc 66 (entget blk))) 1))

    (setdynblk_propvalue (vlax-ename->vla-object blk) "Angle1" ang)))

    (princ))

    Điểm G nằm ở chỗ này:

    (setq val (rem val (* 2 pi))

            vtw (rem (getvar "viewtwist") (* 2 pi))

            ang (rem (+ val vtw) (* 2 pi)))

      (cond ((< (* 0.5 pi) ang (* 1.5 pi)) (setq val (+ val pi))))

    Phải gọi là quá đỉnh quá đỉnh, haha! anh là chuyên gia tìm điểm G, cảm ơn anh rất nhiều (thật tuyệt vời). Em đang tiếp tục mò điểm G (lấy giao điểm để đặt block)

    Để lấy khoảng cách max min phải dùng hàm foreach kết hợp với repeat để tạo ra 1 cái list, rồi mới so từng điểm trong list này phải không anh.


  3. Đây anh, em đã làm được 3 góc phần tư rồi, còn lại góc twist từ pi đến 3pi/2 thì đang mò, hehe

    http://www.cadviet.com/upfiles/6/146422_twist.dwg

    Anh xem giúp em chỗ hàm cond (1 2 3 4), chỗ 1, 2, 4 thì oke, còn chỗ 3 thì không biết sai chỗ nào mà nó không lật text được.

    (defun c:TTY ()
      (command "undo" "be")
      (setq osm (getvar "osmode")
    	lts (getvar "ltscale"))
      (command ".ltscale" 1000)
      (setvar "cmdecho" 0)	
      (setvar "osmode" 0)
      (while
        (setq p1 (getpoint "1"))
        (setq p2 (getpoint p1 "2"))
    
        (if (null (setq d195 (ssget "F" (list p1 p2) (list (cons 8 "00-D195")))))
          (progn (setq d195 0) (setq scada 0))
          (progn (setq d195 (sslength d195)) (setq scada 1)))
    
        (if (null (setq d130tt (ssget "F" (list p1 p2) (list (cons 8 "00-D130 TT")))))
          (setq d130tt 0)
          (setq d130tt (sslength d130tt)))
    
        (if (null (setq d130ht (ssget "F" (list p1 p2) (list (cons 8 "00-D130 HT")))))
          (setq d130ht 0)
          (setq d130ht (sslength d130ht)))
    
        (if (null (setq d65md (ssget "F" (list p1 p2) (list (cons 8 "00-D65 MD")))))
          (setq d65md "0")
          (setq d65md "n"))
    
        (if (null (setq vt (ssget "F" (list p1 p2) (list (cons 8 "00-VT")))))
          (setq vt "")
          (setq vt "v"))
    
        (setq tmc (strcat vt (itoa d195) (itoa d130tt) (itoa scada) (itoa d130ht) d65md))
        (and
          (/= tmc "00000")
          (/= tmc "v00000")
          (while
    	(setq tenblock (car (entsel "\nChon block sua: ")))
    	(progn
    	(setq tenatt (entnext tenblock))
    	(setq hamcon (entget tenatt))
    	(setq hamcon (subst (cons 1 tmc) (assoc 1 hamcon) hamcon))
    
    	(setq view (getvar "viewtwist"))
    	(setq gatt (cdr (assoc 50 hamcon)))
    	(repeat (fix (/ gatt (* pi 2)))
    	  (setq gatt (- gatt (* pi 2))))
    
    ;xem chỗ này giúp em, từ đây	
            (cond 
    	  (;mo 1
    	  (and
    	    (>= view 0.0)
    	    (< view (/ pi 2))
    	    (>= gatt (- (/ pi 2) view))
    	    (< gatt (- (/ (* 3 pi) 2) view))
    	    (setq gatt gatt))
    	   (setq gatt (+ gatt pi))
    	   );dong 1
    	  
    	  (;mo 2
    	  (and
    	    (>= view (/ pi 2))
    	    (< view pi)
    	    (>= gatt (- 0 (- view (/ pi 2))))
    	    (< gatt (- pi (- view (/ pi 2))))
    	    (setq gatt gatt))
    	   (setq gatt (+ gatt pi))
    	   );dong 2
    
    	  (;mo 3
    	   (and
    	     (>= view pi)
    	     (< view (/ (* 3 pi) 2))
    	     (>= gatt (- (/ (* 3 pi) 2) (- view pi)))
    	     (< gatt (- (/ pi 2) (- view pi)))
    	     (setq gatt gatt))
    	   (setq gatt (+ gatt pi))	 
    	   );dong 3
    
    	  (;mo 4
    	  (and
    	    (>= view (/ (* 3 pi) 2))
    	    (< view (* pi 2))
    	    (>= gatt (+ (/ pi 2) (- (* pi 2) view)))
    	    (< gatt (+ (/ (* 3 pi) 2) (- (* pi 2) view)))
    	    (setq gatt gatt))
    	   (setq gatt (+ gatt pi))
    	   );dong 4
    
    	  );dong cond
    ; đến đây
    
    	(setq hamcon (subst (cons 50 gatt) (assoc 50 hamcon) hamcon))	
    	(entmod hamcon)
    	(entupd tenblock)
    	))
          (mapcar 'set '(vt d195 d130tt d130ht d65md scada p1 p2) '(nil nil nil nil nil nil nil nil))
          );and
        );while
      (setvar "osmode" osm)
      (setvar "cmdecho" 1)
      (command ".ltscale" lts)
      (command "undo" "e")
      (princ)
      )
    

  4. Mình sửa phần xoay, còn phần gán Tagstring bạn tự làm nhé!

    (defun c:TTY (/ ang d130ht d130tt d195 d65md gatt hamcon lts osm p1 p2 scada tenatt tenblock tmc view vt)

    (command "undo" "be")

    (setq osm (getvar "osmode")

    lts (getvar "ltscale"))

    (command ".ltscale" 1000)

    (setvar "cmdecho" 0)

    (setvar "osmode" 0)

    (while (setq p1 (getpoint "1"))

    (setq p2 (getpoint p1 "2"))

    ;;----------------------Sua khoi nay------------------------

    ((lambda (/ getangle_pl)

    (defun getangle_pl (ss / el p1 p2 ang pl)

    (setq pl (ssname ss 0))

    (setq el (entget pl)

    p1 (cdr (assoc 10 el))

    p2 (cdr (assoc 10 (reverse el)))

    ang (+ (angle p2 p1) (* 0.5 pi)))

    (if (and (> ang (* 0.5 pi)) (<= ang (* 1.5 pi)))

    (+ ang pi))

    ang)

    (if (null (setq d195 (ssget "F" (list p1 p2) (list (cons 8 "00-D195")))))

    (progn (setq d195 0) (setq scada 0))

    (progn (setq ang (getangle_pl d195)) (setq d195 (sslength d195)) (setq scada 1)))

    (if (null (setq d130tt (ssget "F" (list p1 p2) (list (cons 8 "00-D130 TT")))))

    (setq d130tt 0)

    (progn (setq ang (getangle_pl d130tt)) (setq d130tt (sslength d130tt))))

    (if (null (setq d130ht (ssget "F" (list p1 p2) (list (cons 8 "00-D130 HT")))))

    (setq d130ht 0)

    (progn (setq ang (getangle_pl d130ht)) (setq d130ht (sslength d130ht))))

    (if (null (setq d65md (ssget "F" (list p1 p2) (list (cons 8 "00-D65 MD")))))

    (setq d65md "0")

    (progn (setq ang (getangle_pl d65md)) (setq d65md "n")))

    (if (null (setq vt (ssget "F" (list p1 p2) (list (cons 8 "00-VT")))))

    (setq vt "")

    (progn (setq ang (getangle_pl vt)) (setq vt "v")))))

    ;;----------------------------------------------------------

    (setq tmc (strcat vt (itoa d195) (itoa d130tt) (itoa scada) (itoa d130ht) d65md))

    (and (/= tmc "00000")

    (/= tmc "v00000")

    (while (setq tenblock (car (entsel "\nChon block sua: ")))

    (progn (setq tenatt (entnext tenblock))

    (setq hamcon (entget tenatt))

    (setq hamcon (subst (cons 1 tmc) (assoc 1 hamcon) hamcon))

    (setq view (getvar "viewtwist"))

    (setq gatt (cdr (assoc 50 hamcon)))

    (and ang (setdyn_propvalue (vlax-ename->vla-object tenblock) "Angle1" ang)); Them dong nay

    ))

    (mapcar 'set '(vt d195 d130tt d130ht d65md scada p1 p2) '(nil nil nil nil nil nil nil nil))))

    (setvar "osmode" osm)

    (setvar "cmdecho" 1)

    (command ".ltscale" lts)

    (command "undo" "e")

    (princ))

    ;; Ham dieu khien Block

    (defun setdyn_propvalue (blk prp val / FixTextAngle)

    (defun FixTextAngle (ang)

    (if (and (> ang (* 0.5 pi)) (<= ang (* 1.5 pi)))

    (+ ang pi)

    ang))

    (vla-put-rotation blk 0)

    (setq prp (strcase prp))

    (vl-some '(lambda (x)

    (if (= prp (strcase (vla-get-propertyname x)))

    (progn (vla-put-value x (vlax-make-variant val (vlax-variant-type (vla-get-value x))))

    (cond (val)

    (t)))))

    (vlax-invoke blk 'getdynamicblockproperties))

    (mapcar '(lambda (a) (vla-put-rotation a (FixTextAngle val))) (vlax-invoke blk 'getAttributes)))

    Không phải anh ơi, ý em là khi góc viewtwist là bất kỳ, quét chọn các đường thẳng xong, click vào block để sửa tên ATT trong block đó (vẫn giữ nguyên vị trí block) chỉ xoay text ATT cho đúng với hướng nhìn (xoay thêm 1 góc pi khi text bị ngược, còn nếu không ngược thì text vẫn giữ nguyên góc xoay). Do khi vẽ trên mặt bằng em hay xoay màn hình để dễ nhìn. Mong anh mò trúng điểm G này.hehe


  5. Do chưa đúng điểm "G" nên mò đêm, mò ngày không ra, chứ gặp điểm "G" thì nó sẽ ra ào ào...! :D

    Anh giúp em cái này với, mò hoài mấy bữa nay mà không ra.

    - Em muốn khi quét chọn các đường xong, click vào block thì text att trong block luôn hướng lên cho dù xoay màn hình bất cứ góc nào (viewtwist), theo chiều như bản vẽ đính kèm. Anh sửa trực tiếp vào code này nhé (ở đoạn giữa). Cảm ơn anh!

    http://www.cadviet.com/upfiles/6/146422_nho_sua_lisp_1.dwg

    (defun c:TTY ()
      (command "undo" "be")
      (setq osm (getvar "osmode")
    	lts (getvar "ltscale"))
      (command ".ltscale" 1000)
      (setvar "cmdecho" 0)	
      (setvar "osmode" 0)
      (while
        (setq p1 (getpoint "1"))
        (setq p2 (getpoint p1 "2"))
    
        (if (null (setq d195 (ssget "F" (list p1 p2) (list (cons 8 "00-D195")))))
          (progn (setq d195 0) (setq scada 0))
          (progn (setq d195 (sslength d195)) (setq scada 1)))
    
        (if (null (setq d130tt (ssget "F" (list p1 p2) (list (cons 8 "00-D130 TT")))))
          (setq d130tt 0)
          (setq d130tt (sslength d130tt)))
    
        (if (null (setq d130ht (ssget "F" (list p1 p2) (list (cons 8 "00-D130 HT")))))
          (setq d130ht 0)
          (setq d130ht (sslength d130ht)))
    
        (if (null (setq d65md (ssget "F" (list p1 p2) (list (cons 8 "00-D65 MD")))))
          (setq d65md "0")
          (setq d65md "n"))
    
        (if (null (setq vt (ssget "F" (list p1 p2) (list (cons 8 "00-VT")))))
          (setq vt "")
          (setq vt "v"))
    
        (setq tmc (strcat vt (itoa d195) (itoa d130tt) (itoa scada) (itoa d130ht) d65md))
        (and
          (/= tmc "00000")
          (/= tmc "v00000")
          (while
    	(setq tenblock (car (entsel "\nChon block sua: ")))
    	(progn
    	(setq tenatt (entnext tenblock))
    	(setq hamcon (entget tenatt))
    	(setq hamcon (subst (cons 1 tmc) (assoc 1 hamcon) hamcon))
    
    	(setq view (getvar "viewtwist"))
    	(setq gatt (cdr (assoc 50 hamcon)))
    	(repeat (fix (/ gatt (* pi 2)))
    	  (setq gatt (- gatt (* pi 2))))
    	(cond
    	  (;mo 1
    	  (and
    	    (>= view 0.0)
    	    (< view (/ pi 2))
    	    (>= gatt (- (/ pi 2) view))
    	    (< gatt (- (/ (* 3 pi) 2) view))
    	    (setq gatt gatt))
    	   (setq gatt (+ gatt pi))
    	   );dong 1
    	  
    	  (;mo 4
    	  (and
    	    (>= view (/ (* 3 pi) 2))
    	    (< view (* pi 2))
    	    (>= gatt (+ (/ pi 2) (- (* pi 2) view)))
    	    (< gatt (+ (/ (* 3 pi) 2) (- (* pi 2) view)))
    	    (setq gatt gatt))
    	   (setq gatt (+ gatt pi))
    	   );dong 4
    
    	  ;(;mo 2
    	  ;(and
    	    ;(>= view (/ pi 2))
    	    ;(< view pi)
    	    ;(>= gatt (- (* 2 pi) (- view (/ pi 2))))
    	    ;(< gatt (- pi (- view (/ pi 2))))
    	    ;(setq gatt gatt))
    	   ;(setq gatt (+ gatt pi))
    	   ;);dong 2
    
    	  ;(;mo 3
    	   ;(and
    	     ;(>= view pi)
    	     ;(< view (/ (* 3 pi) 2))
    	     ;(>= gatt pi)
    	     ;(< gatt 0)
    	     ;(setq gatt gatt))
    	   ;(setq gatt (+ gatt pi))	 
    	   ;);dong 3	  
    
    	  );dong cond
    	(setq hamcon (subst (cons 50 gatt) (assoc 50 hamcon) hamcon))	
    	(entmod hamcon)
    	(entupd tenblock)
    	))
          (mapcar 'set '(vt d195 d130tt d130ht d65md scada p1 p2) '(nil nil nil nil nil nil nil nil))
          );and
        );while
      (setvar "osmode" osm)
      (setvar "cmdecho" 1)
      (command ".ltscale" lts)
      (command "undo" "e")
      (princ)
      )
    

  6. 1- Gạch thứ nhất:

    + Có link tham khảo ở trên (thử test lisp ở link đó Text ở gần Segment nào của Pline thì nó xoay theo góc của seg đó).

    + Tìm giao điểm:

    (vlax-invoke (vlax-ename->vla-object ent1) 'IntersectWith (vlax-ename->vla-object ent2) acExtendThisEntity)

    * Trong đó: ent1, ent2 là ename

    acExtendNone => Does not extend either object.

    acExtendThisEntity => Extends the base object.

    acExtendOtherEntity => Extends the object passed as an argument.

    acExtendBoth => Extends both objects.

     

    2- "Obj_Block" là Vla-object, từ ename chuyển sang vla-object:

    (setq ent (car (entsel)))

    (setq Obj_Block (vlax-ename->vla-object ent))

    Cảm ơn anh nhiều nha, không có dấu " " nó mới chạy, em gà quá mò mấy đêm không ra, sáng mai mò tiếp, có gì nhờ anh trợ giúp. hehe! Thanks a lot!


  7. 1. Xác định điểm giữa của nhóm đường quét chọn (Sau khi có điểm nhập vào do lisp yêu cầu):

    - Từ điểm nhập vào kẻ 1 đường (Line, Pline, Xline tùy ý) vuông góc với 1 trong các đường quét chọn (tham khảo: http://www.cadviet.com/forum/topic/69045-nho-chinh-sua-lisp-xoay-text-theo-pline/page-2

    để tìm góc).

    - Xác định giao điểm của đường vừa vẽ với các đường quét chọn.

    - Sort các điểm giao (so sánh khoảng cách các điểm giao với điểm nhập vào) -> Tìm được điểm xa nhất, gần nhất so với điểm nhập vào -> Trung điểm của 2 điểm xa nhất và gần nhất.

    Như vậy ta có các điểm: điểm nhập vào, điểm xa nhất, gần nhất và điểm giữa, sử dụng thế nào điều đó tùy thuộc ở bạn.

    2. Kéo dài được block động (stretch đuôi block trước khi insert) => Sau khi insert mới kéo dài.

    - Ctrl+1 chọn DynBlock thì thấy distance1 đó là biến kéo dài (hoặc các prop khác Flip, angle...), dùng hàm con sau để điều khiển nó:

    (defun setdyn_propvalue  (blk prp val)

      (setq prp (strcase prp))

      (vl-some '(lambda (x)

                 (if (= prp (strcase (vla-get-propertyname x)))

                  (progn (vla-put-value x (vlax-make-variant val (vlax-variant-type (vla-get-value x))))

                         (cond (val)

                               (t)))))

               (vlax-invoke blk 'getdynamicblockproperties)))

    Vd: (setdyn_propvalue "Obj_Block" "distance1" 100)

    3. Chúc thành công...!

    Cảm ơn anh nhiều nhé, cho em hỏi thêm:

    - Nếu là đường Pline có nhiều đỉnh thì làm sao để lấy được tọa độ 2 đỉnh gần nhất ở vùng chọn để tìm điểm giao (lisp bị lỗi).

    - Cái "Obj_Block" là cái gì, lấy ở đâu vậy anh.


  8. Bạn hỏi cụ thể hơn đi chứ!

    (insert Block thì cần 3 tham số chính: Point, Scale, Angle).

    Ý em là làm thế nào để:

    - Lấy tọa độ điểm (đầu block) nằm giữa các đường thẳng và lấy góc block vuông với các đường thẳng đó.

    - Kéo dài được block động (stretch đuôi block trước khi insert) tùy ý.

    Em tìm kiếm hoài mà không thấy có hướng dẫn điều khiển lock động bằng code cả, tìm kiếm trong mã tên block cũng không thấy các điểm này để thay đổi. Mong anh chỉ giáo thêm.


  9. Thử cái này trên file ở bài #1 phát (lệnh TT): http://www.cadviet.com/upfiles/6/141736_t_t.rar

    P/s: Quét chọn các Pline, chọn điểm đặt Block, Block luôn vuông góc với các Pline, giảm bớt thao tác (còn lại 2 thao tác).

    Cảm ơn anh, Lisp hay quá, do còn một số chỗ vẫn chưa vừa ý, anh cho em xin file .lsp để em chỉnh sửa và học hỏi thêm nhé!


  10. Thử copy đừng download, kiểm tra so sánh lsp copy về với lsp ở trên bài.

    =>>> Nếu như bác ndtnv nói là quét theo vùng, chứ đâu phải chọn từng cái.

    Mình cứ nghĩ là bạn dùng p1, p2 để làm việc gì đó về sau nữa.

    Oke, được rồi anh, em sử dụng p1, p2 để cho trường hợp insert block vào ấy anh!

    Cảm ơn anh nhiều nhé, để em mò trường hợp insert block, nếu không được thì lên nhờ anh chỉ giáo thêm!


  11. Vì sao phải dùng cách không an toàn, dễ chọn thiếu khi các đối tượng là nét đứt

    (ssget "F" (list p1 p2) ...)

     mà không dùng trực tiếp, có thể kiểm soát

    (ssget  (list (cons 8 "L1,L2,L3,L4,L5")))

    dùng như thế chọn từng cái lâu lắm anh, với lại mỗi lần em quét qua như thế để lấy tên tại vị trí quét thôi!


  12. 1. Có lúc trả về "00000" là do mấy đường kia là nét đứt, LTSCALE đủ để hở nên khi ssget "F" qua khoảng hở nó sẽ null.

     + Có thể giải quyết: Hoặc set biến LTSCALE trong lisp thật khủng rồi regen (cuối lisp "trả lại tên cho em"), hoặc nhập từ bàn phím trước lúc chạy lsp.

    2. Dựa theo ý của bạn, viết lại theo cách khác gọn hơn.

    (defun c:tt (/ a1 ent l1 l2 l3 l4 l5 lay lst p1 p2 ss temp tmc)

    (setq temp T)

    (while (and temp

    (setq p1 (getpoint "\nPoint 1: "))

    (setq p2 (getpoint "\nPoint 2: " p1))

    (mapcar 'set '(L1 L2 L3 L4 L5 a1) '("" "" "" "0" "" "0")))

    (if (setq ss (ssget "F" (list p1 p2) (list (cons 8 "L1,L2,L3,L4,L5"))))

    (progn (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))

    (setq lay (cdr (assoc 8 (entget x))))

    (if (not (assoc lay lst))

    (setq lst (cons (cons lay 1) lst))

    (setq lst (subst (cons lay (1+ (cdr (assoc lay lst)))) (assoc lay lst) lst))))

    (and (assoc "L1" lst) (setq L1 "v"))

    (and (assoc "L4" lst) (setq L4 "n"))

    (and (assoc "L2" lst) (setq L2 (itoa (cdr (assoc "L2" lst)))))

    (and (assoc "L3" lst) (setq L3 (itoa (cdr (assoc "L3" lst)))) (setq a1 "1"))

    (and (assoc "L5" lst) (setq L5 (itoa (cdr (assoc "L5" lst)))))

    (setq tmc (strcat L1 L2 L5 a1 l3 L4))

    (and (setq ent (car (nentsel "\nPick Att: ")))

    (wcmatch (cdr (assoc 0 (entget ent))) "ATTRIB")

    (vla-put-textstring (vlax-ename->vla-object ent) tmc))))

    (setq lst nil))

    (princ))

    Lisp chạy không được anh ơi, lisp chỉ chạy chọn p1 p2 chứ không chạy hết.

    Nhờ anh sửa giúp em nhé!

    Nhân tiện nhờ anh thêm phần Insert block att vào đoạn code trên khi không "Pich Att" mà pick ra màn hình:

     
      (setq goc (- (/ (* 180 (angle p1 p2)) pi) 180)
               dd (getpoint p2 "\nDiem dat block: "))
      (command "_insert" "D:\\Block\\00- TENMC.dwg" dd "" "" goc)
      (command "_.Explode" "l")
     
    Và để biết ý nghĩa của các hàm như (vla-put-textstring...) thì xem ở tài liệu nào!
    Cảm ơn anh!

  13. Sao em gửi mà không thấy đoạn Code Lisp, em gửi lại:

    (defun c:TTT ()
      (command "undo" "be")
      (setq osm (getvar "osmode"))
      (setvar "cmdecho" 0)	
      (setvar "osmode" 0)	
      (while
      (setq p1 (getpoint "1"))
      (setq	p2 (getpoint p1 "2"))
    
      (if (null (setq L1 (ssget "F" (list p1 p2) (list (cons 8 "L1")))))
          (setq L1 "")
          (setq L1 "v"))
    
      (if (null (setq L2 (ssget "F" (list p1 p2) (list (cons 8 "L2")))))
        (progn (setq L2 0) (setq a1 0))
        (progn (setq L2 (sslength L2)) (setq a1 1)))
      
      (if (null (setq L5 (ssget "F" (list p1 p2) (list (cons 8 "L5")))))
        (setq L5 0)
        (setq L5 (sslength L5)))
    
      (if (null (setq L3 (ssget "F" (list p1 p2) (list (cons 8 "L3")))))
        (setq L3 0)
        (setq L3 (sslength L3)))
      
      (if (null (setq L4 (ssget "F" (list p1 p2) (list (cons 8 "L4")))))
        (setq L4 "0")
        (setq L4 "n"))
    
      (setq tmc (strcat L1 (itoa L2) (itoa L5) (itoa a1) (itoa L3) L4))
      (setq att (cdr (car (entget (entnext (car (entsel "")))))))
      (setq TagName (dxf 2 att)
    	TagVal (dxf 1 att)
    	BlName (dxf 330 att))
         (if (setq NewVal tmc)
    	(putAtt BlName TagName NewVal))
    
      (setq	L1 nil)
      (setq	L2 nil)
      (setq	L5 nil)
      (setq	L3 nil)
      (setq	L4 nil)
      (setq a1 nil)
      (setq p1 nil)
      (setq p2 nil)
      (setvar "osmode" osm)
      (setvar "cmdecho" 1)
      (command "undo" "e")
      (princ)
      ))
    
    ;------------------------------------------------------------------------------------------
    (defun dxf(id ent) (cdr (assoc id (entget ent))))
    ;------------------------------------------------------------------------------------------
    (defun putAtt (BlName TagName NewVal / AttName EntDxf dk)
    (setq AttName (entnext BlName ) dk 1)
      (while (and AttName dk)
        (if (equal (assoc 0 (entget AttName )) '(0 . "SEQEND"))
            (setq AttName nil )
            (if (= (cdr (assoc 2 (entget AttName ))) TagName )
                (progn
                  (setq EntDxf (entget AttName ) dk nil)
                  (setq EntDxf (subst (cons 1 NewVal ) (assoc 1 (entget AttName )) EntDxf ) )
                  (entmod EntDxf )
                  (entupd BlName )
                  (setq AttName (entnext AttName ))
                )
            (setq AttName (entnext AttName ))
            )
        )
      )
    )
    
    

  14. Do còn gà nên nhờ anh chị sửa giúp lỗi Lisp sau:

    Lisp chạy sai khi:

    - Chọn điểm 1 điểm 2 là góc nghiêng

    - Chọn nhiều lần điểm 1 điểm 2 qua các đường thẳng nhất định

    - Có lúc lisp trả về "00000"

    Nhờ anh chị sửa giúp lỗi trên và tạo thêm vòng lặp là khi điểm 1 điểm 2 không cắt qua đường thẳng nào (00000) và nếu cắt thì sau khi gán vào Blockatt Lisp sẽ tiếp tục chọn điểm 1 điểm 2. Xin cảm ơn!

    
    
    (defun c:TTT ()
      (command "undo" "be")
      (setq osm (getvar "osmode"))
      (setvar "cmdecho" 0)
      (setvar "osmode" 0)
      (while
      (setq p1 (getpoint "1"))
      (setq p2 (getpoint p1 "2"))
     
      (if (null (setq L1 (ssget "F" (list p1 p2) (list (cons 8 "L1")))))
          (setq L1 "")
          (setq L1 "v"))
     
      (if (null (setq L2 (ssget "F" (list p1 p2) (list (cons 8 "L2")))))
        (progn (setq L2 0) (setq a1 0))
        (progn (setq L2 (sslength L2)) (setq a1 1)))
      
      (if (null (setq L5 (ssget "F" (list p1 p2) (list (cons 8 "L5")))))
        (setq L5 0)
        (setq L5 (sslength L5)))
     
      (if (null (setq L3 (ssget "F" (list p1 p2) (list (cons 8 "L3")))))
        (setq L3 0)
        (setq L3 (sslength L3)))
      
      (if (null (setq L4 (ssget "F" (list p1 p2) (list (cons 8 "L4")))))
        (setq L4 "0")
        (setq L4 "n"))
     
      (setq tmc (strcat L1 (itoa L2) (itoa L5) (itoa a1) (itoa L3) L4))
      (setq att (cdr (car (entget (entnext (car (entsel "")))))))
      (setq TagName (dxf 2 att)
    TagVal (dxf 1 att)
    BlName (dxf 330 att))
         (if (setq NewVal tmc)
    (putAtt BlName TagName NewVal))
     
      (setq L1 nil)
      (setq L2 nil)
      (setq L5 nil)
      (setq L3 nil)
      (setq L4 nil)
      (setq a1 nil)
      (setq p1 nil)
      (setq p2 nil)
      (setvar "osmode" osm)
      (setvar "cmdecho" 1)
      (command "undo" "e")
      (princ)
      ))
     
    ;------------------------------------------------------------------------------------------
    (defun dxf(id ent) (cdr (assoc id (entget ent))))
    ;------------------------------------------------------------------------------------------
    (defun putAtt (BlName TagName NewVal / AttName EntDxf dk)
    (setq AttName (entnext BlName ) dk 1)
      (while (and AttName dk)
        (if (equal (assoc 0 (entget AttName )) '(0 . "SEQEND"))
            (setq AttName nil )
            (if (= (cdr (assoc 2 (entget AttName ))) TagName )
                (progn
                  (setq EntDxf (entget AttName ) dk nil)
                  (setq EntDxf (subst (cons 1 NewVal ) (assoc 1 (entget AttName )) EntDxf ) )
                  (entmod EntDxf )
                  (entupd BlName )
                  (setq AttName (entnext AttName ))
                )
            (setq AttName (entnext AttName ))
            )
        )
      )
    )
     

    Và đây là file để thửhttp://www.cadviet.com/upfiles/6/146422_drawing1.dwg


  15. (defun C:VTT()
    (command "undo" "be")
      (setq cmd (getvar "cmdecho")
    	osm (getvar "osmode"))
      (setvar "cmdecho" 0)
      (or (and mut (or (= (type mut) 'int) (= (type mut) 'real))) (setq mut 30)) 
      (setq mut (cond ((getdist (strcat "\nChieu dai doan mu <" (rtos mut 2 2) ">: "))) (mut)))
      (setq chk t)
      (while
        (or	(and chk
    	  (setq dt (entsel "\nChon duong thang: "))
    	    )
    	(and (setq p1 (getpoint "\nChon diem dau"))
    	     (setq p2 (getpoint p1 "\nChon diem cuoi"))
    	     (not (setq chk nil))
    	)
        )
      (if dt
    ;;;    (= dt nil)
    ;;;	(progn
    ;;;	(setq p1 (getpoint "\nChon diem dau")
    ;;;	      p2 (getpoint p1 "\nChon diem cuoi")))
        (if
          (= "LWPOLYLINE" (cdr (assoc 0 (entget (car dt)))))
          (progn
    	(setq pt (acet-geom-vertex-list (car dt))
    	   p1 (car pt)
    	   p2 (last pt)))
          (if
    	(= "LINE" (cdr (assoc 0 (entget (car dt)))))
    	(progn
            (setq dt (car dt)
    	   dt (entget dt)
    	   p1 (cdr (assoc 10 dt))
    	   p2 (cdr (assoc 11 dt))))
    	(princ "\nChon sai")))
        )
      (setvar "osmode" 0)
      (setq	p3 (polar p1 (+ pi (angle p1 p2)) mut)
    	p4 (polar p2 (angle p1 p2) mut))
      (command ".mline" p3 p4 "")
      (setvar "osmode" osm)
      );while
      (setvar "cmdecho" cmd)
      (command "undo" "e")
      (princ))
    

    dùng tạm cái này

     

    Oke, hay quá, cảm ơn anh nhiều nhé!


  16.  

    Bạn cần phải khử biến sau khi kết thúc lệnh, thêm các kiểm tra để tránh lỗi, rút ngắn câu lệnh, lisp sau chỉ thêm vòng lặp thêm yêu cầu

    (defun C:VTT()
    (command "undo" "be")
      (setq cmd (getvar "cmdecho")
    	osm (getvar "osmode"))
      (setvar "cmdecho" 0)
      (or (and mut (or (= (type mut) 'int) (= (type mut) 'real))) (setq mut 30)) 
      (setq mut (cond ((getdist (strcat "\nChieu dai doan mu <" (rtos mut 2 2) ">: "))) (mut)))
      (while
        (or	(setq dt (entsel "\nChon duong thang: "))
    	(and (setq p1 (getpoint "\nChon diem dau"))
    	     (setq p2 (getpoint p1 "\nChon diem cuoi"))
    	)
        )
      (if dt
    ;;;    (= dt nil)
    ;;;	(progn
    ;;;	(setq p1 (getpoint "\nChon diem dau")
    ;;;	      p2 (getpoint p1 "\nChon diem cuoi")))
        (if
          (= "LWPOLYLINE" (cdr (assoc 0 (entget (car dt)))))
          (progn
    	(setq pt (acet-geom-vertex-list (car dt))
    	   p1 (car pt)
    	   p2 (last pt)))
          (if
    	(= "LINE" (cdr (assoc 0 (entget (car dt)))))
    	(progn
            (setq dt (car dt)
    	   dt (entget dt)
    	   p1 (cdr (assoc 10 dt))
    	   p2 (cdr (assoc 11 dt))))
    	(princ "\nChon sai")))
        )
      (setvar "osmode" 0)
      (setq	p3 (polar p1 (+ pi (angle p1 p2)) mut)
    	p4 (polar p2 (angle p1 p2) mut))
      (command ".mline" p3 p4 "")
      (setvar "osmode" osm)
      );while
      (setvar "cmdecho" cmd)
      (command "undo" "e")
      (princ))
    
    

    Cảm ơn anh nhé! 

    Ý em muốn là khi đã chọn vẽ từ 2 điểm thì chỉ lặp lại pick chọn 2 điểm liên tục hoặc khi đã chọn "line,pline" thì select line liên tục.

    như vậy có được không anh!


  17. Em đang tập tành autolisp, không biết thêm vòng lặp while vào chỗ nào để lisp sau khi nhập chiều dài đoạn mút thì chọn liên liếp các line, hoặc chọn liên tiếp các pline, hoặc chọn liên tiếp 2 điểm để vẽ.

    Nhờ anh chị trong diễn đàn giúp đỡ. Xin cảm ơn!

    (defun C:VTT()
    (command "undo" "be")
      (setq cmd (getvar "cmdecho")
    	osm (getvar "osmode"))
      (setvar "cmdecho" 0)
      (or (and mut (or (= (type mut) 'int) (= (type mut) 'real))) (setq mut 30)) 
      (setq mut (cond ((getdist (strcat "\nChieu dai doan mu <" (rtos mut 2 2) ">: "))) (mut)))
      (setq dt (entsel "\nChon duong thang: "))
      (if
        (= dt nil)
    	(progn
    	(setq p1 (getpoint "\nChon diem dau")
    	      p2 (getpoint p1 "\nChon diem cuoi")))
        (if
          (= "LWPOLYLINE" (cdr (assoc 0 (entget (car dt)))))
          (progn
    	(setq pt (acet-geom-vertex-list (car dt))
    	   p1 (car pt)
    	   p2 (last pt)))
          (if
    	(= "LINE" (cdr (assoc 0 (entget (car dt)))))
    	(progn
            (setq dt (car dt)
    	   dt (entget dt)
    	   p1 (cdr (assoc 10 dt))
    	   p2 (cdr (assoc 11 dt))))
    	(princ "\nChon sai"))))
      (setvar "osmode" 0)
      (setq	p3 (polar p1 (+ pi (angle p1 p2)) mut)
    	p4 (polar p2 (angle p1 p2) mut))
      (command ".mline" p3 p4 "")
      (setvar "osmode" osm)
      (setvar "cmdecho" cmd)
      (command "undo" "e")
      (princ))
    

  18. Xin chào các anh chị!

    Nhờ các anh chị trong diễn đàn viết giúp em Lisp dùng để tạo kí hiệu mặt cắt bằng cách quét chọn qua các đường Pline, cụ thể lệnh như sau:

    1. Đánh lệnh "KH"

    2. Đánh kí hiệu mặt nền "T" hoặc "N" hoặc .... (và lưu lại cho lần tiếp theo).

    3. Chọn điểm đầu và điểm cuối của đường quét. Phương và chiều của kí hiệu và text phụ thuộc vào 2 điểm này.

    4. Chọn điểm đặt cho Block kí hiệu.

    5. Lặp lại lệnh, chọn điểm đầu và điểm cuối...

    Đây là file đính kèm:

    http://www.cadviet.com/upfiles/6/146422_ki_hieu_mc.dwg

     

    Mong các anh chị hiểu ý và giúp đỡ!

    Cảm ơn nhiều!


  19.  

    Gửi bạn: (bổ sung => hoặc chọn text để ghi kết quả hoặc chèn text mới)

    (defun c:TT  (/ ent kqua obj sobichia sobitru sochia sotru ss ent-l poi)
     (vl-load-com)
     (initget "1 2 3 4")
     (or phep_tinh (setq phep_tinh "1"))
     (setq phep_tinh (cond ((getkword (strcat "\nChon phep tinh [1+/2-/3*/4:] <" phep_tinh ">: ")))
                           (phep_tinh)))
     (cond ;; cong
           ((= phep_tinh "1")
            (prompt "\nChon text de cong:")
            (setq ss   (ssget '((0 . "*TEXT")))
                  kqua 0)
            (while (and ss (> (sslength ss) 0))
             (setq kqua (+ kqua (atof (cdr (assoc 1 (entget (setq ent (ssname ss 0))))))))
             (ssdel ent ss)))
           ;;nhan
           ((= phep_tinh "3")
            (prompt "\nChon text de nhan:")
            (setq ss   (ssget '((0 . "*TEXT")))
                  kqua 1)
            (while (and ss (> (sslength ss) 0))
             (setq kqua (* kqua (atof (cdr (assoc 1 (entget (setq ent (ssname ss 0))))))))
             (ssdel ent ss)))
           ;;tru
           ((= phep_tinh "2")
            (and (princ "\nChon so bi tru:")
                 (setq sobitru (ssget "_+.:E:S" '((0 . "*TEXT"))))
                 (setq sobitru (distof (cdr (assoc 1 (entget (setq ent (ssname sobitru 0)))))))
                 (princ "\nChon so tru:")
                 (setq sotru (ssget "_+.:E:S" '((0 . "*TEXT"))))
                 (setq sotru (distof (cdr (assoc 1 (entget (setq ent (ssname sotru 0)))))))
                 (setq kqua (- sobitru sotru))))
           ;;chia
           ((= phep_tinh "4")
            (and (princ "\nChon so bi chia:")
                 (setq sobichia (ssget "_+.:E:S" '((0 . "*TEXT"))))
                 (setq sobichia (distof (cdr (assoc 1 (entget (setq ent (ssname sobichia 0)))))))
                 (princ "\nChon so chia:")
                 (setq sochia (ssget "_+.:E:S" '((0 . "*TEXT"))))
                 (setq sochia (distof (cdr (assoc 1 (entget (setq ent (ssname sochia 0)))))))
                 (not (eq sochia 0))
                 (setq kqua (/ sobichia sochia)))))
     (if (and (or ss (and sobitru sotru) (and sobichia sochia)) kqua)
      (progn (or ssle (setq ssle 0))
             (setq ssle (cond ((getint (strcat "\nSo so le <" (itoa ssle) ">: ")))
                              (ssle)))
             (princ (strcat "\nChon text de ghi ket qua [Enter->Insert Text] <" (rtos kqua 2 ssle) ">: "))
             (if (setq ss (ssget "_+.:E:S" '((0 . "*TEXT"))))
              (progn (setq obj (vlax-ename->vla-object (ssname ss 0)))
                     (vla-put-TextString obj (rtos kqua 2 ssle)))
              (and (setq poi (getpoint "\nDiem chen Text: "))
                   (setq ent-l (vl-remove-if-not '(lambda (x) (member (car x) '(0 1 7 8 40 41 42 50 51 62 100))) (entget ent))
                         ent-l (append (subst (cons 1 (rtos kqua 2 ssle)) (assoc 1 ent-l) ent-l) (list (cons 10 poi))))
                   (entmakex ent-l)))))
     (princ))

    Hehe, quá Pro, cảm ơn anh nhiều nhé!


  20.  

    Thử xem có đúng ý bạn không nhé:

    (defun c:cco  (/ oldos css ss p0 p1 p2 a e d)
     (defun css  (ss p0 p1 a)
      ((lambda (i / e obj o1 i)
        (while (setq e (ssname ss (setq i (1+ i))))
         (setq obj (vlax-ename->vla-object e))
         (setq o1 (vla-copy obj))
         (if p0
          (vla-move o1 (vlax-3d-point p0) (vlax-3d-point p1)))
         (vla-move o1 (vlax-3d-point p1) (vlax-3d-point (polar p1 a d))))) -1))
     (princ "\n Chon doi tuong can copy")
     (setq ss (ssget)
           p0 (getpoint "\n Chon diem chuan: ")
           p1 (getpoint p0 "\n Chon diem goc: ")
           p2 (getpoint p1 "\n Chon diem dinh huong copy: ")
           a  (angle p1 p2)
           e  (entlast))
     (or dis-copy-m (setq dis-copy-m 100))
     (while (not (eq (setq d (getdist (strcat "\n Nhap khoang cach can copy tiep theo [0->Exit] <" (rtos dis-copy-m)">: "))) 0))
      (if (not d)(setq d dis-copy-m)(setq dis-copy-m d))
      (css ss p0 p1 a)
      (setq ss (ssadd))
      (while (setq e (entnext e)) (setq ss (ssadd e ss)))
      (setq p0 nil
            e  (entlast)))
     (princ))

    Hehe, rất oke, cảm ơn anh nhiều nhé! Tiện thể nhờ anh sửa giúp em Lisp tính toán cộng trừ nhân chia, là khi nhập lệnh TT enter sau đó hoặc ENTER để thực hiện phép tính cộng hoặc nhập các phép tính khác, cảm ơn anh!

    (defun c:TT()
    
      (vl-load-com)
    
      (initget 1 "1 2 3 4")
    
      (setq ptinh (getkword "Chon phep tinh <1 2 3 4>: "))
    
      
    
      (cond ((= ptinh "1")  ;;; cong
    
    	 (prompt "\nChon text de cong:")
    
    	 (setq ss (ssget '((0 . "TEXT")))
    
    	       kqua 0)
    
    	 (while (and ss (> (sslength ss) 0))
    
    	   (setq kqua (+ kqua (atof (cdr (assoc 1 (entget (setq ent (ssname ss 0))))))))
    
    	   (ssdel ent ss))
    
    	 (princ kqua))
    
    	
    
    	((= ptinh "3")  ;;;nhan
    
    	 (prompt "\nChon text de nhan:")
    
    	 (setq ss (ssget '((0 . "TEXT")))
    
    	       kqua 1)
    
    	 (while (and ss (> (sslength ss) 0))
    
    	   (setq kqua (* kqua (atof (cdr (assoc 1 (entget (setq ent (ssname ss 0))))))))
    
    	   (ssdel ent ss))
    
    	 (princ kqua))
    
    
    
    	((= ptinh "2")  ;;;tru
    
    	 (setq sobitru (car (entsel "\nChon so bi tru:"))
    
    	       sotru (car (entsel "\nChon so tru:\n"))
    
    	       kqua (- (atof (cdr (assoc 1 (entget sobitru))))
    
    		     (atof (cdr (assoc 1 (entget sotru))))))	  
    
    	 (princ kqua))
    
    
    
    	((= ptinh "4")  ;;;chia
    
    	 (setq sobichia (car (entsel "\nChon so bi chia:"))
    
    	       sochia (car (entsel "\nChon so chia:\n"))
    
    	       kqua (/ (atof (cdr (assoc 1 (entget sobichia))))
    
    		     (atof (cdr (assoc 1 (entget sochia))))))	  
    
    	 (princ kqua))	
    
      )  
    
      (if (not ssle) (setq ssle 0))
    
      (setq obj (vlax-ename->vla-object (car (entsel "\nChon text de ghi ket qua:")))
    
    		ssle1 (getint (strcat "\nSo so le <" (itoa ssle) ">: ")))
    
      (if ssle1 (setq ssle ssle1))
    
      (vla-put-TextString obj (rtos kqua 2 ssle))  
    
      (princ)	       
    
    )
    
    

  21. Để giảm bớt thao tác lập lại, em nhờ các anh chị sửa Lisp với nội dung là thêm phần lưu giá trị khoảng cách cho lần tiếp theo. Ví dụ: khi nhập khoảng cách copy là 100 cho lần thứ nhất, thì lần thứ 2 khi enter sẽ nhận giá trị là 100 hoặc nhập giá trị mới là 200, lần thứ 3 khi enter thì sẽ nhận giá trị là 200 hoặc nhập giá trị khác....Mong các anh chị hiểu ý và giúp đỡ.

    (defun c:cco (/ oldos css ss p0 p1 p2 a e d)
    (defun css (ss p0 p1 a)
    ((lambda (i / e obj o1 i) (while (setq e (ssname ss (setq i (1+ i))))
    (setq obj (vlax-ename->vla-object e)) (setq o1 (vla-copy obj)) 
    (if p0 (vla-move o1 (vlax-3d-point p0) (vlax-3d-point p1)))
    (vla-move o1 (vlax-3d-point p1) (vlax-3d-point (polar p1 a d))) )) -1) )
    (princ "\n Chon doi tuong can copy") (setq ss (ssget) 
    p0 (getpoint "\n Chon diem chuan")
    p1 (getpoint p0 "\n Chon diem goc") 
    p2 (getpoint p1 "\n Chon diem dinh huong copy") 
    a (angle p1 p2) e (entlast))
    (while (setq d (getdist "\n Nhap khoang cach can copy tiep theo: "))
    (css ss p0 p1 a) (setq ss (ssadd))
    (while (setq e (entnext e)) (setq ss (ssadd e ss))) 
    (setq p0 nil e (entlast)) )
    (princ))
     

    Xin cảm ơn!


  22.  

    Sửa lại theo Y/c đây:

    (defun c:EDL  (/ ang ept ent lpt lst lsn obj poi sel spt lst-coor i ss)
     (vl-load-com)
     (if (setq ss (ssget '((0 . "LEADER"))))
      (progn (or poi (setq poi "E"))
             (initget "E S")
             (setq poi (getstring (strcat "\nDiem thay doi [End/Start] <" poi ">: ")))
             (if (eq poi "")
              (setq poi "E"))
             (or *delta* (setq *delta* 0))
             (setq *delta* (cond ((getdist (strcat "\nNhap so gia <" (rtos *delta*) ">: ")))
                                 (*delta*)))
             (repeat (setq i (sslength ss))
              (setq ent (ssname ss (setq i (1- i)))
                    obj (vlax-ename->vla-object ent)
                    lst (vl-remove-if-not '(lambda (x) (member (car x) '(10))) (entget ent))
                    spt (cdr (car lst))
                    ept (cdr (last lst))
                    lsn (vl-remove (last (cdr lst)) (cdr lst)))
              (foreach x lsn (setq lpt (cons (cdr x) lpt)))
              (if (eq poi "E")
               (setq ang (angle (cdr (nth (- (length lst) 2) lst)) ept)
                     ept (polar ept ang *delta*))
               (setq ang (angle spt (cdr (nth 1 lst)))
                     spt (polar spt (+ ang pi) *delta*)))
              (if lsn
               (setq lst-coor (list spt (apply 'append (reverse lpt)) ept))
               (setq lst-coor (list spt ept)))
              (vlax-put obj 'Coordinates (apply 'append lst-coor))
              (setq lpt nil))))
     (princ))
    

    Cảm ơn anh nhiều nhé! Lisp chạy rất oke, chúc anh và diễn đàn luôn phát triển! :)


  23.  

    Không biết thế này có đúng ý chủ thớt không??? (Dịch mãi mới ra ý của đề)

    (defun c:EDL  (/ ang ept ent lpt lst lsn obj poi sel spt lst-coor)
     (vl-load-com)
     (or *delta* (setq *delta* 0))
     (setq *delta* (cond ((getdist (strcat "\nNhap so gia <" (rtos *delta*) ">: ")))
                         (*delta*)))
     (while (setq sel (entsel))
      (if (eq (cdr (assoc 0 (entget (car sel)))) "LEADER")
       (progn (setq ent (car sel)
                    poi (cadr sel)
                    obj (vlax-ename->vla-object ent)
                    lst (vl-remove-if-not '(lambda (x) (member (car x) '(10))) (entget ent))
                    spt (cdr (car lst))
                    ept (cdr (last lst))
                    ang (angle spt ept)
                    lsn (vl-remove (last (cdr lst)) (cdr lst)))
              (foreach x lsn (setq lpt (cons (cdr x) lpt)))
              (if (> (distance poi spt) (distance poi ept))
               (setq ang (angle (cdr (nth (- (length lst) 2) lst)) ept)
                     ept (polar ept ang *delta*))
               (setq ang (angle spt (cdr (nth 1 lst)))
                     spt (polar spt (+ ang pi) *delta*)))
              (if lsn
               (setq lst-coor (list spt (apply 'append (reverse lpt)) ept))
               (setq lst-coor (list spt ept)))
              (vlax-put obj 'Coordinates (apply 'append lst-coor)))
       (princ "\nDoi tuong da chon khong phai Leader...!"))
      (setq lpt nil))
     (princ))
    

    Cảm ơn anh! hehe, anh sửa lại như thế này dùm e nha, đánh lệnh: EDL -> chọn các đường Leader -> hiện bảng chọn điểm đầu hoặc điểm cuối -> nhập kích thước muốn thay đổi. Anh xem file này nhé! mong anh hiểu ý và giúp đỡ

    http://www.cadviet.com/upfiles/5/146422_edit_leader.dwg

    • Vote giảm 1
×