Hỏi Cách Lồng Lệnh Extrim Vào Lisp

[Superlong 9]

bình thường khi muốn lồng 1 lệnh nào đó vào thì mình dùng (command "tên lệnh" ..... các thuộc tính của lệnh ) nhưng không làm được với lệnh extrim mặc dù gõ lệnh ở ngoài thì vẫn ok . nếu viết trong lisp là (c:extrim) thì vẫn phải làm thủ công các bước chọn boundary và phía trim vì không lồng được câu lệnh (c:extrim boundary phiatrim) với các biến boudary và phiatrim đã được gán trước đó
còn dùng với (etrim ...) thì thường hay lỗi xoá luôn 1 vài đối tượng bên trong boudary mặc dù chọn phía trim là bên ngoài
các tiền bối autolisp có kinh nghiệm về khoảng này không gợi ý em với

[Doan Van Ha 3.201]

Bạn tham khảo lisp này (của ai quên mất) rồi tự nghiên cứu thôi. HỌC HỎI là tốt nhưng HỌC nhiều thì tốt hơn HỎI nhiều.

 

;----- Trim and Delete outside of closed polyline (C¾t vµ xo¸ phÇn bªn ngoµi cña 1 polyline ®ãng).
; Required Express tools. OutSide Contour Delete with Extrim.
(defun C:OCD (  / en ss lst ssall bbox)
 (vl-load-com)
 (if (and (setq en (car (entsel "\nSelect contour (polyline): ")))
               (wcmatch (cdr (assoc 0 (entget en))) "*POLYLINE"))
  (progn
   (setq bbox (ACET-ENT-GEOMEXTENTS en))
   (setq bbox (mapcar '(lambda(x)(trans x 0 1)) bbox))
   (setq lst (ACET-GEOM-OBJECT-POINT-LIST en 1e-3))
   (ACET-SS-ZOOM-EXTENTS (ACET-LIST-TO-SS (list en)))
   (command "_.Zoom" "0.95x")
   (if (null etrim) (load "extrim.lsp"))
   (etrim en (polar (car bbox) (angle (car bbox) (cadr bbox)) (* (distance (car bbox)(cadr bbox)) 1.1)))
   (if (and
         (setq ss (ssget "_CP" lst))
         (setq ssall (ssget "_X" (list (assoc 410 (entget en))))))
    (progn
     (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
     (foreach e1 lst (ssdel e1 ssall))
      (ACET-SS-ENTDEL ssall))))))
(princ "\nType OCD to start")
(princ)

[Superlong 9]

sẳn cho em hỏi 1 vấn đề về tọa độ trong cad
vd em getpoint chọn 1 điểm trên màn hình

xong dùng (car en)  để lấy tọa độ x (cadr en) để lấy y

xong em + tọa độ x đó cho 1 đơn vị và tạo ra 1 điểm mới là (list (+ x 1) y 0) thì điểm mới này ra tọa độ rất lung tung mặc dù điểm mới em vẫn giữ nguyên tọa độ là y nhưng kết quả trả về tọa độ y mới củng đã được + và kết quả của x mới củng không phải = x+1 bác giải thích giúp em được không

[Doan Van Ha 3.201]

Hỏi lủng củng. Đưa lisp lên xem.

[Superlong 9]

đây là lisp vẽ đường phân lớp theo độ dốc nhưng sau khi tạo các đường dốc xong em muốn cho nó vẽ thêm 1 đường pline ở dưới đáy nửa nên lấy toạ độ x của điểm end + 1  và giữ nguyên y ra điểm thứ 1  sau đó lấy x của end -1 giữ nguyên y thành điểm thứ 3 điểm thứ 2 chính là end để vẽ thì nó nhãy loạn cả lên

em nghĩ do ãnh hưởng của hàm nào đó trong lisp này vì ở công đoạn vẽ pline theo độ dốc lisp vẫn tính toán ra kết quả đúng

(vl-load-all "C:/Program Files/AutoCAD 2010/Express/extrim.lsp")
(defun c:tpl ()
(setq s1 (entsel "\nCh\U+1ECDn \U+0111\U+01B0\U+1EDDng bao"))
(setq dinh (getpoint "\nCh\U+1ECDn \U+0111\U+1EC9nh")
end (getpoint "\nCh\U+1ECDn \U+0111\U+00E1y"))
(setq dodoc (getreal "\nNh\U+1EADp \U+0111\U+1ED9 d\U+1ED1c c\U+1EE7a \U+0111\U+01B0\U+1EDDng ph\U+00E2n l\U+1EDBp i%: ")
ydinh (cadr dinh)
yend (cadr end)
xdinh (car dinh)
xend (car end)
xtdpl1 (- xdinh 100)
xtdpl2 (+ xdinh 100)
ytdpl (- ydinh DODOC)
dpl1 (list xtdpl1 ytdpl 0)
dpl2 (list xtdpl2 ytdpl 0)
kc (abs(- ydinh yend))
h (getreal "\nNh\U+1EADp b\U+1EC1 d\U+00E0y ph\U+00E2n l\U+1EDBp : ")
nl1 (ATOI (RTOS (/ kc h) 2 0))
nl2 (/ kc h))
(if (> nl1 nl2) (setq nl (- nl1 1 )))
(if (< nl1 nl2) (setq nl nl1))
(setq kr (strcase (getstring "\nCh\U+1ECDn h\U+01B0\U+1EDBng r\U+1EA3i-Tr\U+00EAn xu\U+1ED1ng/D\U+01B0\U+1EDBi l\U+00EAn: ")))
(if (= kr "T") (setq h1 (* h -1)))
(if (= kr "D") (setq h1 h))

(setq phud (entlast))
(command "pline" dpl1 dinh dpl2 "" "")
(setq ss (entlast))
(command "array" ss "" "r" (+ 1 nl) "1" h1)
(setq da (entlast))



(setq pt2 (nth 0 (acet-geom-vertex-list da)))
(setq pt3 (nth 2 (acet-geom-vertex-list da)))
(setq pt4 (+ (car dinh) 2))
(setq pt1 (- (car dinh) 2)
pt5 (list pt4 (+(nth 1 dinh) 0.1) 0)

pt6 (list pt1 (+(nth 1 dinh) 0.1) 0)
goc (list 0 0 0))

(command "extend" s1 "" "f" pt6 pt2)
(command "" "f" pt3 pt5 "" "")
(vl-load-all "C:/Program Files/AutoCAD 2010/Express/extrim.lsp")

(setq
xcut1 (+ (CAR (NTH 0 (acet-geom-vertex-list da))) 1)
xcut2 (- (CAR (NTH 2 (acet-geom-vertex-list da))) 1)
)
(IF (= KR "T")
(SETQ
PCUT1 (LIST XCUT1 YDINH)
PCUT2 (LIST XCUT1 (- YEND 100))
PCUT3 (LIST XCUT2 YDINH)
PCUT4 (LIST XCUT2 (- YEND 100))
))
(IF (= KR "D")
(SETQ
PCUT1 (LIST XCUT1 (- YDINH 100))
PCUT2 (LIST XCUT1 (+ YEND 100))
PCUT3 (LIST XCUT2 (- YDINH 100))
PCUT4 (LIST XCUT2 (+ YEND 100))
))

(COMMAND "_.TRIM" (CAR S1) "" "F" PCUT1 PCUT2 "" "F" PCUT3 PCUT4 "" "")
(setq xphut1 (- xend 5)
xphut2 (+ xend 5)
phut1 (list xphut1 yend 0)
phut2 (list xphut2 yend 0))
(command "pline" phut1 end phut2 "" "")

)

[Doan Van Ha 3.201]

Kết thúc!

[Superlong 9]

 

Bạn tham khảo lisp này (của ai quên mất) rồi tự nghiên cứu thôi. HỌC HỎI là tốt nhưng HỌC nhiều thì tốt hơn HỎI nhiều.

;----- Trim and Delete outside of closed polyline (C¾t vµ xo¸ phÇn bªn ngoµi cña 1 polyline ®ãng).
; Required Express tools. OutSide Contour Delete with Extrim.
(defun C:OCD (  / en ss lst ssall bbox)
 (vl-load-com)
 (if (and (setq en (car (entsel "\nSelect contour (polyline): ")))
               (wcmatch (cdr (assoc 0 (entget en))) "*POLYLINE"))
  (progn
   (setq bbox (ACET-ENT-GEOMEXTENTS en))
   (setq bbox (mapcar '(lambda(x)(trans x 0 1)) bbox))
   (setq lst (ACET-GEOM-OBJECT-POINT-LIST en 1e-3))
   (ACET-SS-ZOOM-EXTENTS (ACET-LIST-TO-SS (list en)))
   (command "_.Zoom" "0.95x")
   (if (null etrim) (load "extrim.lsp"))
   (etrim en (polar (car bbox) (angle (car bbox) (cadr bbox)) (* (distance (car bbox)(cadr bbox)) 1.1)))
   (if (and
         (setq ss (ssget "_CP" lst))
         (setq ssall (ssget "_X" (list (assoc 410 (entget en))))))
    (progn
     (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
     (foreach e1 lst (ssdel e1 ssall))
      (ACET-SS-ENTDEL ssall))))))
(princ "\nType OCD to start")
(princ)

 lisp này cách thức của nó vẫn là dùng etrim  và xãy ra lỗi như đầu bài mình đã đề cập cái mình cần hỏi là làm sao lồng extrim vào nếu trong lisp gõ dòng lệnh (c:extrim) thì nó vẫn thực hiện lệnh tuy nhiên kế tiếp yêu cầu select object và chọn side to trim không thể thực hiện = 1 câu lệnh được , gõ vd: (setq ss (entsel "\n Chon boundary để trim")

pt (getpoint "\n CHỌN PHÍA TRIM"))

(etrim (car ss) pt)

thì cad nó hiểu nhưng bị lỗi hay xóa luôn 1 vài pline bên trong boundary mặc dù getpoint là bên ngoài

 

còn gõ

(setq ss (entsel "\n Chon boundary để trim")

pt (getpoint "\n CHỌN PHÍA TRIM"))

(c:extrim (car ss) pt) thì báo bad function many argument