trích do

Tháng 9 28, 2009

Cám ơn Anh Thiep nha.

Lisp của anh thể hiện hết sức tuyệt, Rất có ích .

Anh viết thêm cho phần tăng/ giãm theo yên cầu trích thửa của tỉ lệ bản đồ đi.

Lisp hỏi Bản đồ gốc tỉ lệ bao nhiêu ?

Trích ra tỉ lệ bao nhiêu ? Kết qủa Ghi ra ghi chú ở phần dưới giữa khung phía nam tỉ lệ trích.

Rất mong được anh giúp.

Tháng 9 29, 2009

Chào khaosat2009, Lisp cwb của bác Gia_bach viết rất tuyệt vời khi copy, xóa, move các đối tượng trong ngoài 1 vùng kín, hay giữa 2 vùng kín. Tuy nhiên, các đối tượng gốc bị bẻ gãy hết. Lisp Thiep viết sau đây sẽ trích thửa bản đồ, theo 1 ô vuông có kích thước cạnh do user tự chọn.
Sau khi tạo ô vuông xong, user rê ô vuông này vào khu vực cần trích thửa, nó sẽ copy các đối tượng bên trong và giao với ô vuông (ô vuông giống như 1 nam châm). Sau đó, user rê các đối tượng này đến vị trí cần đặt, ví dụ đặt ở giữa bản vẽ TRÍCH ĐO ĐỊA CHÍNH THỬA ĐẤT. Lisp sẽ cắt bỏ những đường bên ngoài ô vuông.

Chào bạn khaosat 2009,

Hề hề, đúng như mình dự đoán các bác ấy mà rảnh tay là giúp bạn rất nhanh mà. Riêng mình do cái trình độ lisp còn hơi lùn nên loay hoay mãi bữa nay mới ra được cái coi có vẻ dùng được. Nhưng có lẽ có lỗi như bác Thiep đã nói là nó sẽ bẻ vụn các đường biên có giao với biên vùng chọn. Việc khắc phục cái lỗi này thì mình chưa nghĩ ra biện pháp nào hay hơn ngoài việc copy thằng cu gốc ra một file khác để xử lý nó cho khỏi bận tâm tới bản gốc nữa.

Hiện tại lisp này mình chỉ dừng ở việc copy cái khung có chứa thửa đất của bạn vào cilpboard, còn việc paste nó vào đâu là tùy bạn nhé. Do chưa rõ nó đã đạt yêu cầu của bạn chưa nên mình chưa giải quyết tiếp các việc như đánh số các góc ranh, ghi chiều dài các cạnh thửa đất, lập bảng tọa độ góc ranh ....... Những điều này không khó lắm nữa khi đã có cái lisp lần trước mình gửi. Việc chỉnh sửa và bổ sung nó vào cái lisp mới này nếu bạn có thể tự làm được thì quá tốt, còn không thì mình có thể giúp bạn sau nhé.

Bạn hãy xem thử cái kết quả của lisp này đã trúng ý bạn chưa nhé. Cần chỉnh sửa gì thì bạn cứ mạnh dạn cho mình biết để mình suy nghĩ thêm.

Lisp đây bạn:

http://www.cadviet.com/upfiles/2/trichdonew.lsp

Và đây là một cái kết quả mà mình đã chạy thử:

http://www.cadviet.com/upfiles/2/dc_4f135ivdm.dwg

Chúc bạn luôn vui.

Tháng 9 30, 2009

Chào khaosat2009, Lisp cwb của bác Gia_bach viết rất tuyệt vời khi copy, xóa, move các đối tượng trong ngoài 1 vùng kín, hay giữa 2 vùng kín. Tuy nhiên, các đối tượng gốc bị bẻ gãy hết. Lisp Thiep viết sau đây sẽ trích thửa bản đồ, theo 1 ô vuông có kích thước cạnh do user tự chọn.

Sau khi tạo ô vuông xong, user rê ô vuông này vào khu vực cần trích thửa, nó sẽ copy các đối tượng bên trong và giao với ô vuông (ô vuông giống như 1 nam châm). Sau đó, user rê các đối tượng này đến vị trí cần đặt, ví dụ đặt ở giữa bản vẽ TRÍCH ĐO ĐỊA CHÍNH THỬA ĐẤT. Lisp sẽ cắt bỏ những đường bên ngoài ô vuông.

