đo khoảng cách từ đoạn thẳng 1 kéo dài đến đoạn thẳng 2

[Hoangnhanst 12]

do yêu cầu công việc lập đi lập lại tốn rất nhiều thời gian nên mong được mn giúp đở nha!

em co 1 đoạn thẳng(line)(thanh sắt) và 1 khung(pline) bất kì. em muốn đo khoảng cách từ đoạn thẳng đến khung để nối dài thêm thanh sắt, rồi +- một số a bất kì nào đó, a nhập vào lúc đầu

em ko rành diễn giải mong mn thông cảm a!

 

test.dwg

[CadExTools 102]

đoạn Line có 2 đầu, bạn muốn kéo dài đầu nào?

Sau khi tính toán được giá trị đó, thì bạn muốn làm gì nữa?

 

[Hoangnhanst 12]

36 phút trước, CadExTools đã nói:

đoạn Line có 2 đầu, bạn muốn kéo dài đầu nào?

Sau khi tính toán được giá trị đó, thì bạn muốn làm gì nữa?

 

thank b!

mình có mô tả trong cad đính kèm ak

đo đầu gần nhất đến khung, sau đó lấy kích thước đó trừ cho 1 số bất kì rồi ghi kích thước tính dc lên vị trí cần đo

[Hoangnhanst 12]

mong được mn giúp đỡ.

 

thank mn nhiều

[thanhduan2407 272]

Mình viết hơi dài nhưng tạm dùng

