Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
NguyenNgocSon

[Nhờ giúp đỡ] sửa lỗi lisp

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

Em có lisp này nhưng chạy không ổn định và báo lỗi
; error: bad argument type: lselsetp 
nil
Mong bác nào có thời gian xem giúp
Cám ơn !
(vl-load-com)
;;;--------------------------------------------------------------------------
; Ham lay chieu dai doi tuong
(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))

(defun C:TLN()
;Viet ham tinh toan bo PL thuoc layer

;Chon doi tuong mau de layer tinh chieu dai
(command "UCS" "W")
(setq lay (cdr (assoc 8 (entget (car (entsel "\n Chon doi tuong lay layer tinh khoi luong:\n"))))))
(princ (strcat"\nDoi tuong lay layer tinh khoi luong la:" lay "\n"))
(setq txt (cdr (assoc 1 (entget (car (entsel "\nChon Text mau de dien khoi luong: "))))))
(princ (strcat"\nHang muc tinh khoi luong la:" txt))
(setq ss3 (ssget "_X" '((0 . "*POLYLINE")(8 . "PLINETNTN"))))
(setq ss4 (ssget "_X" '((0 . "*LINE")(8 . "ENTDAUCO"))))
(setq ss (ssget "_X" '((0 . "TEXT")(8 . "ENTDAUCO")(1 . "Cäc:*"))))
    	(setq n (sslength ss))
    	(setq i 0)
    	(while (< i n)
    	(setq e (entget(ssname ss i)))
(setq p  (cdr (assoc 10 e))	  
x  (rtos (car p));Toa do X	  
y  (rtos (cadr p)); Toa do Y
)
(Setq A (length1 (ssname ss3 1)))
(Setq A (/ A 2))
(Setq c (length1 (ssname ss4 1)))
(setq p1 (list (- (car p) A ) (- (cadr p) c)))
(setq p2 (list (+ A (car p)) (cadr p)))
(command "zoom" "w" p1 p2)
;------- Tinh tong cac doi tuong
(progn
            (setq l 0.0)
            (repeat (setq j (sslength ss2))
                (setq e1 (ssname ss2 (setq j (1- j)))
                      l (+ l (vlax-curve-getdistatparam e1 (vlax-curve-getendparam e1)))
                )
            )
    	(setq e1 (entget(ssname ss1 0)))
    	(setq e1 (subst (cons 1 (rtos l 2 2)) (assoc 1 e1) e1))
    	(entmod e1);; Thay noi dung cua doi tuong
)
    	(setq i (1+ i))
    	);; while

(command "undo" "end")
(princ)
)

Lisp bị lỗi ; error: bad argument type: 

lselsetp nil
Nhờ bác nào rãnh xem giúp. vì nó chạy không ổn định lúc được lúc không :(
  • Vote giảm 1

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
Tot77    501

Lỗi ở chỗ này 

(setq ss (ssget "_X" '((0 . "TEXT")(8 . "ENTDAUCO")(1 . "Cäc:*"))))

vì không có text nào thuộc layer ENTDAUCO và có nội dung như trên.

Tức là ss=nil và (sslength ss) gây ra lỗi.

  • Vote tăng 1

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

Lỗi ở chỗ này 

(setq ss (ssget "_X" '((0 . "TEXT")(8 . "ENTDAUCO")(1 . "Cäc:*"))))

vì không có text nào thuộc layer ENTDAUCO và có nội dung như trên.

Tức là ss=nil và (sslength ss) gây ra lỗi.

Cám ơn bác. Vậy bác có thể giúp em bẫy lỗi các hàm SSget không ?

Vì nếu (sslength ss)=0 là gây lỗi

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
Tot77    501

Đặt nó vào trong 1 cái if.

 

(defun C:TLN()
;Viet ham tinh toan bo PL thuoc layer
 
;Chon doi tuong mau de layer tinh chieu dai
(command "UCS" "W")
(setq lay (cdr (assoc 8 (entget (car (entsel "\n Chon doi tuong lay layer tinh khoi luong:\n"))))))
(princ (strcat"\nDoi tuong lay layer tinh khoi luong la:" lay "\n"))
(setq txt (cdr (assoc 1 (entget (car (entsel "\nChon Text mau de dien khoi luong: "))))))
(princ (strcat"\nHang muc tinh khoi luong la:" txt))
(setq ss3 (ssget "_X" '((0 . "*POLYLINE")(8 . "PLINETNTN"))))
(setq ss4 (ssget "_X" '((0 . "*LINE")(8 . "ENTDAUCO"))))
(if (setq ss (ssget "_X" '((0 . "TEXT")(8 . "ENTDAUCO")(1 . "Cäc:*"))))
(progn
(setq n (sslength ss))
(setq i 0)
(while (< i n)
 (setq e (entget(ssname ss i)))
(setq p  (cdr (assoc 10 e)) 
x  (rtos (car p));Toa do X 
y  (rtos (cadr p)); Toa do Y
)
(Setq A (length1 (ssname ss3 1)))
(Setq A (/ A 2))
(Setq c (length1 (ssname ss4 1)))
(setq p1 (list (- (car p) A ) (- (cadr p) c)))
(setq p2 (list (+ A (car p)) (cadr p)))
(command "zoom" "w" p1 p2)
;------- Tinh tong cac doi tuong
(progn
      (setq l 0.0)
      (repeat (setq j (sslength ss2))
          (setq e1 (ssname ss2 (setq j (1- j)))
                l (+ l (vlax-curve-getdistatparam e1 (vlax-curve-getendparam e1)))
          )
      )
     (setq e1 (entget(ssname ss1 0)))
     (setq e1 (subst (cons 1 (rtos l 2 2)) (assoc 1 e1) e1))
     (entmod e1);; Thay noi dung cua doi tuong
)
   (setq i (1+ i))
);; while
)
)
(command "undo" "end")
(princ)
)
  • Vote tăng 1

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

(if (setq SS2 (ssget "_C" p1 p2 (list '(0 . "*POLYLINE,*LWPOLYLINE,*LINE") (cons 8 lay))))
(setq ps (vlax-curve-getStartPoint (ssname ss2 1)))


(entmake (list (cons 0 "POINT") (cons 10 ps)))
);Close if
Lỗi này do đâu
; error: bad DXF group: (10)

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
gia_bach    1.442
(if (setq SS2 (ssget "_C" p1 p2 (list '(0 . "*POLYLINE,*LWPOLYLINE,*LINE") (cons 8 lay))))
(setq ps (vlax-curve-getStartPoint (ssname ss2 1)))


        (entmake (list (cons 0 "POINT") (cons 10 ps)))
);Close if
Lỗi này do đâu
; error: bad DXF group: (10)

thiếu (progn ...) 

  • Vote tăng 1

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
Tot77    501

Có phải theo bạn thì center point là điểm giữa của Text, không phải điểm chèn hay điểm canh lề?

Nếu vậy bạn lấy center point như này:

 

(vla-getBoundingBox (vlax-ename->vla-object (car (entsel))) 'minp 'maxp)
(setq bd (mapcar 'vlax-safearray->list (list minp maxp)))
(polar (car bd) (angle (car bd) (last bd)) (* 0.5 (distance (car bd) (last bd))))
  • Vote tăng 1

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
;Lua chon doi tuong nam trong Windows
(if (setq SS2 (ssget "_C" p1 p2 (list '(0 . "*POLYLINE,*LWPOLYLINE,*LINE") (cons 8 "a"))))
(progn
	(setq ps (trans (vlax-curve-getStartPoint (ssname ss2 0)) 1 0))
	(setq dc (trans (list (- (car ps) 2.5 ) (- (cadr ps) 0)) 0 1))
	(command "._insert" "GPMB" dc 1 1 0 )
	(setq ds (trans (list (- (car p) 0.0 ) (- (cadr p) 3)) 0 1))
	(command "dimlinear" dc ds ds)
)
);Close if

Bản chất của đoạn mã là tìm đối tượng có layer a bằng cách chọn _C. Sau đó chèn block vào điểm cách đối tượng (điểm đầu) này 1 khoảng là -2.5 theo phuong X

Nhung khi thực hiện lệnh đoạn mã không ổn định. lúc thì điểm chèn cách -2.5,-2.45,-2.6...

Không biêt lỗi phát sinh do đâu ?

Cám ơn!

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

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

Đăng nhập để thực hiện theo  

×