Đến nội dung


Hình ảnh
- - - - -

Nhờ Sửa Lỗi Lisp


  • Please log in to reply
32 replies to this topic

#21 taipham

taipham

    biết vẽ ellipse

  • Members
  • PipPip
  • 57 Bài viết
Điểm đánh giá: -5 (bình thường)

Đã gửi 09 September 2016 - 10:49 PM

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


  • 0

#22 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 673 Bài viết
Điểm đánh giá: 315 (khá)

Đã gửi 09 September 2016 - 11:19 PM

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

141736_tty_edit.gif

 


  • 0

#23 taipham

taipham

    biết vẽ ellipse

  • Members
  • PipPip
  • 57 Bài viết
Điểm đánh giá: -5 (bình thường)

Đã gửi 09 September 2016 - 11:47 PM

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

141736_tty_edit.gif

Đâ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.c...46422_twist.dwg


  • 0

#24 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 673 Bài viết
Điểm đánh giá: 315 (khá)

Đã gửi 10 September 2016 - 12:26 AM

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


  • 0

#25 taipham

taipham

    biết vẽ ellipse

  • Members
  • PipPip
  • 57 Bài viết
Điểm đánh giá: -5 (bình thường)

Đã gửi 10 September 2016 - 12:33 AM

Đâ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.c...46422_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)
  )

  • 0

#26 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 673 Bài viết
Điểm đánh giá: 315 (khá)

Đã gửi 10 September 2016 - 03:16 PM

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

  • 0

#27 taipham

taipham

    biết vẽ ellipse

  • Members
  • PipPip
  • 57 Bài viết
Điểm đánh giá: -5 (bình thường)

Đã gửi 10 September 2016 - 07:12 PM

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.


  • 0

#28 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 673 Bài viết
Điểm đánh giá: 315 (khá)

Đã gửi 10 September 2016 - 09:00 PM

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.

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


  • 0

#29 taipham

taipham

    biết vẽ ellipse

  • Members
  • PipPip
  • 57 Bài viết
Điểm đánh giá: -5 (bình thường)

Đã gửi 11 September 2016 - 01:49 AM

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


  • 0

#30 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 13 September 2016 - 08:43 AM

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

Bạn quocmanh04tt cho mình hỏi có hàm nào lấy lại "distance1" không (nghĩa là khi tích vào bock ta lấy được giá trị "distance1")


  • 0

#31 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 673 Bài viết
Điểm đánh giá: 315 (khá)

Đã gửi 13 September 2016 - 08:55 AM

Có đây:

(defun getdynpropvalue  (blk prp)
  (setq prp (strcase prp))
  (vl-some '(lambda (x)
             (if (= prp (strcase (vla-get-propertyname x)))
              (vlax-get x 'value)))
           (vlax-invoke blk 'getdynamicblockproperties)))


  • 1

#32 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 15 September 2016 - 08:02 AM

1- Gạch thứ nhất:

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

Bạn cho mình hỏi thêm tí nữa

Có hơn 1 điểm giao thì làm sao lấy tọa độ của các điểm


  • 0

#33 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 673 Bài viết
Điểm đánh giá: 315 (khá)

Đã gửi 15 September 2016 - 10:28 AM

Bạn cho (princ lst) kết quả trả về thì rõ ngay.

VD: kq có 2 giao điểm nó sẽ có 1 list thế này: (x1 y1 z1 x2 y2 z2), từ đây mỗi 3 phần tử của list là 1 điểm, thứ tự từ đầu list đến cuối.

Xử lý tiếp theo tùy thuộc ở bạn.


  • 1