Nhờ Sửa Cách Tính Diện Tích Của Lisp (Từ Tạo Boundary Thành Hatch)

[Superlong 9]

 

 

đây là lisp độ lại từ lisp của diễn đàn tính diện tích cho trắc ngang theo lớp có phân biệt lý trình  tuy nhiên cách tính diện tích của lisp này là tạo boundary mình muốn nhờ sửa lại cách tính diện tích = hatch  và giữ lại vùng hatch đó luôn để sau này tiện đối chiếu khối lượng với tư vấn giám sát vì nếu tính theo cách tạo boundary nếu giữ lại các đường bao thì khi pick nhìu vùng thì nó tạo các đường bao độc lập sau này tư vấn nó kiểm tra phải cộng lại còn hatch nó đồng nhất kiểm tra tiện hơn

 

http://www.cadviet.com/upfiles/5/150337_block_1.dwg

(Defun c:tdt()

(setvar "cmdecho" 0)

(initget "Heso Do")

(setq

cn (getstring "\nNh\U+1EADp th\U+1EE9 t\U+1EF1 l\U+1EDBp <1>: " T))

(if (not sc3) (setq sc3 2))

(setq sc1 (getreal (strcat "\nChi\U+1EC1u cao Text <")))

(if (not sc1) (setq sc1 sc3) (setq sc3 sc1))

(setq sc9 (cdr (assoc 1 (entget (car (entsel "\nChon Text Ly Trinh: "))))))

(if (not dn) (setq dn 1))

(if (= cn "") (setq cn "0"))

(setq c (vl-string-right-trim "0 1 2 3 4 5 6 7 8 9" cn))

(setq n (vl-string-subst "" c cn))

 

(while

(setq pt (getpoint "\n chon diem:"))

(if (= pt "Heso")

(progn

(setq am (getreal "\n loccoc259.co.cc : "))

(if (and (null am) (/= ac 0))

(setq am ac)

)

(setq pt (getpoint "\n Chon diem: "))

)

(setq ac am))

 

(if (or (= am 0) (null am)) (setq am 1))

(setq s 0)

(progn

; (setq pt (getpoint "\n Chon diem: "))

(while pt

(setq entold (cdr (assoc 5 (entget (entlast)))))

(command "BOUNDARY" pt "")

(setq entnew (cdr (assoc 5 (entget (entlast)))))

(if (/= entold entnew)

(progn

(setq entnew (entget (entlast)))

(if (assoc 62 entnew)

(setq entnew (subst (cons 62 (+ 3 (cdr (assoc 62 entnew)))) (assoc 62 entnew) entnew))

(setq entnew (append entnew (list (cons 62 (+ 3 (cdr (assoc 62 (tblsearch "layer" (cdr (assoc 8

 

entnew))))))))))

)

(entmod entnew)

(Command "area" "o" (entlast))

(setq s (+ s (getvar "area")))

(setq pt (getpoint "\n Chon diem: "))

(entdel (entlast))

)

(progn

(princ "chon diem sai")

(setq pt (getpoint "\n Chon diem: "))

)

)

)

 

)

 

"(command "" "")"

 

(princ (* s am))

(princ)

(if (not (tblsearch "block" "DIENTICHL"))

(progn (command "insert" "D:\\Lisp CAD\\BLOCK.dwg" 0 "" "" "")

(command "erase" (entlast) "")))

(setq p (getpoint "\n\U+0110i\U+1EC3m ch\U+00E8n : "))

(if (= n "")

(setq cn (incC cn))

(setq cn (strcat c (incN (vl-string-subst "" c cn) dn)))

)

(setq

dat (entget (entlast))

dat (subst (cons 1 cn) (assoc 1 dat) dat)

)

(setq dt1 (* s am 1 1))

(setq dt (/ dt1 1))

(setq dt (strcat (rtos dt 2 3)))

(command "INSERT" "DIENTICHL" p sc1 sc1 "0" sc9 cn dt)

)

)

 

)