;;;-----------------------
(defun SS-enlst	(ss / c L)
 (setq c -1)
 (repeat (sslength ss)
   (setq L (cons (ssname ss (setq c (1+ c))) L))
 )
 (reverse L)
)
;;;====================================================================
(defun break_with (Lstent enL /	lst masterlist ss oc break_obj intpts)
 (princ "\nCalculating Break Points, Please Wait.\n")

 ;;========================================
 ;; Break entity at break points in list
 ;;========================================

 (defun break_obj (ent	brkptlst   /	      brkobjlst	 en
		enttype	   maxparam   closedobj	 minparam
		obj	   obj2break  p1param	 p2param
		brkpt2	   dlst	      idx	 brkptS
		brkptE	   brkpt      result	 result
		ignore	   dist	      tmppt	 #ofpts
		enddist	   lastent    obj2break	 stdist
	       )
    (setq obj2break ent
   brkobjlst (list ent)
   enttype   (dxf 0 ent)
    )
   (if	(not (or (eq (dxf 0 obj2break) "TEXT")
	 (eq (dxf 0 obj2break) "MTEXT")
     )
)
     (setq closedobj (vlax-curve-isclosed obj2break))
   )
   (setq spt (vlax-curve-getstartpoint ent)
ept (vlax-curve-getendpoint ent)
brkptlst (vl-remove-if
'(lambda (x)
(or (< (distance x spt) 0.0001)
(< (distance x ept) 0.0001)
)
)
brkptlst
)
)
   (if	(and brkptlst
     (not (or (eq (dxf 0 obj2break) "TEXT")
	      (eq (dxf 0 obj2break) "MTEXT")
	  )
     )
)
     (progn
(setq brkptlst
       (mapcar
	 '(lambda (x)
	    (list
	      x
	      (vlax-curve-getdistatparam
		obj2break
		(cond
		  ((vlax-curve-getparamatpoint obj2break x)
		  )
		  ((vlax-curve-getparamatpoint
		     obj2break
		     (vlax-curve-getclosestpointto
		       obj2break
		       x
		     )
		   )
		  )
		)
	      )
	    )
	  )
	 brkptlst
       )
)

(setq
  brkptlst (vl-sort brkptlst
		    '(lambda (a1 a2) (< (cadr a1) (cadr a2)))
	   )
)

(foreach brkpt (reverse brkptlst)
    (setq brkptS (car brkpt)
	  brkptE brkptS
    )
  ;; get last entity created via break in case multiple breaks
  (if brkobjlst
    (progn
      (setq tmppt brkptS)	; use only one of the pair of breakpoints
      ;; if pt not on object x, switch objects
      (if (not (numberp	(vl-catch-all-apply
			  'vlax-curve-getdistatpoint
			  (list obj2break tmppt)
			)
	       )
	  )
	(progn			; find the one that pt is on
	  (setq idx (length brkobjlst))
	  (while
	    (and (not (minusp (setq idx (1- idx))))
		 (setq obj (nth idx brkobjlst))
		 (if (numberp (vl-catch-all-apply
				'vlax-curve-getdistatpoint
				(list obj tmppt)
			      )
		     )
		   (null (setq obj2break obj))
				; switch objects, null causes exit
		   t
		 )
	    )
	  )
	)
      )
    )
  ); end (if brkobjlst

  ;;; Handle any objects that can not be used with the Break Command
  ;;; using one point, gap of 0.000001 is used
  (if (not (or (eq (dxf 0 obj2break) "TEXT")
	       (eq (dxf 0 obj2break) "MTEXT")
	   )
      )
    (setq closedobj (vlax-curve-isclosed obj2break))
  )
;;; single breakpoint ----------------------------------------------------
    (if
      (and closedobj
	   (not	(setq
		  brkptE (vlax-curve-getPointAtDist
			   obj2break
			   (+ (vlax-curve-getdistatparam
				obj2break
				;;(vlax-curve-getparamatpoint obj2break brkpts)) 0.00001))))
				;; ver 2.0 fix
				(cond
				  ((vlax-curve-getparamatpoint
				     obj2break
				     brkpts
				   )
				  )
				  ((vlax-curve-getparamatpoint
				     obj2break
				     (vlax-curve-getclosestpointto
				       obj2break
				       brkpts
				     )
				   )
				  )
				)
			      )
			      0.00001
			   )
			 )
		)
	   )
      )
       (setq
	 brkptE	(vlax-curve-getPointAtDist
		  obj2break
		  (- (vlax-curve-getdistatparam
		       obj2break
		       (cond ((vlax-curve-getparamatpoint
				obj2break
				brkpts
			      )
			     )
			     ((vlax-curve-getparamatpoint
				obj2break
				(vlax-curve-getclosestpointto
				  obj2break
				  brkpts
				)
			      )
			     )
		       )
		     )
		     0.00001
		  )
		)
       ); end setq brkptE
    ); end fi (and closedobj

  ;; (if (null brkptE) (princ)) ; debug
  (setq LastEnt (GetLastEnt))
  (if (not (or (eq (dxf 0 obj2break) "TEXT")
	       (eq (dxf 0 obj2break) "MTEXT")
	   )
      )
    (command "._break"
	     obj2break
	     "_non"
	     (trans brkptS 0 1)
	     "_non"
	     (trans brkptE 0 1)
    )
  )
  (and (= "CIRCLE" enttype) (setq enttype "ARC"))
  (if (and (not closedobj)	; new object was created
	   (not (equal LastEnt (entlast)))
      )
    (setq brkobjlst (cons (entlast) brkobjlst))
  ); end (if (and
); end (foreach brkpt
     );end progn brkptlst
   ); end if brkptlst

 ); defun break_obj

 ;;====================================
 ;; CAB - get last entity in datatbase
 (defun GetLastEnt (/ ename result)
   (if	(setq result (entlast))
     (while (setq ename (entnext result))
(setq result ename)
     )
   )
   result
 )
 ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 ;; S T A R T              S U B R O U T I N E             H E R E
 ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(if (and Lstent enL)
   (progn
     ;; CREATE a list of entity & it's break points
     (foreach en Lstent
				; check each object in Lstent
(if (not (acet-layer-locked (dxf 8 en)))
  (progn
    (setq lst nil)
    ;; check for break pts with other objects in Lstentwith
    (if	(and (not (equal en enint))
	     (setq intpts (acet-geom-intersectwith en enL 0))
	)
      (setq lst (append intpts lst))
				; entity w/ break points
    )
    (if	lst
      (setq masterlist
	     (cons (cons en lst) masterlist)
      )
    )
  )
)
     )
     (princ "\nBreaking Objects.\n")
     (if masterlist
(foreach obj2brk masterlist
  (break_obj (car obj2brk) (cdr obj2brk))
)
     )
   )
 )
);end break_with
;;===========================================================================
;; get all objects touching entities in the sscross
;; limited obj types to "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"
;; returns a list of enames
;;===========================================================================
(defun gettouching (en / ss lst lstb lstc objl)
 (and
   (setq objl (vlax-ename->vla-object en))
   (setq
     ss
      (ssget
 "_A"
 (list
   (cons 0
	 "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"
   )
   (cons 410 (getvar "ctab"))
 )
      )
   )
   (setq lst (SS-enlst ss)
    lst (mapcar 'vlax-ename->vla-object lst))
   (mapcar
     '(lambda (x)
 (if (not
       (vl-catch-all-error-p
	 (vl-catch-all-apply
	   '(lambda ()
	      (vlax-safearray->list
		(vlax-variant-value
		  (vla-intersectwith objl x acextendnone)
		)
	      )
	    )
	 )
       )
     )
   (setq lstc (cons (vlax-vla-object->ename x) lstc))
 )
      )
     lst
   )
 )
 lstc
)
;;;------------------------------------------------
(defun LWP (Lpoint *Model* / PntArr)
 (setq	PntArr (vlax-make-safearray
	 vlax-vbDouble
	 (cons 0 (1- (length Lpoint)))
       )
 )
 (vlax-safearray-fill PntArr Lpoint)
 (vla-AddLightWeightPolyline *Model* PntArr)
)
;;;------------------------------------------------
(defun DXF (code en) (cdr (assoc code (entget en))))
;;;============================================================
;;;=======================MAIN LISP============================
;;;============================================================
(defun c:trichthua (/ ss p2 encur lstss1 emin emax p3 LenssBR)
 (setq	ActDoc	(vla-get-ActiveDocument (vlax-get-acad-object))
*Model*	(vla-get-ModelSpace ActDoc)
 )
 (vla-StartUndoMark ActDoc)
 (setq	a (cond	(a)
	(50)
  )
 )
 (setq olda a)
 (setq	a (getreal (strcat "\nChon kich thuoc cat hinh vuong cat <"
			   (rtos olda 2 1)
			   "> : ")))
 (if (null a) (setq a olda))
 (setq	emin (list (car (getvar "extmin")) (cadr (getvar "extmin"))))
 (setvar "cecolor" "104")
 (setq	lstp (list (car emin)
	   (cadr emin)
	   (+ (car emin) a)
	   (cadr emin)
	   (+ (car emin) a)
	   (+ (cadr emin) a)
	   (car emin)
	   (+ (cadr emin) a)
     )
 )
 (vla-put-closed (LWP lstp *Model*) :vlax-True)
 (setq ss (ssadd (entlast) (ssadd)))
 (setq	p2 (ACET-SS-DRAG-MOVE
     ss
     (list (car emin) (cadr emin))
     "Chon vi tri bat dau trich thua: "
   )
 )
 (command ".move" ss "" emin p2)
 (setq encur (entlast)
lstp (acet-geom-VERTEX-LIST encur))
 (setq ss (ssdel encur (ssget "_CP" lstp)))
 (command ".copy" ss "" p2 p2)
 (setq	p3 (ACET-SS-DRAG-MOVE
     (ssadd encur ss)
     p2
     "Chon vi tri dat ban do trich thua: "
   )
 )
 (command ".move" ss encur "" p2 p3)
 (setvar "cecolor" "0")
 (setq encur (ssname (ssget "X" '((62 . 104))) 0))
 (setq	lstobj1	(vl-remove encur (gettouching encur))
ss	(acet-list-to-ss lstobj1)
 )
 (acet-ss-zoom-extents ss)
 (break_with  lstobj1 encur)
 (vlax-invoke-method ActDoc 'Regen acActiveViewport)
 (vla-offset (vlax-ename->vla-object encur) (* (getvar "viewsize") 0.002))
 (setq lst3 (acet-geom-vertex-list (entlast)))
 (entdel (entlast))
 (setq	LenssBR	(SS-enlst (ssget "F" lst3)))
 (foreach x LenssBR
   (if	(or (not (eq (dxf 0 x) "TEXT"))
    (not (eq (dxf 0 x) "MTEXT"))
)
     (entdel x)
   )
 )
 (vla-EndUndoMark ActDoc)
 (princ "\nChuc cac ban gat hai nhieu thanh cong. Thiep")
)

Hiên nay mình chạy Lisp Của Bạn nó lại báo lỗi này :

displacement or :

Command: ; error: bad argument type: lselsetp Mong được Bạn giúp

Tháng 9 30, 2009

Chào bạn khaosat 2009,
Hề hề, đúng như mình dự đoán các bác ấy mà rảnh tay là giúp bạn rất nhanh mà. Riêng mình do cái trình độ lisp còn hơi lùn nên loay hoay mãi bữa nay mới ra được cái coi có vẻ dùng được. Nhưng có lẽ có lỗi như bác Thiep đã nói là nó sẽ bẻ vụn các đường biên có giao với biên vùng chọn. Việc khắc phục cái lỗi này thì mình chưa nghĩ ra biện pháp nào hay hơn ngoài việc copy thằng cu gốc ra một file khác để xử lý nó cho khỏi bận tâm tới bản gốc nữa.

Hiện tại lisp này mình chỉ dừng ở việc copy cái khung có chứa thửa đất của bạn vào cilpboard, còn việc paste nó vào đâu là tùy bạn nhé. Do chưa rõ nó đã đạt yêu cầu của bạn chưa nên mình chưa giải quyết tiếp các việc như đánh số các góc ranh, ghi chiều dài các cạnh thửa đất, lập bảng tọa độ góc ranh ....... Những điều này không khó lắm nữa khi đã có cái lisp lần trước mình gửi. Việc chỉnh sửa và bổ sung nó vào cái lisp mới này nếu bạn có thể tự làm được thì quá tốt, còn không thì mình có thể giúp bạn sau nhé.

Bạn hãy xem thử cái kết quả của lisp này đã trúng ý bạn chưa nhé. Cần chỉnh sửa gì thì bạn cứ mạnh dạn cho mình biết để mình suy nghĩ thêm.

Lisp đây bạn:

http://www.cadviet.com/upfiles/2/trichdonew.lsp

Và đây là một cái kết quả mà mình đã chạy thử:

http://www.cadviet.com/upfiles/2/dc_4f135ivdm.dwg

Chúc bạn luôn vui.

Sao nó chớp qúa lâu nhưng không ra kết qủa.

Mong được bạn chỉ bảo cho.

Tháng 9 30, 2009

Hiên nay mình chạy Lisp Của Bạn nó lại báo lỗi này :
displacement or :

Command: ; error: bad argument type: lselsetp Mong được Bạn giúp

Code bạn thiep không bị lỗi. -> vào codebox -> bị mã hoá.

Bạn thử cái mẹo này của Tue_NV xem sao :

Thế này nhé bạn nhấn nút Reply bài viết số 25 của Thiep -> Chép hết code của bạn thiep về chạy là được

(princ "\nChuc cac ban gat hai nhieu thanh cong. Thiep")

Tháng 9 30, 2009

Chào khaosat2009, Lisp cwb của bác Gia_bach viết rất tuyệt vời khi copy, xóa, move các đối tượng trong ngoài 1 vùng kín, hay giữa 2 vùng kín. Tuy nhiên, các đối tượng gốc bị bẻ gãy hết. Lisp Thiep viết sau đây sẽ trích thửa bản đồ, theo 1 ô vuông có kích thước cạnh do user tự chọn.

Sau khi tạo ô vuông xong, user rê ô vuông này vào khu vực cần trích thửa, nó sẽ copy các đối tượng bên trong và giao với ô vuông (ô vuông giống như 1 nam châm). Sau đó, user rê các đối tượng này đến vị trí cần đặt, ví dụ đặt ở giữa bản vẽ TRÍCH ĐO ĐỊA CHÍNH THỬA ĐẤT. Lisp sẽ cắt bỏ những đường bên ngoài ô vuông.

;;;-----------------------
(defun SS-enlst	(ss / c L)
 (setq c -1)
 (repeat (sslength ss)
   (setq L (cons (ssname ss (setq c (1+ c))) L))
 )
 (reverse L)
)
;;;====================================================================
(defun break_with (Lstent enL /	lst masterlist ss oc break_obj intpts)
 (princ "\nCalculating Break Points, Please Wait.\n")

 ;;========================================
 ;; Break entity at break points in list
 ;;========================================

 (defun break_obj (ent	brkptlst   /	      brkobjlst	 en
		enttype	   maxparam   closedobj	 minparam
		obj	   obj2break  p1param	 p2param
		brkpt2	   dlst	      idx	 brkptS
		brkptE	   brkpt      result	 result
		ignore	   dist	      tmppt	 #ofpts
		enddist	   lastent    obj2break	 stdist
	       )
    (setq obj2break ent
   brkobjlst (list ent)
   enttype   (dxf 0 ent)
    )
   (if	(not (or (eq (dxf 0 obj2break) "TEXT")
	 (eq (dxf 0 obj2break) "MTEXT")
     )
)
     (setq closedobj (vlax-curve-isclosed obj2break))
   )
   (setq spt (vlax-curve-getstartpoint ent)
ept (vlax-curve-getendpoint ent)
brkptlst (vl-remove-if
'(lambda (x)
(or (< (distance x spt) 0.0001)
(< (distance x ept) 0.0001)
)
)
brkptlst
)
)
   (if	(and brkptlst
     (not (or (eq (dxf 0 obj2break) "TEXT")
	      (eq (dxf 0 obj2break) "MTEXT")
	  )
     )
)
     (progn
(setq brkptlst
       (mapcar
	 '(lambda (x)
	    (list
	      x
	      (vlax-curve-getdistatparam
		obj2break
		(cond
		  ((vlax-curve-getparamatpoint obj2break x)
		  )
		  ((vlax-curve-getparamatpoint
		     obj2break
		     (vlax-curve-getclosestpointto
		       obj2break
		       x
		     )
		   )
		  )
		)
	      )
	    )
	  )
	 brkptlst
       )
)

(setq
  brkptlst (vl-sort brkptlst
		    '(lambda (a1 a2) (< (cadr a1) (cadr a2)))
	   )
)

(foreach brkpt (reverse brkptlst)
    (setq brkptS (car brkpt)
	  brkptE brkptS
    )
  ;; get last entity created via break in case multiple breaks
  (if brkobjlst
    (progn
      (setq tmppt brkptS)	; use only one of the pair of breakpoints
      ;; if pt not on object x, switch objects
      (if (not (numberp	(vl-catch-all-apply
			  'vlax-curve-getdistatpoint
			  (list obj2break tmppt)
			)
	       )
	  )
	(progn			; find the one that pt is on
	  (setq idx (length brkobjlst))
	  (while
	    (and (not (minusp (setq idx (1- idx))))
		 (setq obj (nth idx brkobjlst))
		 (if (numberp (vl-catch-all-apply
				'vlax-curve-getdistatpoint
				(list obj tmppt)
			      )
		     )
		   (null (setq obj2break obj))
				; switch objects, null causes exit
		   t
		 )
	    )
	  )
	)
      )
    )
  ); end (if brkobjlst

  ;;; Handle any objects that can not be used with the Break Command
  ;;; using one point, gap of 0.000001 is used
  (if (not (or (eq (dxf 0 obj2break) "TEXT")
	       (eq (dxf 0 obj2break) "MTEXT")
	   )
      )
    (setq closedobj (vlax-curve-isclosed obj2break))
  )
;;; single breakpoint ----------------------------------------------------
    (if
      (and closedobj
	   (not	(setq
		  brkptE (vlax-curve-getPointAtDist
			   obj2break
			   (+ (vlax-curve-getdistatparam
				obj2break
				;;(vlax-curve-getparamatpoint obj2break brkpts)) 0.00001))))
				;; ver 2.0 fix
				(cond
				  ((vlax-curve-getparamatpoint
				     obj2break
				     brkpts
				   )
				  )
				  ((vlax-curve-getparamatpoint
				     obj2break
				     (vlax-curve-getclosestpointto
				       obj2break
				       brkpts
				     )
				   )
				  )
				)
			      )
			      0.00001
			   )
			 )
		)
	   )
      )
       (setq
	 brkptE	(vlax-curve-getPointAtDist
		  obj2break
		  (- (vlax-curve-getdistatparam
		       obj2break
		       (cond ((vlax-curve-getparamatpoint
				obj2break
				brkpts
			      )
			     )
			     ((vlax-curve-getparamatpoint
				obj2break
				(vlax-curve-getclosestpointto
				  obj2break
				  brkpts
				)
			      )
			     )
		       )
		     )
		     0.00001
		  )
		)
       ); end setq brkptE
    ); end fi (and closedobj

  ;; (if (null brkptE) (princ)) ; debug
  (setq LastEnt (GetLastEnt))
  (if (not (or (eq (dxf 0 obj2break) "TEXT")
	       (eq (dxf 0 obj2break) "MTEXT")
	   )
      )
    (command "._break"
	     obj2break
	     "_non"
	     (trans brkptS 0 1)
	     "_non"
	     (trans brkptE 0 1)
    )
  )
  (and (= "CIRCLE" enttype) (setq enttype "ARC"))
  (if (and (not closedobj)	; new object was created
	   (not (equal LastEnt (entlast)))
      )
    (setq brkobjlst (cons (entlast) brkobjlst))
  ); end (if (and
); end (foreach brkpt
     );end progn brkptlst
   ); end if brkptlst

 ); defun break_obj

 ;;====================================
 ;; CAB - get last entity in datatbase
 (defun GetLastEnt (/ ename result)
   (if	(setq result (entlast))
     (while (setq ename (entnext result))
(setq result ename)
     )
   )
   result
 )
 ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 ;; S T A R T              S U B R O U T I N E             H E R E
 ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(if (and Lstent enL)
   (progn
     ;; CREATE a list of entity & it's break points
     (foreach en Lstent
				; check each object in Lstent
(if (not (acet-layer-locked (dxf 8 en)))
  (progn
    (setq lst nil)
    ;; check for break pts with other objects in Lstentwith
    (if	(and (not (equal en enint))
	     (setq intpts (acet-geom-intersectwith en enL 0))
	)
      (setq lst (append intpts lst))
				; entity w/ break points
    )
    (if	lst
      (setq masterlist
	     (cons (cons en lst) masterlist)
      )
    )
  )
)
     )
     (princ "\nBreaking Objects.\n")
     (if masterlist
(foreach obj2brk masterlist
  (break_obj (car obj2brk) (cdr obj2brk))
)
     )
   )
 )
);end break_with
;;===========================================================================
;; get all objects touching entities in the sscross
;; limited obj types to "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"
;; returns a list of enames
;;===========================================================================
(defun gettouching (en / ss lst lstb lstc objl)
 (and
   (setq objl (vlax-ename->vla-object en))
   (setq
     ss
      (ssget
 "_A"
 (list
   (cons 0
	 "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"
   )
   (cons 410 (getvar "ctab"))
 )
      )
   )
   (setq lst (SS-enlst ss)
    lst (mapcar 'vlax-ename->vla-object lst))
   (mapcar
     '(lambda (x)
 (if (not
       (vl-catch-all-error-p
	 (vl-catch-all-apply
	   '(lambda ()
	      (vlax-safearray->list
		(vlax-variant-value
		  (vla-intersectwith objl x acextendnone)
		)
	      )
	    )
	 )
       )
     )
   (setq lstc (cons (vlax-vla-object->ename x) lstc))
 )
      )
     lst
   )
 )
 lstc
)
;;;------------------------------------------------
(defun LWP (Lpoint *Model* / PntArr)
 (setq	PntArr (vlax-make-safearray
	 vlax-vbDouble
	 (cons 0 (1- (length Lpoint)))
       )
 )
 (vlax-safearray-fill PntArr Lpoint)
 (vla-AddLightWeightPolyline *Model* PntArr)
)
;;;------------------------------------------------
(defun DXF (code en) (cdr (assoc code (entget en))))
;;;============================================================
;;;=======================MAIN LISP============================
;;;============================================================
(defun c:trichthua (/ ss p2 encur lstss1 emin emax p3 LenssBR)
 (setq	ActDoc	(vla-get-ActiveDocument (vlax-get-acad-object))
*Model*	(vla-get-ModelSpace ActDoc)
 )
 (vla-StartUndoMark ActDoc)
 (setq	a (cond	(a)
	(50)
  )
 )
 (setq olda a)
 (setq	a (getreal (strcat "\nChon kich thuoc cat hinh vuong cat <"
			   (rtos olda 2 1)
			   "> : ")))
 (if (null a) (setq a olda))
 (setq	emin (list (car (getvar "extmin")) (cadr (getvar "extmin"))))
 (setvar "cecolor" "104")
 (setq	lstp (list (car emin)
	   (cadr emin)
	   (+ (car emin) a)
	   (cadr emin)
	   (+ (car emin) a)
	   (+ (cadr emin) a)
	   (car emin)
	   (+ (cadr emin) a)
     )
 )
 (vla-put-closed (LWP lstp *Model*) :vlax-True)
 (setq ss (ssadd (entlast) (ssadd)))
 (setq	p2 (ACET-SS-DRAG-MOVE
     ss
     (list (car emin) (cadr emin))
     "Chon vi tri bat dau trich thua: "
   )
 )
 (command ".move" ss "" emin p2)
 (setq encur (entlast)
lstp (acet-geom-VERTEX-LIST encur))
 (setq ss (ssdel encur (ssget "_CP" lstp)))
 (command ".copy" ss "" p2 p2)
 (setq	p3 (ACET-SS-DRAG-MOVE
     (ssadd encur ss)
     p2
     "Chon vi tri dat ban do trich thua: "
   )
 )
 (command ".move" ss encur "" p2 p3)
 (setvar "cecolor" "0")
 (setq encur (ssname (ssget "X" '((62 . 104))) 0))
 (setq	lstobj1	(vl-remove encur (gettouching encur))
ss	(acet-list-to-ss lstobj1)
 )
 (acet-ss-zoom-extents ss)
 (break_with  lstobj1 encur)
 (vlax-invoke-method ActDoc 'Regen acActiveViewport)
 (vla-offset (vlax-ename->vla-object encur) (* (getvar "viewsize") 0.002))
 (setq lst3 (acet-geom-vertex-list (entlast)))
 (entdel (entlast))
 (setq	LenssBR	(SS-enlst (ssget "F" lst3)))
 (foreach x LenssBR
   (if	(or (not (eq (dxf 0 x) "TEXT"))
    (not (eq (dxf 0 x) "MTEXT"))
)
     (entdel x)
   )
 )
 (vla-EndUndoMark ActDoc)
 (princ "\nChuc cac ban gat hai nhieu thanh cong. Thiep")
)

Anh Thiep ơi.

Qua Lisp của anh đã viết, anh giúp em thêm việc này nha:

Dựa vào bản đồ DC , mình chọn vào vị trí thửa thì nó trích ra thửa đó, cắt vùng bao quanh, ghi tọa độ , cạnh và chèn vào mẫu khung.

như file mẫu:

Rất mong được anh giúp

Tháng 9 30, 2009

Thế này nhé bạn nhấn nút Reply bài viết số 25 của Thiep -> Chép hết code của bạn thiep về chạy là được

Mình tìm không thấy bài của Bạn, mong được giúp

Tháng 9 30, 2009

Mình tìm không thấy bài của Bạn, mong được giúp

Bài viết số 25 của bạn thiệp là bài viết cùng trong trang này mà ở góc phía trên bên phải bài viết có dòng chữ "Gửi vào: #25"

Tháng 9 30, 2009

Sao nó chớp qúa lâu nhưng không ra kết qủa.
Mong được bạn chỉ bảo cho.

Khà khà,

Cái nhà bác này nóng ăn quá, nó chớp lâu là do bác chọn vùng quá lớn, chứa quá nhiều đường bao đó. Bác nói nó không ra kết quả thì bác phải cho biết nó báo cái lỗi gì chớ. Còn cái mình đã chạy bác xem chưa??? Nếu không ra kết quả thì sao mình có cái đó được.

Có thể do trình độ của mình còn kém nên cách viết lisp không được hay cho lắm nhưng cái kết quả thì mình phải nhắm đến chứ. Thực tế thì mình đã chạy thử rồi, tùy theo vùng chọn của bạn lớn hay bé mà nó nhanh hay chậm, tỷ dụ như cái hình mình gửi bạn thì nó chạy mất khoảng 30 giây. Qua theo dõi nó chạy mình thấy bản vẽ của bạn chứa rất nhiều đường lwpolyline chồng chéo lên nhau, do vậy nó có lâu cũng là điều phải chấp nhận thôi. Cũng có thể lisp của mình có lỗi mà mình chưa phát hiện ra, nhưng nói như bác thì mình chịu chết chả hiểu cái lỗi ấy ở đâu, giá bác chịu khó chờ cho nó chạy xong và đọc cái dòng báo lỗi của Cad thì may ra mình còn có tí chút manh mối mà gỡ rối bác ạ.

Cái việc nó chớp chớp khó chịu là do mình xài các lệnh của cad như erase, rectang,..... đó mà, nếu bạn hổng khoái nhìn thì cứ nhập xong kích thước vùng chọn thì đi ra ngoài làm điếu thuốc hay li cà phê gì đó, lúc vào là nó chạy xong mà, khỏi ngồi nhìn cho nó đau cái bụng bác ạ

Bác hãy thử lại nhé, hãy chọn vùng trích phù hợp và chịu khó chờ vài phút cho nó dừng chạy, khi đó trong clipboad đã có cái bác cần trích, chỉ việc dùng lệnh paste dán cái vùng trích đó vào chỗ bác cần. Nên nhớ là sau khi chạy lisp xong bác sẽ chả nhìn thấy gì đâu vì cái vùng chọn đó chỉ có trong clipboad thôi. Bác phải dùng tiếp lệnh paste thì mới nhòm thấy nó và đưa nó về đúng chỗ bác cần nha.

Hề hề, văn ngọng lisp nghịu, mong các bác thông cảm nha.

Tháng 9 30, 2009

xin chào tất cả các thành viên của cadviet!

mình thấy các bạn viết lisp rất hay, mình mới tập tành thôi mong các bạn dúp đỡ.

mình nhờ các thành viên giúp mình đọan lisp chèn khung tên tạo sẵn theo điểm pick vào bản vẽ hiện hành nhé.

thank!

Tháng 9 30, 2009

Cám ơn Anh Thiep nha.
Lisp của anh thể hiện hết sức tuyệt, Rất có ích .

Anh viết thêm cho phần tăng/ giãm theo yên cầu trích thửa của tỉ lệ bản đồ đi.

Lisp hỏi Bản đồ gốc tỉ lệ bao nhiêu ?

Trích ra tỉ lệ bao nhiêu ? Kết qủa Ghi ra ghi chú ở phần dưới giữa khung phía nam tỉ lệ trích.

Rất mong được anh giúp.

http://www.cadviet.com/upfiles/2/trichthua1.rar

Hiên nay mình chạy Lisp Của Bạn nó lại báo lỗi này :
displacement or :

Command: ; error: bad argument type: lselsetp Mong được Bạn giúp

Ủa, sao vừa nói "Lisp của anh thể hiện hết sức tuyệt, Rất có ích", lại vừa nói lại liền "Lisp Của Bạn nó lại báo lỗi" dậy cà? Mình test nhiều lần có lỗi gì đâu.

bạn chú ý có 1 dòng lạ trong textbox:

"http://img2.cadviet.com/forum/style_emoticons/default/wink.gif" style="vertical-align:middle" emoid=";)" border="0" alt="wink.gif">

và chép sửa lại cả đoạn bắt đầu từ (setq spt:

(setq spt (vlax-curve-getstartpoint ent)

ept (vlax-curve-getendpoint ent)

brkptlst (vl-remove-if

'(lambda (x)

(or (< (distance x spt) 0.0001)

(< (distance x ept) 0.0001)

)

brkptlst

)

Anh Thiep ơi.
Qua Lisp của anh đã viết, anh giúp em thêm việc này nha:

Dựa vào bản đồ DC , mình chọn vào vị trí thửa thì nó trích ra thửa đó, cắt vùng bao quanh, ghi tọa độ , cạnh và chèn vào mẫu khung.

như file mẫu:

http://www.cadviet.com/upfiles/2/trich_thua_dat.rar

Rất mong được anh giúp

khaosat2009 sử dụng lisp của bác phamthanhbinh để trích thửa đất và tạo bảng tọa độ. Sau đó dùng lisp của thiep để trích bản đồ ra cũng được mà.

Theo mình nghĩ, lisp của Thiep cũng có có ích giúp cho các bạn cơ khí dùng để trích 1 phần chi tiết máy, giúp cho các bạn xây dựng trích các chi tiết kết cấu phức tạp để vẽ rõ thêm ... vì vậy không nên nhập 2 cái lisp này lại thành 1.

Tháng 9 30, 2009

Anh Thiep ơi.
Qua Lisp của anh đã viết, anh giúp em thêm việc này nha:

Dựa vào bản đồ DC , mình chọn vào vị trí thửa thì nó trích ra thửa đó, cắt vùng bao quanh, ghi tọa độ , cạnh và chèn vào mẫu khung.

như file mẫu:

http://www.cadviet.com/upfiles/2/trich_thua_dat.rar

Rất mong được anh giúp

Ối giời ơi là bác Khaosat 2009 ơi,

Bác là dân kỹ thuật mà bác trình bày yêu cầu của bác thế này có mà bố thằng Tây cũng thua chứ chả nói gì tới cư dân Cadviet nhà ta bác ạ. Cùng một vấn đề mà mỗi bài bác post là nó lại méo đi một tí. Đành rằng nó na ná như nhau nhưng cái thằng lisp nó chỉ có thể hiểu duy nhất một kiểu thôi chứ không thể đã bắt nó thế này giờ lại bắt nó thế khác. Như thế có mà nó kiện đến tận ông...... Khaosat 2009 ấy chứ.

Cái bản Sơ đồ trích thửa ban đầu của bác có mỗi trần xì cái ranh của thửa đất, giờ lại thêm hai cái ngoe nữa và thêm mấy cái text bên trong

Cái Họa đồ vị trí lúc trước thì là cái khung vùng trích với tất cả các đường bao và mọi thứ linh tinh nằm trong khung, bây giờ thì lại cắt bỏ vô khối các đường bao và mấy thứ linh tinh đó mà bác không khoái nữa.

Thú thật mình không thể hiểu nổi cái lý do mà bác ghét bỏ mấy thằng đó, phải chăng nó là con hoang hở bác. ??? Ghét nó cũng phải có cái lý gì đó thì thằng lisp nó mới chịu nghe chớ bác. Cái thằng lisp này nó có tình thương bao la lắm, con nuôi con đẻ con hoang nó đều thương hết bác ạ.

Lại nữa hai cái khung của Sơ đồ trích thửa và Họa đồ vì trí của bác là bác lấy như thế nào ạ, tùy cái sướng của bác hay phải có phép tắc đường hoàng ạ???

Tóm nó lại thì mong bác cố gắng suy nghĩ thật kỹ lưỡng và trình bày thật rõ cái thâm ý của bác, bác muốn hành cái thằng lisp này ra sao thì mọi người mới có cơ hội học tập bác bác ạ. Bằng không đẻ nó ra nó lại chả vừa ý bác, bác chả thèm thương quẳng nó vào sọt rác thì tội nghiệp nó lắm lắm.

Rất mong bác bình tâm xem xét lại bác nhé.

Tháng 9 30, 2009

khaosat2009 sử dụng lisp của bác phamthanhbinh để trích thửa đất và tạo bảng tọa độ. Sau đó dùng lisp của thiep để trích bản đồ ra cũng được mà.
Theo mình nghĩ, lisp của Thiep cũng có có ích giúp cho các bạn cơ khí dùng để trích 1 phần chi tiết máy, giúp cho các bạn xây dựng trích các chi tiết kết cấu phức tạp để vẽ rõ thêm ... vì vậy không nên nhập 2 cái lisp này lại thành 1.

Không biết mình xem lisp có đụng gì nó không mà lúc đó chạy lại không đúng, tưởng cad lỗi cài lại nửa đó.

Lisp của anh Bình trích thửa ra và nhớ tọa độ rất hay, nhưng mình lại thường bị lỗi về đánh số thứ tự điểm và kẻ khung,

Phải anh phanthanhbinh kết họp của lisp trích của ảnh trích ra thủa và dùng lisp tạo hồ sơ kỹ thuật TĐất để ghi kích thuớc , điểm và Block bảng tọa độ là rất tuyệt.

Mình từng bước thực hiện được : trích Họa đồ vị trí, trích thửa thì đang bị lổi.

Mong được các anh giúp cho hoàn thiện.

Cám ơn

Tháng 9 30, 2009

xin chào tất cả các thành viên của cadviet!
mình thấy các bạn viết lisp rất hay, mình mới tập tành thôi mong các bạn dúp đỡ.

mình nhờ các thành viên giúp mình đọan lisp chèn khung tên tạo sẵn theo điểm pick vào bản vẽ hiện hành nhé.

thank!

Chào bạn Trang 7889,

Lisp vẽ khung tên nếu mình không nhầm thì trên diễn đàn này đã có rồi bạn ạ. Bản thân mình cũng ti toe có tí. Tuy nhiên nó có thất sự đúng với ý bạn hay không thì mình chả biết được mà chỉ có bạn mới quyết định được điều đó.

Như bạn đã nói, bạn đang tập tành viết lisp, như vậy mình khuyên bạn nên lấy một lisp vẽ khung tên có sẵn, chạy thử và phát hiện những điều chưa hợp với ý bạn, sau đó nếu bạn có thể tự chỉnh sửa những chỗ chưa hợp ý thành hợp ý bạn thì thật là tuyệt diệu. Còn nếu như chưa hẳn đã được như vậy thì bạn hãy post cái chưa vừa ý đó lên và nói chính xác cái ý bạn muốn, mình tin là mọi người sẽ giúp bạn để hoàn thành cái lisp đó mỹ mãn theo ý bạn.

Bằng cách như vậy bạn vừa có lisp để xài theocái khẩu vị của bạn, lại vừa tập tành được khối thứ trong quá trình hoàn thiện cái lisp đó bạn ạ. Bạn thử chịu khó kiếm tìm tí ti trên diễn đàn này là có lisp vẽ khung tên ngay ý mà.

Chúc bạn thành công.

Tháng 9 30, 2009

Chào bạn khaosat 2009,
Mình đã sửa lại cái lisp để trích thửa theo đúng cái mẫu bạn gửi. Bạn có thể so sánh cái lisp này với cái lisp trước để thấy phần mình bổ sung vào và rút ra kinh nghiệm để chỉnh sửa lisp sau này.

10/- Bạn nhập chiều cao của một dòng trong bảng. Ở đây bạn nên nhập là 5 do mình đã fix chiều cao text trong bảng, Còn chiều rộng các cột mình đã mặc định cho nó rồi theo kích thước chiều cao chữ.

11/- Lisp sẽ tự động tạo bảng, điền các tên cột và tên bảng, điền các tọa độ góc ranh và độ dài các cạnh cho bạn ở trong khung cũng như trên bản đồ trích thửa với các màu mà bạn đã cho mẫu.

Mình chạy lisp của Anh phamthanhbinh, thường bị lỗi về bảng và ghi tên điểm, cạnh như file gởi kèm.

Mong được anh giúp

Tháng 9 30, 2009

Mình chạy lisp của Anh phamthanhbinh, thường bị lỗi về bảng và ghi tên điểm, cạnh như file gởi kèm.
Mong được anh giúp

http://www.cadviet.com/upfiles/2/mong_duoc..._trich_thua.rar

Chào phamthanhbinh,

lisp của bác có 1 vài điều mình góp ý như sau:

- Lúc ban đầu nên đưa biến OSMODE = 0

- Khi tạo boundary xong, nên dùng lệnh move đối tượng (entlast), theo thiep thì nên dùng hàm (ACET-SS-DRAG-MOVE ss....) thích hợp hơn nhóm lệnh (command "copyclip" ent "") (command "pasteclip" pause "")

- Khi tạo bảng thống kê xong, thì nên dùng hàm (ACET-SS-DRAG-MOVE ss....) để move bảng thống kê về vị trí thích hợp

- Các điểm góc ranh nên đưa ra ngoài ranh (cái này hơi khó) và chiều cao bằng chiều cao text kích thước.

- Và khi tạo line, text, nên hạn chế bớt dùng (command .....) mà thay bằng hàm entmake, như vậy lisp sẽ chạy nhanh hơn và hy vọng không còn nhấp nháy nữa.

Một vài góp ý chân thành. Trân trọng!

Tháng 9 30, 2009

Mình chạy lisp của Anh phamthanhbinh, thường bị lỗi về bảng và ghi tên điểm, cạnh như file gởi kèm.
Mong được anh giúp

http://www.cadviet.com/upfiles/2/mong_duoc..._trich_thua.rar

Chào bạn Khaosat 2009,

Mình đã xem cái bảng tọa độ bị lỗi của bạn thấy có một số điều cần trao đổi như sau:

1/- Các đường line vẽ bảng bị sai lệch:

Bạn kiểm tra lại kỹ các dòng code sau đây:

(command "line" pt5 pt8 "")

(command "line" pt6 pt9 "")

Đây là hai dòng code để thực hiện vẽ hai line từ điểm pt5 đến pt8 và pt6 đến pt9. Rõ ràng trên bản lỗi của bạn các điểm pt8 và pt9 đã được lấy đúng vị trí của nó. Hai điểm này đều được lấy theo tọa độ độc cực tương đối so với các điểm chuẩn là pt5 và pt6. Điều này thể hiện ở các dòng code sau trong hàm setq:

pt8 (polar pt5 (/ pi 2) (* (+ i 2) k))

pt9 (polar pt6 (/ pi 2) (* (+ i 3) k))

Do vậy chắc chắn các điểm pt5 và pt6 phải được lấy đúng vị trí rồi.

Vì thế các line nếu thực hiện đúng theo các dòng code đã nói ở trên chắc chắn phải đúng chứ không thể xiên như bạn được. Nghĩa là hai dòng code đó đã bị bạn hoặc ai đó sửa đổi. Theo thiển ý của mình hai dòng này bị biến thành :

(command "line" pt0 pt8 "")

(command "line" pt0 pt9 "")

Nếu như vậy bạn hãy sửa lại cho đúng là OK

2/- Text 4.85 bị đặt sai vị trí trong bảng tọa độ góc ranh:

Thật tình mình không thể tìm ra lý do của nó vì theo lisp mình viết các text này được ghi trong vòng lặp While theo thứ tự các đỉnh góc ranh. Vậy mà tất cả text trước và sau nó trong vòng lặp đều đúng với vị trí đã định, chỉ riêng ở bước ghi text này thì lại bị sai vị trí. Vị trí của các text trong vòng lặp này được xác định bởi điểm đặt text là pt theo dòng code:

pt (list (+ (car pt9) 2) (- (cadr pt9) (+ (* (+ d 3) k) 2)))

Do đó với hiện trạng cái sai như bạn đã gửi mình cho rằng không thể là do code lisp sai mà rất có thể text này sau khi chạy lisp mới bị di chuyển đi vì một lý do nào đó bạn ạ.

Bạn hãy thử chạy lisp lại cẩn thận và kiểm tra kết quả xem nhé.

3/- Như mình đã nói, mình chỉ đang học lisp nên việc viết code sai có thể xảy ra, mình không bảo thủ nhưng mình nghĩ cần phải hiểu nội dung cái mình viết nên mình đã cố gắng mà mới chỉ giải thích cho bạn được đến vậy. Các bác khác trên diễn đàn nếu có thể giúp mình chỉ ra chỗ sai thì mình cảm ơn lắm lắm. Tuy nhiên mình cũng khá tư tin là mình đã kiểm tra kỹ nó rồi, không thể có cái sai tệ đến như vậy được bạn ạ. Mong bạn thử test lại bạn nhé. Để chắc ăn bạn nên tắt chế độ snap trên bản vẽ đi bạn nhé.

Chúc bạn thành công.

Tháng 9 30, 2009

Chào phamthanhbinh,
lisp của bác có 1 vài điều mình góp ý như sau:

- Lúc ban đầu nên đưa biến OSMODE = 0

- Khi tạo boundary xong, nên dùng lệnh move đối tượng (entlast), theo thiep thì nên dùng hàm (ACET-SS-DRAG-MOVE ss....) thích hợp hơn nhóm lệnh (command "copyclip" ent "") (command "pasteclip" pause "")

- Khi tạo bảng thống kê xong, thì nên dùng hàm (ACET-SS-DRAG-MOVE ss....) để move bảng thống kê về vị trí thích hợp

- Các điểm góc ranh nên đưa ra ngoài ranh (cái này hơi khó) và chiều cao bằng chiều cao text kích thước.

- Và khi tạo line, text, nên hạn chế bớt dùng (command .....) mà thay bằng hàm entmake, như vậy lisp sẽ chạy nhanh hơn và hy vọng không còn nhấp nháy nữa.

Một vài góp ý chân thành. Trân trọng!

Chào bác Thiep,

Rất cám ơn bác đã góp ý chân tình, thực lòng mình cũng rất muốn học cho thiệt kỹ rồi mới xài, nhưng quả thực do trình độ còn non nên học chậm quá. Qua các bài viết của các bác mình cũng mót được rất nhiều. Mấy hàm thuộc nhóm ACET-.... bác có giới thiệu nhưng mình đọc vẫn chưa thông được, rồi cả nhóm các hàm vlax, vl nữa, mình đọc nó chậm vô lắm, nhiều cái khái niệm mình cũng chưa hiểu hết được nên đành cứ từ từ gặm dần. Sở dĩ vậy là do cái vốn tiếng Anh nó còn lủng củng quá bác ạ.

Một khó khăn nữa là các hàm thuộc nhóm ACET-... này theo như bác Giabach nói thì phải cài Express Tools mới xài được mà mình thì chưa cài được nó. Lý do là cái Cad2004 của mình do thợ nó cài giùm chứ mình chả có đĩa cài bác ạ. Thế mới khó để vọc chứ lị.

Qua các cái lisp mình viết chắc bác cũng hiểu được cái cách tư duy của mình, nó hơi lẩm cẩm nhưng phần nào nó cũng rất thật với con người mình, nghĩ sao mình mần vậy, cố gắng xài những cái thiệt dễ hiểu, đơn giản nhưng có hiệu quả thôi bác ạ. Mình cũng còn đang học lisp mà nên chắc chắn còn rất nhiều điều cần học nữa, như bác nói đó Học lisp học nữa học mãi mà. Chưa thiệt là hiệu quả lắm nhưng ít nhiều cũng giúp mình hiểu thêm cái công cụ này và có thêm hứng thú để học bác ạ.

Lisp còn nhiều, chắc còn phải mót của các bác hoài hoài à, mong các bác luôn mạnh khỏe, tâm sáng lòng trong để có được nhiều cái lisp hay cho mình mót với.

Hẹn gặp bác. Thân chào.

Tháng 9 30, 2009

Chào bạn Khaosat 2009,
Mình đã xem cái bảng tọa độ bị lỗi của bạn thấy có một số điều cần trao đổi như sau:

1/- Các đường line vẽ bảng bị sai lệch:

Bạn kiểm tra lại kỹ các dòng code sau đây:

(command "line" pt5 pt8 "")

(command "line" pt6 pt9 "")

Đây là hai dòng code để thực hiện vẽ hai line từ điểm pt5 đến pt8 và pt6 đến pt9. Rõ ràng trên bản lỗi của bạn các điểm pt8 và pt9 đã được lấy đúng vị trí của nó. Hai điểm này đều được lấy theo tọa độ độc cực tương đối so với các điểm chuẩn là pt5 và pt6. Điều này thể hiện ở các dòng code sau trong hàm setq:

pt8 (polar pt5 (/ pi 2) (* (+ i 2) k))

pt9 (polar pt6 (/ pi 2) (* (+ i 3) k))

Do vậy chắc chắn các điểm pt5 và pt6 phải được lấy đúng vị trí rồi.

Vì thế các line nếu thực hiện đúng theo các dòng code đã nói ở trên chắc chắn phải đúng chứ không thể xiên như bạn được. Nghĩa là hai dòng code đó đã bị bạn hoặc ai đó sửa đổi. Theo thiển ý của mình hai dòng này bị biến thành :

(command "line" pt0 pt8 "")

(command "line" pt0 pt9 "")

Nếu như vậy bạn hãy sửa lại cho đúng là OK

2/- Text 4.85 bị đặt sai vị trí trong bảng tọa độ góc ranh:

Thật tình mình không thể tìm ra lý do của nó vì theo lisp mình viết các text này được ghi trong vòng lặp While theo thứ tự các đỉnh góc ranh. Vậy mà tất cả text trước và sau nó trong vòng lặp đều đúng với vị trí đã định, chỉ riêng ở bước ghi text này thì lại bị sai vị trí. Vị trí của các text trong vòng lặp này được xác định bởi điểm đặt text là pt theo dòng code:

pt (list (+ (car pt9) 2) (- (cadr pt9) (+ (* (+ d 3) k) 2)))

Do đó với hiện trạng cái sai như bạn đã gửi mình cho rằng không thể là do code lisp sai mà rất có thể text này sau khi chạy lisp mới bị di chuyển đi vì một lý do nào đó bạn ạ.

Bạn hãy thử chạy lisp lại cẩn thận và kiểm tra kết quả xem nhé.

3/- Như mình đã nói, mình chỉ đang học lisp nên việc viết code sai có thể xảy ra, mình không bảo thủ nhưng mình nghĩ cần phải hiểu nội dung cái mình viết nên mình đã cố gắng mà mới chỉ giải thích cho bạn được đến vậy. Các bác khác trên diễn đàn nếu có thể giúp mình chỉ ra chỗ sai thì mình cảm ơn lắm lắm. Tuy nhiên mình cũng khá tư tin là mình đã kiểm tra kỹ nó rồi, không thể có cái sai tệ đến như vậy được bạn ạ. Mong bạn thử test lại bạn nhé. Để chắc ăn bạn nên tắt chế độ snap trên bản vẽ đi bạn nhé.

Chúc bạn thành công.

Líp của bạn , mình không dám chỉnh gì hết, load vào dùng.

Mình tìm được nguyên nhân rố bạn à. Phải tắchế độ Snap và ortho thì nó mới ra bảng đúng.

Nhưng hàng số chưa được canh chỉnh ngay lắm. mong được bạn giúp tiếp.

Tháng 9 30, 2009

Líp của bạn , mình không dám chỉnh gì hết, load vào dùng.
Mình tìm được nguyên nhân rố bạn à. Phải tắchế độ Snap và ortho thì nó mới ra bảng đúng.

Nhưng hàng số chưa được canh chỉnh ngay lắm. mong được bạn giúp tiếp.

Chào bạn Khaosat 2009,

1/- Ý bạn căn text như thế nào? Hiện tại mình căn cột text theo điểm đặt text ở góc dưới bên trái của text. Bạn xem lisp sẽ thấy. Còn về hàng thì cột giá trị chiều dài cạnh được căn vào khoảng giữa hai dòng text của cột text tọa độ.

2/- Bạn có thể bổ sung các dòng code sau đây vào cái lisp đó để không phải tắt bật chế độ snap và ortho nữa:

(setq oldos (getvar "osmode"))

(setvar "osmode" 0)

Hai dòng này chèn vào phía trên dòng lệnh (prompt "Hay pick thua dat") và dưới dòng (vl-load-com)

Chèn thêm dòng lệnh sau:

(setvar "osmode" oldos)

Vào trên dòng lệnh (princ)

3/- Bạn cho biết ý kiến về cái lisp trich họa đồ vị trí của mình. Nếu Ok mình có thể bổ sung hoàn chỉnh lại nó bao gồm cả phần mà cái lisp trích thửa đã làm.

Chúc bạn thành công.

Tháng 10 1, 2009

Chào bạn Khaosat 2009,
1/- Ý bạn căn text như thế nào? Hiện tại mình căn cột text theo điểm đặt text ở góc dưới bên trái của text. Bạn xem lisp sẽ thấy. Còn về hàng thì cột giá trị chiều dài cạnh được căn vào khoảng giữa hai dòng text của cột text tọa độ.

Việc tạo bảng kê toạ độ thỉ các số căn về bên trái của cột, mong bạn giúp cho căn về bên phải hay nằm cân ở giửa cột.

Số ghi cạnh trên thửa có những số qúa sát vào cạnh, mong bạn chỉnh cho ra ít.

Tháng 10 1, 2009

Chào bạn Khaosat 2009,

3/- Bạn cho biết ý kiến về cái lisp trich họa đồ vị trí của mình. Nếu Ok mình có thể bổ sung hoàn chỉnh lại nó bao gồm cả phần mà cái lisp trích thửa đã làm.

Riêng về Lisp trích họa đồ, do cấu hình máy cơ quan thấp, file bản vẽ lớn, nó chớp Trung bình 20 phút 1 khu vực trích ra, và việc tạo đường bao trong thửa chưa khớp .Bạn xem lại giúp

Tháng 10 1, 2009

Chào khaosat2009, Lisp cwb của bác Gia_bach viết rất tuyệt vời khi copy, xóa, move các đối tượng trong ngoài 1 vùng kín, hay giữa 2 vùng kín. Tuy nhiên, các đối tượng gốc bị bẻ gãy hết. Lisp Thiep viết sau đây sẽ trích thửa bản đồ, theo 1 ô vuông có kích thước cạnh do user tự chọn.

Sau khi tạo ô vuông xong, user rê ô vuông này vào khu vực cần trích thửa, nó sẽ copy các đối tượng bên trong và giao với ô vuông (ô vuông giống như 1 nam châm). Sau đó, user rê các đối tượng này đến vị trí cần đặt, ví dụ đặt ở giữa bản vẽ TRÍCH ĐO ĐỊA CHÍNH THỬA ĐẤT. Lisp sẽ cắt bỏ những đường bên ngoài ô vuông.

;;;-----------------------
(defun SS-enlst	(ss / c L)
 (setq c -1)
 (repeat (sslength ss)
   (setq L (cons (ssname ss (setq c (1+ c))) L))
 )
 (reverse L)
)
;;;====================================================================
(defun break_with (Lstent enL /	lst masterlist ss oc break_obj intpts)
 (princ "\nCalculating Break Points, Please Wait.\n")

 ;;========================================
 ;; Break entity at break points in list
 ;;========================================

 (defun break_obj (ent	brkptlst   /	      brkobjlst	 en
		enttype	   maxparam   closedobj	 minparam
		obj	   obj2break  p1param	 p2param
		brkpt2	   dlst	      idx	 brkptS
		brkptE	   brkpt      result	 result
		ignore	   dist	      tmppt	 #ofpts
		enddist	   lastent    obj2break	 stdist
	       )
    (setq obj2break ent
   brkobjlst (list ent)
   enttype   (dxf 0 ent)
    )
   (if	(not (or (eq (dxf 0 obj2break) "TEXT")
	 (eq (dxf 0 obj2break) "MTEXT")
     )
)
     (setq closedobj (vlax-curve-isclosed obj2break))
   )
   (setq spt (vlax-curve-getstartpoint ent)
ept (vlax-curve-getendpoint ent)
brkptlst (vl-remove-if
'(lambda (x)
(or (< (distance x spt) 0.0001)
(< (distance x ept) 0.0001)
)
)
brkptlst
)
)
   (if	(and brkptlst
     (not (or (eq (dxf 0 obj2break) "TEXT")
	      (eq (dxf 0 obj2break) "MTEXT")
	  )
     )
)
     (progn
(setq brkptlst
       (mapcar
	 '(lambda (x)
	    (list
	      x
	      (vlax-curve-getdistatparam
		obj2break
		(cond
		  ((vlax-curve-getparamatpoint obj2break x)
		  )
		  ((vlax-curve-getparamatpoint
		     obj2break
		     (vlax-curve-getclosestpointto
		       obj2break
		       x
		     )
		   )
		  )
		)
	      )
	    )
	  )
	 brkptlst
       )
)

(setq
  brkptlst (vl-sort brkptlst
		    '(lambda (a1 a2) (< (cadr a1) (cadr a2)))
	   )
)

(foreach brkpt (reverse brkptlst)
    (setq brkptS (car brkpt)
	  brkptE brkptS
    )
  ;; get last entity created via break in case multiple breaks
  (if brkobjlst
    (progn
      (setq tmppt brkptS)	; use only one of the pair of breakpoints
      ;; if pt not on object x, switch objects
      (if (not (numberp	(vl-catch-all-apply
			  'vlax-curve-getdistatpoint
			  (list obj2break tmppt)
			)
	       )
	  )
	(progn			; find the one that pt is on
	  (setq idx (length brkobjlst))
	  (while
	    (and (not (minusp (setq idx (1- idx))))
		 (setq obj (nth idx brkobjlst))
		 (if (numberp (vl-catch-all-apply
				'vlax-curve-getdistatpoint
				(list obj tmppt)
			      )
		     )
		   (null (setq obj2break obj))
				; switch objects, null causes exit
		   t
		 )
	    )
	  )
	)
      )
    )
  ); end (if brkobjlst

  ;;; Handle any objects that can not be used with the Break Command
  ;;; using one point, gap of 0.000001 is used
  (if (not (or (eq (dxf 0 obj2break) "TEXT")
	       (eq (dxf 0 obj2break) "MTEXT")
	   )
      )
    (setq closedobj (vlax-curve-isclosed obj2break))
  )
;;; single breakpoint ----------------------------------------------------
    (if
      (and closedobj
	   (not	(setq
		  brkptE (vlax-curve-getPointAtDist
			   obj2break
			   (+ (vlax-curve-getdistatparam
				obj2break
				;;(vlax-curve-getparamatpoint obj2break brkpts)) 0.00001))))
				;; ver 2.0 fix
				(cond
				  ((vlax-curve-getparamatpoint
				     obj2break
				     brkpts
				   )
				  )
				  ((vlax-curve-getparamatpoint
				     obj2break
				     (vlax-curve-getclosestpointto
				       obj2break
				       brkpts
				     )
				   )
				  )
				)
			      )
			      0.00001
			   )
			 )
		)
	   )
      )
       (setq
	 brkptE	(vlax-curve-getPointAtDist
		  obj2break
		  (- (vlax-curve-getdistatparam
		       obj2break
		       (cond ((vlax-curve-getparamatpoint
				obj2break
				brkpts
			      )
			     )
			     ((vlax-curve-getparamatpoint
				obj2break
				(vlax-curve-getclosestpointto
				  obj2break
				  brkpts
				)
			      )
			     )
		       )
		     )
		     0.00001
		  )
		)
       ); end setq brkptE
    ); end fi (and closedobj

  ;; (if (null brkptE) (princ)) ; debug
  (setq LastEnt (GetLastEnt))
  (if (not (or (eq (dxf 0 obj2break) "TEXT")
	       (eq (dxf 0 obj2break) "MTEXT")
	   )
      )
    (command "._break"
	     obj2break
	     "_non"
	     (trans brkptS 0 1)
	     "_non"
	     (trans brkptE 0 1)
    )
  )
  (and (= "CIRCLE" enttype) (setq enttype "ARC"))
  (if (and (not closedobj)	; new object was created
	   (not (equal LastEnt (entlast)))
      )
    (setq brkobjlst (cons (entlast) brkobjlst))
  ); end (if (and
); end (foreach brkpt
     );end progn brkptlst
   ); end if brkptlst

 ); defun break_obj

 ;;====================================
 ;; CAB - get last entity in datatbase
 (defun GetLastEnt (/ ename result)
   (if	(setq result (entlast))
     (while (setq ename (entnext result))
(setq result ename)
     )
   )
   result
 )
 ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 ;; S T A R T              S U B R O U T I N E             H E R E
 ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(if (and Lstent enL)
   (progn
     ;; CREATE a list of entity & it's break points
     (foreach en Lstent
				; check each object in Lstent
(if (not (acet-layer-locked (dxf 8 en)))
  (progn
    (setq lst nil)
    ;; check for break pts with other objects in Lstentwith
    (if	(and (not (equal en enint))
	     (setq intpts (acet-geom-intersectwith en enL 0))
	)
      (setq lst (append intpts lst))
				; entity w/ break points
    )
    (if	lst
      (setq masterlist
	     (cons (cons en lst) masterlist)
      )
    )
  )
)
     )
     (princ "\nBreaking Objects.\n")
     (if masterlist
(foreach obj2brk masterlist
  (break_obj (car obj2brk) (cdr obj2brk))
)
     )
   )
 )
);end break_with
;;===========================================================================
;; get all objects touching entities in the sscross
;; limited obj types to "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"
;; returns a list of enames
;;===========================================================================
(defun gettouching (en / ss lst lstb lstc objl)
 (and
   (setq objl (vlax-ename->vla-object en))
   (setq
     ss
      (ssget
 "_A"
 (list
   (cons 0
	 "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"
   )
   (cons 410 (getvar "ctab"))
 )
      )
   )
   (setq lst (SS-enlst ss)
    lst (mapcar 'vlax-ename->vla-object lst))
   (mapcar
     '(lambda (x)
 (if (not
       (vl-catch-all-error-p
	 (vl-catch-all-apply
	   '(lambda ()
	      (vlax-safearray->list
		(vlax-variant-value
		  (vla-intersectwith objl x acextendnone)
		)
	      )
	    )
	 )
       )
     )
   (setq lstc (cons (vlax-vla-object->ename x) lstc))
 )
      )
     lst
   )
 )
 lstc
)
;;;------------------------------------------------
(defun LWP (Lpoint *Model* / PntArr)
 (setq	PntArr (vlax-make-safearray
	 vlax-vbDouble
	 (cons 0 (1- (length Lpoint)))
       )
 )
 (vlax-safearray-fill PntArr Lpoint)
 (vla-AddLightWeightPolyline *Model* PntArr)
)
;;;------------------------------------------------
(defun DXF (code en) (cdr (assoc code (entget en))))
;;;============================================================
;;;=======================MAIN LISP============================
;;;============================================================
(defun c:trichthua (/ ss p2 encur lstss1 emin emax p3 LenssBR)
 (setq	ActDoc	(vla-get-ActiveDocument (vlax-get-acad-object))
*Model*	(vla-get-ModelSpace ActDoc)
 )
 (vla-StartUndoMark ActDoc)
 (setq	a (cond	(a)
	(50)
  )
 )
 (setq olda a)
 (setq	a (getreal (strcat "\nChon kich thuoc cat hinh vuong cat <"
			   (rtos olda 2 1)
			   "> : ")))
 (if (null a) (setq a olda))
 (setq	emin (list (car (getvar "extmin")) (cadr (getvar "extmin"))))
 (setvar "cecolor" "104")
 (setq	lstp (list (car emin)
	   (cadr emin)
	   (+ (car emin) a)
	   (cadr emin)
	   (+ (car emin) a)
	   (+ (cadr emin) a)
	   (car emin)
	   (+ (cadr emin) a)
     )
 )
 (vla-put-closed (LWP lstp *Model*) :vlax-True)
 (setq ss (ssadd (entlast) (ssadd)))
 (setq	p2 (ACET-SS-DRAG-MOVE
     ss
     (list (car emin) (cadr emin))
     "Chon vi tri bat dau trich thua: "
   )
 )
 (command ".move" ss "" emin p2)
 (setq encur (entlast)
lstp (acet-geom-VERTEX-LIST encur))
 (setq ss (ssdel encur (ssget "_CP" lstp)))
 (command ".copy" ss "" p2 p2)
 (setq	p3 (ACET-SS-DRAG-MOVE
     (ssadd encur ss)
     p2
     "Chon vi tri dat ban do trich thua: "
   )
 )
 (command ".move" ss encur "" p2 p3)
 (setvar "cecolor" "0")
 (setq encur (ssname (ssget "X" '((62 . 104))) 0))
 (setq	lstobj1	(vl-remove encur (gettouching encur))
ss	(acet-list-to-ss lstobj1)
 )
 (acet-ss-zoom-extents ss)
 (break_with  lstobj1 encur)
 (vlax-invoke-method ActDoc 'Regen acActiveViewport)
 (vla-offset (vlax-ename->vla-object encur) (* (getvar "viewsize") 0.002))
 (setq lst3 (acet-geom-vertex-list (entlast)))
 (entdel (entlast))
 (setq	LenssBR	(SS-enlst (ssget "F" lst3)))
 (foreach x LenssBR
   (if	(or (not (eq (dxf 0 x) "TEXT"))
    (not (eq (dxf 0 x) "MTEXT"))
)
     (entdel x)
   )
 )
 (vla-EndUndoMark ActDoc)
 (princ "\nChuc cac ban gat hai nhieu thanh cong. Thiep")
)

Chào anh thiep.

Xin lỗi anh nha, vì yêu cầu công việc, việc trích thửa đó phải làm thêm theo hình chử nhật.

Mong anh viết thêm giúp cho:

Lisp hỏi : cắt theo ô vuông / chử nhật

Nếu chọn ô vuông ---> Cạnh bao nhiêu.?

Nếu chọn chử nhật ---> Dài bao nhiêu ? Rộng bao nhiêu ?

Cám ơn

Chỉnh sửa Tháng 11 19, 2010 theo phamthanhbinh

Tháng 10 1, 2009

Chào phamthanhbinh,
lisp của bác có 1 vài điều mình góp ý như sau:

- Lúc ban đầu nên đưa biến OSMODE = 0

- Khi tạo boundary xong, nên dùng lệnh move đối tượng (entlast), theo thiep thì nên dùng hàm (ACET-SS-DRAG-MOVE ss....) thích hợp hơn nhóm lệnh (command "copyclip" ent "") (command "pasteclip" pause "")

- Khi tạo bảng thống kê xong, thì nên dùng hàm (ACET-SS-DRAG-MOVE ss....) để move bảng thống kê về vị trí thích hợp

- Các điểm góc ranh nên đưa ra ngoài ranh (cái này hơi khó) và chiều cao bằng chiều cao text kích thước.

- Và khi tạo line, text, nên hạn chế bớt dùng (command .....) mà thay bằng hàm entmake, như vậy lisp sẽ chạy nhanh hơn và hy vọng không còn nhấp nháy nữa.

Một vài góp ý chân thành. Trân trọng!

Tôi sử dụng gặp lỗi như sau:

trichthua.lsp successfully loaded.

Command: ; error: malformed list on input

Thiep có thể hướng dẫn tôi khắc phục lỗi trên. Thanks

Tháng 10 1, 2009

Chào anh thiep.
Xin lỗi anh nha, vì yêu cầu công việc, việc trích thửa đó phải làm thêm theo hình chử nhật.

Mong anh viết thêm giúp cho:

Lisp hỏi : cắt theo ô vuông / chử nhật

Nếu chọn ô vuông ---> Cạnh bao nhiêu.?

Nếu chọn chử nhật ---> Dài bao nhiêu ? Rộng bao nhiêu ?

Cám ơn

Chào khaosat2009, thiep đoán cũng có ngày có người yêu cầu trích thửa theo hình chữ nhật, sau đó theo hình tròn, elipse. khaosat2009 chờ nhé, thiep sẽ viết luôn 1 thể.

Tôi sử dụng gặp lỗi như sau:
trichthua.lsp successfully loaded.

Command: ; error: malformed list on input

Thiep có thể hướng dẫn tôi khắc phục lỗi trên. Thanks

Chào VBảo, lỗi này là do copy file bị thiếu dấu ")" bạn nên chép lại file trichthua.lsp; Hoặc có thể do trong codebox có 1 dòng mã lỗi, Vbảo xóa nó đi và xóa luôn ")"

Đăng nhập

trích do

Các bài được khuyến nghị

khaosat2009 11

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

phamthanhbinh 3147

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

khaosat2009 11

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

khaosat2009 11

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Tue_NV 3915

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

khaosat2009 11

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

khaosat2009 11

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

svba1608 627

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

phamthanhbinh 3147

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

trang7889 0

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

thiep 367

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

phamthanhbinh 3147

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

khaosat2009 11

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

phamthanhbinh 3147

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

khaosat2009 11

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

thiep 367

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

phamthanhbinh 3147

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

phamthanhbinh 3147

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

khaosat2009 11

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

phamthanhbinh 3147