Đến nội dung


Hình ảnh
- - - - -

[Nhờ giúp đỡ] Chuyển xref thành no path


  • Please log in to reply
10 replies to this topic

#1 amateurday

amateurday

    biết lệnh break

  • Members
  • PipPipPipPip
  • 228 Bài viết
Điểm đánh giá: 4 (bình thường)

Đã gửi 03 June 2012 - 12:04 PM

Nhờ các bác sửa cho em đoạn code này, mục đích là chuyển xref thành no path. Có lẽ lisp không update dữ liệu vào được nên không chạy. Em đang gặp khó khăn nếu reference name bị thay đổi (không trùng tên với file xref).

(defun c:aaa(/ tmp1)
;(vl-load-com)
(setq tmp1 (tblnext "BLOCK" 1))
(WHILE (/= tmp1 NIL)
(IF(/= (assoc 1 tmp1) nil)
(PROGN
(SETQ xfname (cdr (ASSOC 2 tmp1)))
(princ xfname) (princ "\n Current: ")
(setq pathname (cdr (assoc 1 tmp1)))
(princ pathname)
(setq ct (strlen pathname))
(setq c ct)
(setq test (substr pathname ct 1))
(while (/= test "\\")
(setq test (substr pathname c 1))
(setq c (1- c))
) ;while
(setq pathdir (substr pathname 1 c))
(setq filenameex (substr pathname (1+ c)))
(if (/= (assoc 2 tmp1) (substr pathname 1 (- (strlen pathname) 4)))
(progn
(setq tmp1 (subst (cons 1 (strcat (cdr (assoc 2 tmp1)) ".dwg")) (assoc 1 tmp1) tmp1))
(entmod tmp1)
(entupd (cdr(assoc -2 tmp1)))
)
))))
(setq tmp1 (tblnext "BLOCK"))
)

  • 0

#2 amateurday

amateurday

    biết lệnh break

  • Members
  • PipPipPipPip
  • 228 Bài viết
Điểm đánh giá: 4 (bình thường)

Đã gửi 04 June 2012 - 09:47 AM

Nhờ các bác tiếp nào!!!
  • 0

#3 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5682 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 04 June 2012 - 10:44 AM


(defun c:xrefnopath (/ xrefName ) ;@ketxu 4/6
(vl-load-com)
(vlax-for x (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object)))
(cond ((and
(vlax-property-available-p x 'isxref)
(eq (vla-get-IsXref x) :vlax-true)
)
(vla-put-path
x
(strcat
(vl-filename-base (setq xrefName (vla-get-Path x)))
(vl-filename-extension xrefName)
)
)
(vla-reload x)
)
)
)
)

  • 2

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#4 LoveLisp

LoveLisp

    biết lệnh extend

  • Members
  • PipPipPip
  • 195 Bài viết
Điểm đánh giá: 20 (tàm tạm)

Đã gửi 28 December 2012 - 03:36 PM

Mình bị gặp lỗi này
Command: XREFNOPATH
; error: Automation Error. File access error


Cho mình hỏi liệu có thể chuyển đổi qua lại giữa Full path, Relative path và No path được không?
  • 0

#5 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5682 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 28 December 2012 - 03:42 PM

Nếu bạn xài thì hình như mình có nghịch một cái ở đây, lâu quá rùi ^^ CODE search trên mạng nhìu lắm í
  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#6 LoveLisp

LoveLisp

    biết lệnh extend

  • Members
  • PipPipPip
  • 195 Bài viết
Điểm đánh giá: 20 (tàm tạm)

Đã gửi 28 December 2012 - 03:51 PM

Cám ơn ket! Mình đã thử, khi chuyển từ Relative sáng Full thì tốt, nhưng ngược lại thì không thành công bạn ạ, chẳng có gì thay đổi hết!
  • 0

#7 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5449 Bài viết
Điểm đánh giá: 2625 (tuyệt vời)

Đã gửi 28 December 2012 - 04:04 PM

Tôi chưa test. LL thử xem:

