- UID
- 674793
- 积分
- 1874
- 精华
- 贡献
-
- 威望
-
- 活跃度
-
- D豆
-
- 在线时间
- 小时
- 注册时间
- 2013-4-1
- 最后登录
- 1970-1-1
|
发表于 2013-6-16 09:22:12
|
显示全部楼层
线型定义是可以提取出来的的!下面是输出线型定义的程序,供参考:
![](source/plugin/imc_colorcode/images/loading.gif) - ;|
- NEW-LIN.LSP -- (c) 2000 Tee Square Graphics
- NEW-LIN is a useful AutoLISP routine that extracts parameters for
- unknown LineTypes in a drawing, and creates entries in a new LineType
- definition file, NEW-ACAD.LIN. After extraction, the LineType definitions
- may be moved to ACAD.LIN or any other *.LIN file desired by the user.
- This version of NEW-LIN.LSP functions fully with simple LineTypes, and
- Complex LineTypes composed of linear elements and Text objects. Because
- of difficulty in extracting Shape data from shape definition (*.shx)
- files, the user may, for the time being, have to supply the appropriate
- name for the Shape represented by {Shape #nnn} in NEW-ACAD.LIN, in cases
- where the associated Shape Source File (*.shp) is unavailable.
- |;
- (defun C:NEW-LIN (/ flag outf ltname tblent tblist i
- desc alist acode value rot shpno shxfl
- shpfl inf dat n shpnm flg txt
- sty
- )
- (setq flag (findfile (strcat (getvar 'dwgprefix) "new-acad.lin"))
- outf (open (if flag
- flag
- (strcat (getvar 'dwgprefix) "new-acad.lin")
- )
- "w"
- )
- )
- (write-line ";;" outf)
- (write-line ";; New LineType descriptions extracted" outf)
- (write-line
- ";; from existing drawing(s) by NEW-LIN.LSP."
- outf
- )
- (write-line ";;" outf)
- (write-line
- ";; NEW-LIN.LSP (c) 2000 Tee Square Graphics"
- outf
- )
- (write-line ";;\n" outf)
- (setvar "luprec" 8)
- (setvar "auprec" 8)
- (tblnext "ltype" T)
- (while (setq tblent (tblnext "ltype"))
- (setq ltname (cdr (assoc 2 tblent))
- tblent (tblobjname "ltype" ltname)
- tblist (entget tblent)
- i 1
- desc "A,"
- )
- (write-line
- (strcat "*"
- (cdr (assoc 2 tblist))
- ","
- (cdr (assoc 3 tblist))
- )
- outf
- )
- (while (< i (length tblist))
- (setq alist (nth i tblist)
- acode (car alist)
- value (cdr alist)
- )
- (cond
- ((= acode 49)
- (setq desc (strcat desc (trim (rtos value 2 8)) ","))
- )
- ((= acode 74)
- (setq flag (if (= (logand value 4) 4)
- T
- nil
- )
- rot (if (= (logand value 1) 1)
- "a"
- "r"
- )
- )
- )
- ((= acode 75)
- (setq shpno (itoa value))
- )
- ((= acode 340)
- (if flag
- (progn
- (setq shxfl (cdr (assoc 3 (entget value)))
- shpfl (strcat (substr shxfl 1 (- (strlen shxfl) 3))
- "shp"
- )
- )
- (if (setq inf (findfile shpfl))
- (progn
- (setq inf (open inf "r"))
- (while (setq dat (read-line inf))
- (if (wcmatch dat (strcat "`*" shpno "*"))
- (progn
- (setq n 1)
- (repeat 2
- (while (/= (substr dat n 1) ",")
- (setq n (1+ n))
- )
- (setq n (1+ n))
- )
- (setq shpnm (substr dat n))
- )
- )
- )
- (close inf)
- )
- )
- )
- )
- (setq flg flag
- txt (if flag
- (if shpnm
- shpnm
- (strcat "{Shape #" shpno "}")
- )
- (strcat "\""
- (cdr (assoc 9 (member alist tblist)))
- "\""
- )
- )
- sty (if flag
- (cdr (assoc 3 (entget value)))
- (cdr (assoc 2 (entget value)))
- )
- desc (strcat desc
- "\n["
- txt
- ","
- sty
- ",s="
- (trim (rtos (cdr (nth (1+ i) tblist)) 2 8))
- ","
- rot
- "="
- (trim (angtos (cdr (nth (+ i 2) tblist)) 0 8))
- ",x="
- (trim (rtos (cdr (nth (+ i 3) tblist)) 2 8))
- ",y="
- (trim (rtos (cdr (nth (+ i 4) tblist)) 2 8))
- "],\n"
- )
- i (+ i 4)
- )
- )
- (T nil)
- )
- (setq i (1+ i))
- )
- (write-line (substr desc 1 (1- (strlen desc))) outf)
- (write-line " " outf)
- )
- (close outf)
- (alert
- (strcat
- "All loaded LineTypes in the current drawing database have been\n"
- "duplicated in a new LineType definition file, NEW-ACAD.LIN.\n"
- "Any complex LineTypes using Shape Definitions for which no\n"
- "source file (*.shp) could be found will contain a reference in\n"
- "curly braces { }; the user must supply the correct shape name\n"
- "before NEW-ACAD.LIN can be used to load these LineTypes.")
- )
- (startapp "notepad.exe" (strcat (getvar 'dwgprefix) "new-acad.lin"))
- (princ)
- )
|
|