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

[leejang 5]

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)

)

[phamthanhbinh 3.146]

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.

[leejang 5]

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

[gia_bach 1.549]

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

[leejang 5]

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

[gia_bach 1.549]

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 ?

[leejang 5]

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

[gia_bach 1.549]

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:

[leejang 5]

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

[gia_bach 1.549]

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

[leejang 5]

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

[Tue_NV 3.912]

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

[leejang 5]

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

[gia_bach 1.549]

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.

[leejang 5]

Sorry leejang, đã fix lỗi.

bạn test lại dùm.

bác Fix lỗi rùi sao ko up cho em bản Fix lỗi, Em lấy j để Test đây ???

[gia_bach 1.549]

bác Fix lỗi rùi sao ko up cho em bản Fix lỗi, Em lấy j để Test đây ???

Bạn lấy code ở bài viết số 10