Nhờ các anh chị em sửa giúp lisp không cần nhập lựa chọn

[nguyenxuanbien1994 2]

Em sưu tầm được 2 file lisp. Do không biết tý gì về lập trình nên mạn phép đăng bài nhờ các anh chị sửa giúp hai con lisp này. 

Nội dung lệnh đang dùng và cần sửa em có để trong file ảnh để tiện xem cho được cụ thể.

https://drive.google.com/file/d/1BX8hdvryGpKB_R4cHRXtjvETPvF_eER0/view?usp=sharing

https://drive.google.com/file/d/1t6ORV430EccWKX5Z0Yo3P1pKSN5lRBuS/view?usp=drive_link

Hoặc 2 file lisp đây ạ:

_XYcoordinates.LSP

hinh chieu dung hcd.lsp

Em xin cảm ơn. 

 

Chỉnh sửa Tháng 5 7 theo nguyenxuanbien1994
thừa ảnh

[Doan Van Ha 3.202]

Tham lam quá + Nhiêu khê quá >> Ca này khó rồi

[amateurday 16]

Hề hề. Bài này tớ thường dùng 2 lisp LINE và MATCHPROP. Với các bác viết lisp khác thì không khó, chỉ cần có lý do.

[nguyenxuanbien1994 2]

3 giờ trước, Doan Van Ha đã nói:

Tham lam quá + Nhiêu khê quá >> Ca này khó rồi

Em vẽ hai lisp này thấy bất tiện hơn là vẽ thủ công.

Có cách nào cắt bớt lisp không anh. Em theo dõi anh có nhiều lisp hay nhưng em bên mảng cơ khí đột dập lại hiếm lisp quá.

 

[nguyenxuanbien1994 2]

1 giờ trước, amateurday đã nói:

Hề hề. Bài này tớ thường dùng 2 lisp LINE và MATCHPROP. Với các bác viết lisp khác thì không khó, chỉ cần có lý do.

Em đang tìm hiểu macro. Không biết có ứng dụng gì được không. 
 

 

[cuongtk2 356]

Đây:

(defun c:hinhchieudung ( / A1 ANG CV1 DIST ENT OBJ P1 P1A P2 P2A PARAM PEND PG1 PG2 PT PT1)
(setq obj (vlax-ename->vla-object (car (entsel "\nPick entity lay chieu dung:"))))
(vla-getBoundingBox obj 'p1 'p2)
(setq p1 (vlax-safearray->list p1)
      p2 (vlax-safearray->list p2))
(setq p1a (polar p1 (* pi 0.5) 1)
      p2a (polar p2 (* pi 0.5) 1))

(setq cv1 (entsel "\nPick start duong giong:")
      ent (car cv1)
      pt (cadr cv1)
      obj (vlax-ename->vla-object ent)
      pt (vlax-curve-getclosestpointto obj pt nil)
      param (vlax-curve-getParamAtPoint obj pt)
      ang (vlax-curve-getFirstDeriv obj param)
      ang (atan (/ (cadr ang) (car ang)))
      pt1 (polar pt ang 1)
      )
(setq pg1 (INTERS p1 p1a pt pt1 nil)
      pg2 (INTERS p2 p2a pt pt1 nil))
(setq pend (getpoint "\nEnd duong giong" pt)
      a1 (angle pt pend)
      dist (distance pt pend))
(entmake (list (cons 0 "LINE") (cons 10 pg1) (cons 11 (polar pg1 a1 dist))))
(entmake (list (cons 0 "LINE") (cons 10 pg2) (cons 11 (polar pg2 a1 dist))))
  )

 

[cuongtk2 356]

Sử dụng:

[nguyenxuanbien1994 2]

39 phút trước, cuongtk2 đã nói:

Đây:

(defun c:hinhchieudung ( / A1 ANG CV1 DIST ENT OBJ P1 P1A P2 P2A PARAM PEND PG1 PG2 PT PT1)
(setq obj (vlax-ename->vla-object (car (entsel "\nPick entity lay chieu dung:"))))
(vla-getBoundingBox obj 'p1 'p2)
(setq p1 (vlax-safearray->list p1)
      p2 (vlax-safearray->list p2))
(setq p1a (polar p1 (* pi 0.5) 1)
      p2a (polar p2 (* pi 0.5) 1))

(setq cv1 (entsel "\nPick start duong giong:")
      ent (car cv1)
      pt (cadr cv1)
      obj (vlax-ename->vla-object ent)
      pt (vlax-curve-getclosestpointto obj pt nil)
      param (vlax-curve-getParamAtPoint obj pt)
      ang (vlax-curve-getFirstDeriv obj param)
      ang (atan (/ (cadr ang) (car ang)))
      pt1 (polar pt ang 1)
      )
(setq pg1 (INTERS p1 p1a pt pt1 nil)
      pg2 (INTERS p2 p2a pt pt1 nil))
(setq pend (getpoint "\nEnd duong giong" pt)
      a1 (angle pt pend)
      dist (distance pt pend))
(entmake (list (cons 0 "LINE") (cons 10 pg1) (cons 11 (polar pg1 a1 dist))))
(entmake (list (cons 0 "LINE") (cons 10 pg2) (cons 11 (polar pg2 a1 dist))))
  )

 

Dạ em cảm ơn anh nhiều ạ. Đúng 2 trong 1 luôn. 

Anh có thể giúp em bổ sung thêm đường center của circle được không ạ, với có thể quét vùng chọn cho các circle, polyline thì càng tốt.

Chúc anh và gia đình nhiều sức khỏe. 

 

[cuongtk2 356]

Làm từng cái mới kiểm soát tốt, đừng tham nhiều dễ sai.

[nguyenxuanbien1994 2]

3 giờ trước, cuongtk2 đã nói:

Làm từng cái mới kiểm soát tốt, đừng tham nhiều dễ sai.

vâng ạ.