;Full Path to Relative Path
;;-------------=={ Full Path to Relative Path }==-------------;;
;; ;;
;; Converts a Full XRef path to a Relative Path. ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; dir - Directory of the Drawing in which the Xref resides ;;
;; path - Full Xref Path ;;
;;------------------------------------------------------------;;
;; Returns: Relative XRef Path ;;
;;------------------------------------------------------------;;
(defun LM:XRef:Full->Relative ( dir path / p q ) (setq dir (vl-string-right-trim "\\" dir))
(cond
( (and
(setq p (vl-string-position 58 dir))
(setq q (vl-string-position 58 path))
(not (eq (strcase (substr dir 1 p)) (strcase (substr path 1 q))))
)
path
)
( (and
(setq p (vl-string-position 92 dir))
(setq q (vl-string-position 92 path))
(eq (strcase (substr dir 1 p)) (strcase (substr path 1 q)))
)
(LM:Xref:Full->Relative (substr dir (+ 2 p)) (substr path (+ 2 q)))
)
( (and
(setq q (vl-string-position 92 path))
(eq (strcase dir) (strcase (substr path 1 q)))
)
(strcat ".\\" (substr path (+ 2 q)))
)
( (eq "" dir)
path
)
( (setq p (vl-string-position 92 dir))
(LM:Xref:Full->Relative (substr dir (+ 2 p)) (strcat "..\\" path))
)
( (LM:Xref:Full->Relative "" (strcat "..\\" path)) )
)
)
;----- Example Function Calls:
;_$ (LM:XRef:Full->Relative "C:\\Folder1\\Folder2\\Folder3" "C:\\Folder1\\Folder2\\Folder3\\XRef.dwg") => ".\\XRef.dwg"
;_$ (LM:XRef:Full->Relative "C:\\Folder1\\Folder2\\Folder3" "C:\\Folder1\\Folder2\\XRef.dwg") => "..\\XRef.dwg"
;_$ (LM:XRef:Full->Relative "C:\\Folder1\\Folder2\\Folder3" "C:\\Folder1\\Folder4\\XRef.dwg") => "..\\..\\Folder4\\XRef.dwg"

  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#8 LoveLisp

LoveLisp

    biết lệnh extend

  • Members
  • PipPipPip
  • 195 Bài viết
Điểm đánh giá: 20 (tàm tạm)

Đã gửi 28 December 2012 - 04:34 PM

hihi.. cám ơn bác HẠ, nhưng cái này là hàm con, chỉ làm nhiệm vụ xử lý thôi. Mình muốn có cái nào ... trọn gói lun í, nghĩa là chỉ gõ lệnh là xong thôi! :)
  • 0

#9 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5449 Bài viết
Điểm đánh giá: 2625 (tuyệt vời)

Đã gửi 28 December 2012 - 04:57 PM

Bạn biết viết lisp, và có hàm con rồi, thì tự phóng bút cho oai luôn đi!
  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#10 LoveLisp

LoveLisp

    biết lệnh extend

  • Members
  • PipPipPip
  • 195 Bài viết
Điểm đánh giá: 20 (tàm tạm)

Đã gửi 28 December 2012 - 05:13 PM

oh, vụ này để sau vậy. Chúc mọi người ăn Tết vui vẻ! :)
  • 0

#11 txchuong

txchuong

    biết vẽ circle

  • Members
  • PipPip
  • 39 Bài viết
Điểm đánh giá: 3 (bình thường)

Đã gửi 11 June 2014 - 05:00 PM

Lôi cái này lên nhờ bác Doan Van Ha giúp cho.

Em rất cần "Full Path to Relative Path" cái này nhưng không thể "Phóng bút" như bác nói, mong bác hoàn thiện giúp cho.

Em có biết vài hàm lisp nhưng mấy hàm vl thì em mù tịt luôn. Hơn nữa cho em hỏi thêm không biết nó có dùng được cho Attach Image không? nếu không thì nhờ bác sửa cho nó dùng được với à.


  • 0