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  
leejang

Em đang học Lisp, nhờ các anh sửa júp em đoạn mã bị lỗi !!!!!

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

leejang    4

Em muốn viết lisp như sau :

Command: HT

select object : chọn vào hatch

select text to result :

hiện tại kết quả đang = 0, còn lỗi đôi chút, mong các bác sửa júp em với !!!

CODE

;=========dien tich hatch=========

(defun C:ht (/ tot_len ss e_name e_record e_type)

(princ "\nHoang Giang ")

(setq tot_len 0.0)

(setq ss (ssget))

(if (null ss)

(exit)

)

(while (> (sslength ss) 0)

(setq e_name (ssname ss 0))

(setq e_record (entget e_name))

(setq e_type (cdr (assoc '0 e_record)))

(cond ((wcmatch e_type "hatch")

(command "area" "o" e_name)

(setq tot_len (+ tot_len ))

(ssdel e_name ss)

)

((wcmatch e_type "hatch") (add_mline))

(e_type (ssdel e_name ss))

)

)

(if co1

(setq co2 (getreal (strcat "\nHe so <" (rtos co1) ">:")))

(setq co1 (getreal "\nHe so :" )))

 

(if co2 (setq co1 co2))

 

(prompt (strcat "\nDien tich hatch: " (rtos tot_len 2 2)))

(setq giatri (entget (car (entsel "\n Select Text to results: "))))

(command "luprec" "2")

(setq gia (assoc 1 giatri))

(setq nt1 (cons 1 (rtos (* tot_len co1 ))))

(setq giatri (subst nt1 gia giatri))

(entmod giatri)

(princ)

(princ)

)

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
phamthanhbinh    3.123
Em muốn viết lisp như sau :

Command: HT

select object : chọn vào hatch

select text to result :

hiện tại kết quả đang = 0, còn lỗi đôi chút, mong các bác sửa júp em với !!!

CODE

;=========dien tich hatch=========

(defun C:ht (/ tot_len ss e_name e_record e_type)

(princ "\nHoang Giang ")

(setq tot_len 0.0)

(setq ss (ssget))

(if (null ss)

(exit)

)

(while (> (sslength ss) 0)

(setq e_name (ssname ss 0))

(setq e_record (entget e_name))

(setq e_type (cdr (assoc '0 e_record)))

(cond ((wcmatch e_type "hatch")

(command "area" "o" e_name)

(setq tot_len (+ tot_len ))

(ssdel e_name ss)

)

((wcmatch e_type "hatch") (add_mline))

(e_type (ssdel e_name ss))

)

)

(if co1

(setq co2 (getreal (strcat "\nHe so :")))

(setq co1 (getreal "\nHe so :" )))

 

(if co2 (setq co1 co2))

 

(prompt (strcat "\nDien tich hatch: " (rtos tot_len 2 2)))

(setq giatri (entget (car (entsel "\n Select Text to results: "))))

(command "luprec" "2")

(setq gia (assoc 1 giatri))

(setq nt1 (cons 1 (rtos (* tot_len co1 ))))

(setq giatri (subst nt1 gia giatri))

(entmod giatri)

(princ)

(princ)

)

Chào bạn Leejang,

Bạn hày xem lại các dòng code sau:

1/-(setq tot_len (+ tot_len ))

2/- (setq nt1 (cons 1 (rtos (* tot_len co1 ))))

Chúc bạn thành công.

  • 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
leejang    4

Chào bạn Leejang,

Bạn hày xem lại các dòng code sau:

1/-(setq tot_len (+ tot_len ))

2/- (setq nt1 (cons 1 (rtos (* tot_len co1 ))))

Chúc bạn thành công.

Anh nào sửa giúp em đi ? Em ko sửa được, em ko bit cách gán kết quả sau dòng (command "area" "o" e_name) vào biến như thế nào ? huhuhuhu

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
Em muốn viết lisp như sau :

Command: HT

select object : chọn vào hatch

select text to result :

hiện tại kết quả đang = 0, còn lỗi đôi chút, mong các bác sửa júp em với !!!

CODE

;=========dien tich hatch=========

.....................

Chào leejang

Từ phiên bản Cad 2006, đối tuợng Hatch mới có thuộc tính Diện tích.

Nếu bạn sử dụng phiên bản Cad 2005 trở về truớc thì pótay.

bạn chạy thử Lisp này (cho phiên bản Cad 2006 đến nay):

(defun c:HatchArea (/ cnt tot ss obj )
 (if (> (atof (substr (getvar "ACADVER") 1 4)) 16.1) ;;;AutoCAD 2006 16.2
   (progn
     (vl-load-com)
     (setq	cnt 0	tot 0  )
     (prin "\nChon hatches : ")
     (if (ssget '((0 . "HATCH")))
(progn
  (vlax-for
    h
    (setq ss (vla-get-ActiveselectionSet (vla-get-ActiveDocument (vlax-get-acad-object)) ) )
    (setq cnt (1+ cnt)
	  tot (+ tot (vla-get-Area h))
	  )
    )
  (vla-delete ss)
  )
)
     (princ (strcat "\nTong dien tich cua "(itoa cnt) " Hatch la : " (rtos tot) )  )
     (setq obj (entsel "\nChon text de ghi ket qua hay Enter de ket thuc."))
     (if (and
    obj
    (setq obj (vlax-ename->vla-object (car obj)))
    (eq (vlax-get obj 'ObjectName) "AcDbText")
    )
(vla-put-TextString obj (rtos tot))
)
     (princ)
     )
   (alert "\nPhien ban AutoCad cua ban khong ho tro tinh dien tich Hatch ")
   )
 )

  • 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
leejang    4
Chào leejang

Từ phiên bản Cad 2006, đối tuợng Hatch mới có thuộc tính Diện tích.

Nếu bạn sử dụng phiên bản Cad 2005 trở về truớc thì pótay.

bạn chạy thử Lisp này (cho phiên bản Cad 2006 đến nay):

(defun c:HatchArea (/ cnt tot ss obj )
 (if (> (atof (substr (getvar "ACADVER") 1 4)) 16.1) ;;;AutoCAD 2006 16.2
   (progn
     (vl-load-com)
     (setq	cnt 0	tot 0  )
     (prin "\nChon hatches : ")
     (if (ssget '((0 . "HATCH")))
(progn
  (vlax-for
    h
    (setq ss (vla-get-ActiveselectionSet (vla-get-ActiveDocument (vlax-get-acad-object)) ) )
    (setq cnt (1+ cnt)
	  tot (+ tot (vla-get-Area h))
	  )
    )
  (vla-delete ss)
  )
)
     (princ (strcat "\nTong dien tich cua "(itoa cnt) " Hatch la : " (rtos tot) )  )
     (setq obj (entsel "\nChon text de ghi ket qua hay Enter de ket thuc."))
     (if (and
    obj
    (setq obj (vlax-ename->vla-object (car obj)))
    (eq (vlax-get obj 'ObjectName) "AcDbText")
    )
(vla-put-TextString obj (rtos tot))
)
     (princ)
     )
   (alert "\nPhien ban AutoCad cua ban khong ho tro tinh dien tich Hatch ")
   )
 )

Bác Gia_Bach à !!Em hay dùng phiên bản CAD 2004 vì thằng đó nhẹ và chạy ổn định, Máy em thì yếu. Em vẫn tính diện tích Hatch bằng LI được mà . Bác xem chỉnh thế nào để nó chạy được trên CAD 2004 vớ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
gia_bach    1.442
Bác Gia_Bach à !!Em hay dùng phiên bản CAD 2004 vì thằng đó nhẹ và chạy ổn định, Máy em thì yếu. Em vẫn tính diện tích Hatch bằng LI được mà . Bác xem chỉnh thế nào để nó chạy được trên CAD 2004 với...

Có thể bạn nhầm lẫn giữa đuờng biên (boundary) Hatch và đối tuợng Hatch ?!

Hoặc bạn đang sử dụng phiên bản Cad2004 đặc biệt của AutoDesk ?

Bạn thử gõ lệnh LI(list) rồi chọn đối tuợng Hatch xem ?

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
leejang    4
Có thể bạn nhầm lẫn giữa đuờng biên (boundary) Hatch và đối tuợng Hatch ?!

Hoặc bạn đang sử dụng phiên bản Cad2004 đặc biệt của AutoDesk ?

Bạn thử gõ lệnh LI(list) rồi chọn đối tuợng Hatch xem ?

Bản vẽ người ta làm từ trước, chắc là người ta làm bằng CAD đời cao hơn. khi mình li bằng CAD 2004 thì có AREA còn nếu CAD 2004 mà Hatch sau đó Li thì ko có thật bác à !!!Nhưng hiện tại Lisp bác viết chưa chạy được khi em chạy trên CAD 2007.Em đánh lệnh xong thì chẳng thấy j. Bác xem lại xem có nhầm lẫn chỗ nào ko ???

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
Bản vẽ người ta làm từ trước, chắc là người ta làm bằng CAD đời cao hơn. khi mình li bằng CAD 2004 thì có AREA còn nếu CAD 2004 mà Hatch sau đó Li thì ko có thật bác à !!!Nhưng hiện tại Lisp bác viết chưa chạy được khi em chạy trên CAD 2007.Em đánh lệnh xong thì chẳng thấy j. Bác xem lại xem có nhầm lẫn chỗ nào ko ???

unKnown ! :s_big:

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
leejang    4
unKnown ! :s_big:

Lisp của bác viết cho em ko chạy được trên bất cứ phiên bản CAD nào. mở CAD 2007 ra chạy, đánh lệnh xong chẳng thấy j ???? Phiền bác check lại júp em vớ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
gia_bach    1.442
Lisp của bác viết cho em ko chạy được trên bất cứ phiên bản CAD nào. mở CAD 2007 ra chạy, đánh lệnh xong chẳng thấy j ???? Phiền bác check lại júp em với !!!!!

Bạn chạy thử Lisp này

(defun c:HatchArea (/ cnt tot ss obj )
 (if (> (atof (substr (getvar "ACADVER") 1 4)) 16.1) ;;;AutoCAD 2006 16.2
   (progn
     (vl-load-com)
     (setq cnt 0 tot 0  )
     (princ "\nChon doi tuong HATCH : ")
     (if (setq ss (ssget '((0 . "HATCH"))))
(progn
  (foreach e (mapcar 'vlax-ename->vla-Object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
    (if (vlax-property-available-p e 'Area)
      (setq cnt (1+ cnt)
	    tot (+ tot (vla-get-Area e))
	    )
      )
    )
  (princ (strcat "\nTong dien tich cua "(itoa cnt) " Hatch la : " (rtos tot) )  )
  (setq obj (entsel "\nChon text de ghi ket qua hay Enter de ket thuc."))
  (if (and
	obj
	(setq obj (vlax-ename->vla-object (car obj)))
	(eq (vlax-get obj 'ObjectName) "AcDbText")
	)
    (vla-put-TextString obj (rtos tot))
    )
  (princ)
  )
(princ "\nKhong co doi tuong HATCH nao duoc chon." )
)      
     )
   (alert "\nPhien ban AutoCad cua ban khong ho tro tinh dien tich Hatch ")
   )
 )

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
leejang    4
Bạn chạy thử Lisp này

(defun c:HatchArea (/ cnt tot ss obj )
 (if (> (atof (substr (getvar "ACADVER") 1 4)) 16.1) ;;;AutoCAD 2006 16.2
   (progn
     (vl-load-com)
     (setq cnt 0 tot 0  )
     (princ "\nChon doi tuong HATCH : ")
     (if (setq ss (ssget '((0 . "HATCH"))))
(progn
  (foreach e (mapcar 'vlax-ename->vla-Object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
    (if (vlax-property-available-p e 'Area)
      (setq cnt (1+ cnt)
	    tot (+ tot (vla-get-Area h))
	    )
      )
    )
  (princ (strcat "\nTong dien tich cua "(itoa cnt) " Hatch la : " (rtos tot) )  )
  (setq obj (entsel "\nChon text de ghi ket qua hay Enter de ket thuc."))
  (if (and
	obj
	(setq obj (vlax-ename->vla-object (car obj)))
	(eq (vlax-get obj 'ObjectName) "AcDbText")
	)
    (vla-put-TextString obj (rtos tot))
    )
  (princ)
  )
(princ "\nKhong co doi tuong HATCH nao duoc chon." )
)      
     )
   (alert "\nPhien ban AutoCad cua ban khong ho tro tinh dien tich Hatch ")
   )
 )

 

lỗi khi chạy CAD 2007:

Select objects: ; error: bad argument type: VLA-OBJECT nil

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
Tue_NV    3.841
lỗi khi chạy CAD 2007:

Select objects: ; error: bad argument type: VLA-OBJECT nil

Bạn thêm dòng :

(vl-load-com)

dưới dòng : (defun c:HatchArea (/ cnt tot ss obj )

 

xem sao

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
leejang    4
Bạn thêm dòng :

(vl-load-com)

dưới dòng : (defun c:HatchArea (/ cnt tot ss obj )

 

xem sao

Em Thêm rùi, Vẫn báo lỗi : Select objects: ; error: bad argument type: VLA-OBJECT nil

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
Em Thêm rùi, Vẫn báo lỗi : Select objects: ; error: bad argument type: VLA-OBJECT nil

Sorry leejang, đã fix lỗi.

bạn test lại dùm.

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  

×