(defun C:00 (/ A DELTA LTSINTERS LTSSORT OBJKHUNG OBJLINE P1 P1A P1B P2	P2A P2B	PMID S1	S2 VBADIM )
  (defun *error* (msg)
    (if	Olmode
      (setvar 'osmode Olmode)
    )
    (if	(not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )
  (setq Olmode (getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setq	ObjKhung
	 (car
	   (LM:SelectIf
	     "\nCh\U+1ECDn khung: "
	     (lambda (x) (eq "LWPOLYLINE" (cdr (assoc 0 (entget (car x))))))
	     entsel
	     nil
	   )
	 )
  )
  (setq	ObjLine
	 (car
	   (LM:SelectIf
	     "\nCh\U+1ECDn Line: "
	     (lambda (x) (eq "LINE" (cdr (assoc 0 (entget (car x))))))
	     entsel
	     nil
	   )
	 )
  )
  (setq	Delta (LM:GetXWithDefault
		getdist
		"\nNh\U+1EADp s\U+1ED1 b\U+1ECB tr\U+1EEB: "
		'*Delta*
		5.0
	      )
  )
  (setq P1A (cdr (assoc 10 (entget ObjLine))))
  (setq P2A (cdr (assoc 11 (entget ObjLine))))
  (setq	LtsInters (LM:Intersections
		    (vlax-ename->vla-object ObjLine)
		    (vlax-ename->vla-object ObjKhung)
		    acextendthisentity
		  )
  )
  (setq LtsSort (SortAB (append LtsInters (list P1A P2A))))
  (if (< (vl-position P1A LtsSort) (vl-position P2A LtsSort))
    (progn
      (setq P1 P1A)
      (setq P2 P2A)
    )
    (progn
      (setq P1 P2A)
      (setq P2 P1A)
    )
  )
  (if (/= (vl-position P1 LtsSort) 0)
    (progn
      (setq P1B (nth (- (vl-position P1 LtsSort) 1) LtsSort))
      (setq P2B (nth (+ (vl-position P2 LtsSort) 1) LtsSort))
      (setq S1 (distance P1 P1B))
      (setq S2 (distance P2 P2B))
      (if (< S1 S2)
	(progn

	  (setq Pmid (mid2Pnt P1 P1B))
	  (makedimrot P1 P1B Pmid (GochuongBac P1 P1B))
	  (setq VbaDIM (vlax-ename->vla-object (entlast)))
	  (setq a (- (vla-get-Measurement VbaDIM) Delta))
	  (vla-put-TextOverride VbaDIM (rtos a 2 2))
	)
	(progn
	  (setq Pmid (mid2Pnt P2 P2B))
	  (makedimrot P2 P2B Pmid (GochuongBac P2 P2B))
	  (setq VbaDIM (vlax-ename->vla-object (entlast)))
	  (setq a (- (vla-get-Measurement VbaDIM) Delta))
	  (vla-put-TextOverride VbaDIM (rtos a 2 2))
	)
      )
    )
  )
  (setvar "OSMODE" Olmode)
  (princ)
)

(defun makedimrot (p1 p2 locpt dimang / elist)
  (setq	elist (list
		'(0 . "DIMENSION")
		'(100 . "AcDbEntity")
		(cons '8 (getvar "clayer"))
		'(100 . "AcDbDimension")
		(cons '10 locpt)
		'(11 0.0 0.0 0.0)
		'(12 0.0 0.0 0.0)
		'(70 . 32)
		'(52 . 0.0)
		'(53 . 0.0)
		'(54 . 0.0)
		'(51 . 0.0)
		'(210 0.0 0.0 1.0)
		(cons '3 (getvar "dimstyle"))
		'(100 . "AcDbAlignedDimension")
		(cons '13 p1)
		(cons '14 p2)
		(cons '50 dimang)
		'(100 . "AcDbRotatedDimension")
	      )
  )
  (entmake elist)
)

(defun mid2Pnt (p1 p2)
  (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.0)) p1 p2)
)
(defun GochuongBac (P1 P2 / Goc)
  (setq Goc (angle P1 P2))
  (if (or (<= 0 Goc (/ pi 2))
	  (<= (/ (* 3 pi) 2) Goc (* 2 pi))
      )
    (setq GocOK Goc)
    (setq GocOK (+ Goc pi))
  )
  GocOK
)
(defun MakeText
		(point string Height Ang justify Layer Style Color / Lst)
							    ; Ang: Radial
  (setq	Lst	(list '(0 . "TEXT")
		      (cons 10 point)
		      (cons 40 Height)
		      (cons 8
			    (if	Layer
			      Layer
			      (getvar "CLAYER")
			    )
		      )
		      (cons 1 string)
		      (if Ang
			(cons 50 Ang)
		      )
		      (cons 7
			    (if	Style
			      Style
			      (getvar "Textstyle")
			    )
		      )
		      (cons 62
			    (if	Color
			      Color
			      256
			    )
		      )
		)
	justify	(strcase justify)
  )
  (cond
    ((= justify "C")
     (setq Lst (append Lst (list (cons 72 1) (cons 11 point))))
    )
    ((= justify "L")
     (setq
       Lst
	(append Lst (list (cons 72 0) (cons 73 0) (cons 10 point)))
     )
    )
    ((= justify "R")
     (setq Lst (append Lst (list (cons 72 2) (cons 11 point))))
    )
    ((= justify "M")
     (setq Lst (append Lst (list (cons 72 4) (cons 11 point))))
    )
    ((= justify "TL")
     (setq
       Lst
	(append Lst (list (cons 72 0) (cons 11 point) (cons 73 3)))
     )
    )
    ((= justify "TC")
     (setq
       Lst
	(append Lst (list (cons 72 1) (cons 11 point) (cons 73 3)))
     )
    )
    ((= justify "TR")
     (setq
       Lst
	(append Lst (list (cons 72 2) (cons 11 point) (cons 73 3)))
     )
    )
    ((= justify "ML")
     (setq
       Lst
	(append Lst (list (cons 72 0) (cons 11 point) (cons 73 2)))
     )
    )
    ((= justify "MC")
     (setq
       Lst
	(append Lst (list (cons 72 1) (cons 11 point) (cons 73 2)))
     )
    )
    ((= justify "MR")
     (setq
       Lst
	(append Lst (list (cons 72 2) (cons 11 point) (cons 73 2)))
     )
    )
    ((= justify "BL")
     (setq
       Lst
	(append Lst (list (cons 72 0) (cons 11 point) (cons 73 1)))
     )
    )
    ((= justify "BC")
     (setq
       Lst
	(append Lst (list (cons 72 1) (cons 11 point) (cons 73 1)))
     )
    )
    ((= justify "BR")
     (setq
       Lst
	(append Lst (list (cons 72 2) (cons 11 point) (cons 73 1)))
     )
    )
  )
  (entmakex Lst)
)
(defun SortAB (lstPnt /)
  (setq	Lts-Sort
	 (vl-sort (vl-sort lstPnt
			   '(lambda (e1 e2) (< (cadr e1) (cadr e2)))
		  )
		  '(lambda (e1 e2) (< (car e1) (car e2)))
	 )
  )
  Lts-Sort
)
(defun LM:Intersections	(obj1 obj2 mode / l r)
  (setq l (vlax-invoke obj1 'intersectwith obj2 mode))
  (repeat (/ (length l) 3)
    (setq r (cons (list (car l) (cadr l) (caddr l)) r)
	  l (cdddr l)
    )
  )
  (reverse r)
)
(defun LM:SelectIf (msg pred func keyw / sel)
  (setq pred (eval pred))
  (while
    (progn
      (setvar 'ERRNO 0)
      (if keyw
	(apply 'initget keyw)
      )
      (setq sel (func msg))
      (cond
	((= 7 (getvar 'ERRNO))
	 (princ
	   "\nB\U+1EA1n ch\U+1ECDn sai r\U+1ED3i! H\U+00E3y ch\U+1ECDn l\U+1EA1i."
	 )
	)
	((eq 'STR (type sel))
	 nil
	)
	((vl-consp sel)
	 (if (and pred (not (pred sel)))
	   (princ "")
	 )
	)
      )
    )
  )
  sel
)
(defun LM:GetXWithDefault (_function _prompt _symbol _default / _toString)
  ;; © Lee Mac 2010

  (setq	_toString
	 (lambda (x)
	   (cond
	     ((eq getangle _function) (angtos x))
	     ((eq 'REAL (type x)) (rtos x))
	     ((eq 'INT (type x)) (itoa x))
	     (x)
	   )
	 )
  )

  (set _symbol
       (
	(lambda	(input)
	  (if (or (not input) (eq "" input))
	    (eval _symbol)
	    input
	  )
	)
	 (_function (strcat _prompt
			    "<"
			    (_toString (set _symbol
					    (cond ((eval _symbol))
						  (_default)
					    )
				       )
			    )
			    "> : "
		    )
	 )
       )
  )
)

 

[Danh Cong 422]

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

Mong được giúp đỡ

 

thank mn nhiều!

Tôi góp ý thôi ^^

Yêu cầu của bạn đừng nên mang tính cá nhân quá :))

Bạn nên tách ra,lisp 1 là đo vuông góc, lisp 2 chọn các Dim rồi trừ đi 1 số.

Rõ ràng 2 lisp sẽ có nhiều người sử dụng hơn là gộp cả 2 để phục vụ mỗi bạn :)))