Nhờ Sửa Lỗi Lisp

Tháng 9 2, 2016

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

Tháng 9 2, 2016

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

Tháng 9 2, 2016

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

Tháng 9 3, 2016

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

Tháng 9 3, 2016

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!

Tháng 9 3, 2016

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!

Tháng 9 3, 2016

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.

Tháng 9 3, 2016

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!

Tháng 9 4, 2016

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

Tháng 9 4, 2016

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

Tháng 9 6, 2016

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

Làm sao để insert và kéo block như anh được vậy?

Tháng 9 7, 2016

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

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

Tháng 9 7, 2016

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.

Tháng 9 7, 2016

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

Tháng 9 7, 2016

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.

Tháng 9 7, 2016

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

Tháng 9 7, 2016

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!

Tháng 9 8, 2016

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!

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

Tháng 9 9, 2016

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

Tháng 9 9, 2016

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

Tháng 9 9, 2016

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

Tháng 9 9, 2016

.=>Vậy thì có lẽ phải dùng hàm trans để chuyển đổi. Bạn gửi bản vẽ viewtwist bất kỳ đi! Mình thử lsp đã sửa ở trên, test trên file của bạn không thấy lỗi.

Tháng 9 9, 2016

.=>Vậy thì có lẽ phải dùng hàm trans để chuyển đổi. Bạn gửi bản vẽ viewtwist bất kỳ đi! Mình thử lsp đã sửa ở trên, test trên file của bạn không thấy lỗi.

Đâ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

Tháng 9 9, 2016

Chưa được, ca này phải nghiên cứu thêm.

Tháng 9 9, 2016

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

Đăng nhập

Nhờ Sửa Lỗi Lisp

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

taipham 5

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

taipham 5

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

ndtnv 481

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

taipham 5

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

taipham 5

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

taipham 5

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

taipham 5

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

taipham 5

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

taipham 5

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

taipham 5

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

taipham 5

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

taipham 5

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