在Ca中输入数据需要Lisp
大家好在CAD中输入数据需要LISP
我有一个地平面
样品
x y z
17 20 2.5
21 24 3.4
25 28 4.3
29 32 5.2
33 36 2.5
37 40 3.4
关于绘图，我有x，y和z坐标，我必须在autocad中绘图
但在显示点和文本上绘制z值是一个块
之后，当我勾选列表时，它在相同的x，y和z坐标上。
请参考附件样本：）
谢谢
哈什哈德：）
样本。pdf 试试这个
;; local defun
;; entmake block
(defun makepoint()
(if (not (tblsearch "BLOCK" "POINT_ELEV"))
(progn
(initget 6)
(setq hgt (getreal "\nEnter text height of attribute <2.5>: "))
(if (not hgt)
(setq hgt 2.5))
(entmake
(mapcar 'cons
(list 0 8 2 70 10 3)
(list "BLOCK" "0" "POINT_ELEV" 2 '(0 0 0) "POINT_ELEV")))
(entmake
(mapcar 'cons
(list 0 8 62 10 210 50)
(list "POINT" "0" 0 (list 0 0 0) '(0 0 1) 0.0)))
(entmake
(mapcar 'cons
(list 0 8 62 10 40 70 1 210 3 2)
(list "ATTDEF"
"0"
0
(list (/ hgt 2) (* hgt 2.5) 0)
2.5
9
"x"
'(0 0 1)
"Topo point X coordinate"
"XCOORD")))
(entmake
(mapcar 'cons
(list 0 8 62 10 40 70 1 210 3 2)
(list "ATTDEF"
"0"
0
(list (/ hgt 2) (* hgt 1.5) 0)
2.5
9
"y"
'(0 0 1)
"Topo point Y coordinate"
"YCOORD")))
(entmake
(mapcar 'cons
(list 0 8 62 10 40 70 1 210 3 2)
(list "ATTDEF"
"0"
6
(list (/ hgt 2) (/ hgt 2) 0)
2.5
8
"z"
'(0 0 1)
"Topo point Z coordinate"
"ZCOORD")))
(entmake
(mapcar 'cons
(list 0
(list "ENDBLK" "0"))))))
;; main programm
(defun C:PP(/ att_tag ent new_value next next_data osm point_list)
(makepoint)
(if (not (tblsearch "BLOCK" "POINT_ELEV"))
(progn
(alert "Something wrong\nprogramm stopped")
(exit)
(princ)))
(setq osm (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(setq point_list
(list
'(17 20 2.5) '(21 24 3.4) '(25 28 4.3) '(29 32 5.2) '(33 36 2.5) '(37 40 3.4)))
(foreach pointpoint_list
(command "._-insert" "POINT_ELEV" point 1 1 0)
(setq ent (entlast))
(setq next ent)
(while (setq next (entnext next))
(setq next_data (entget next))
(setq att_tag (cdr (assoc 2 next_data)))
(cond
((eq (strcase "XCOORD") att_tag)
(setq new_value (rtos (car point) 2 1)))
((eq (strcase "YCOORD") att_tag)
(setq new_value (rtos (cadr point) 2 1)))
((eq (strcase "ZCOORD") att_tag)
(setq new_value (rtos (caddr point) 2 1))))
(entmod
(subst (cons 1 new_value) (assoc 1 next_data) next_data))
(entupd ent)
)
)
(command "._zoom" "_e");by suit
(setvar "osmode" osm)
(setvar "cmdecho" 1)
(princ)
)
;; TesT : (C:PP)
(prompt "\n====================================\n")
(prompt "\n\t>>>\tType PP to execute ... \t>>>\n")
(prompt "\n====================================\n")
(prin1)
~'J'~ 谢谢，胖子，但我有很多地面
我发给你的是一个样本，我有一万多个
x、 是的，我们尽全力吧
谢谢
哈沙德 您有XYZ坐标的文件吗？文件的“空格”是否被分隔？ 我希望你知道地面的改进
从网站上我得到了x，y，z数据，我想把它导入cad
但我想展示的是z值，这就是我们的全部目标
机密，如果任何idia将制作该x、y、z点的脚本或lisp
一次完成这个输入
感谢您的回复
哈沙德 查看此示例
心形。exel文件
谢谢
哈萨德
样本。拉链 你明白了，我以前从未使用过excell文件。但是这里有很多关于它的线索。搜索并找到答案。
继续关注此线程
~'J'~ 看看它将如何为你工作
;; PP.lsp
;; read Excel, draw points in Acad as blocks with attributes
;; local defun
;; entmake block
(defun makepoint()
(if (not (tblsearch "BLOCK" "POINT_ELEV"))
(progn
(initget 6)
(setq hgt (getreal "\nEnter text height of attribute <2.5>: "))
(if (not hgt)
(setq hgt 2.5))
(entmake
(mapcar 'cons
(list 0 8 2 70 10 3)
(list "BLOCK" "0" "POINT_ELEV" 2 '(0 0 0) "POINT_ELEV")))
(entmake
(mapcar 'cons
(list 0 8 62 10 210 50)
(list "POINT" "0" 0 (list 0 0 0) '(0 0 1) 0.0)))
(entmake
(mapcar 'cons
(list 0 8 62 10 40 70 1 210 3 2)
(list "ATTDEF"
"0"
0
(list (/ hgt 2) (* hgt 2.5) 0)
2.5
9
"x"
'(0 0 1)
"Topo point X coordinate"
"XCOORD")))
(entmake
(mapcar 'cons
(list 0 8 62 10 40 70 1 210 3 2)
(list "ATTDEF"
"0"
0
(list (/ hgt 2) (* hgt 1.5) 0)
2.5
9
"y"
'(0 0 1)
"Topo point Y coordinate"
"YCOORD")))
(entmake
(mapcar 'cons
(list 0 8 62 10 40 70 1 210 3 2)
(list "ATTDEF"
"0"
6
(list (/ hgt 2) (/ hgt 2) 0)
2.5
8
"z"
'(0 0 1)
"Topo point Z coordinate"
"ZCOORD")))
(entmake
(mapcar 'cons
(list 0
(list "ENDBLK" "0"))))))
;; local defun
;; to read the Excel range
(defun EXR(FilePath ShtNum StrRange / ExcelApp ExcData Sht UsdRange Wbk)
;; based on function "EXD" from this page:
;; http://www.cadforyou.spb.ru/index.php?current_section=section_functions_page
(vl-load-com)
(setq ExcelApp (vlax-get-or-create-object "Excel.Application"))
(vla-put-visible ExcelApp :vlax-true) ; or :vlax-false if you want
(vlax-put-property ExcelApp 'DisplayAlerts :vlax-false)
(setq Wbk (vl-catch-all-apply
'vla-open
(list (vlax-get-property ExcelApp "WorkBooks") FilePath)
)
)
(setq Sht (vl-catch-all-apply
'vlax-get-property
(list (vlax-get-property Wbk "Sheets")
"Item"
ShtNum
)
)
)
(vlax-invoke-method Sht "Activate")
(setq UsdRange (vlax-get-property
(vlax-get-property Sht 'Cells)
"Range"
StrRange)
ExcData (vlax-safearray->list
(vlax-variant-value
(vlax-get-property UsdRange 'Value2)
)
)
)
(setq
ExcData (mapcar
(function (lambda (x) (mapcar 'vlax-variant-value x)))
ExcData
)
)
(vl-catch-all-apply
'vlax-invoke-method
(list Wbk "Close")
)
(vl-catch-all-apply
'vlax-invoke-method
(list ExcelApp "Quit")
)
(mapcar
(function
(lambda (x)
(vl-catch-all-apply
(function (lambda ()
(progn
(if (not (vlax-object-released-p x))
(progn
(vlax-release-object x)
(setq x nil)
)
)
)
)
)
)
)
)
(list UsdRange Sht Wbk ExcelApp)
)
(gc)
(gc)
ExcData
)
;; main part ;;
(defun C:PP(/ Att_Tag Ent Filepath Headflag New_Value Next Next_Data
Osm Poinlist Response Shtnum Strrange)
(or (vl-load-com))
(setq FilePath (getfiled "Select Excel file to read :"
(getvar "dwgprefix")
"xls"
16
)
)
(initget 6)
(setq ShtNum (getint "\nEnter the sheet number <1> : "))
(if (not ShtNum)
(setq ShtNum 1))
(setq strRange (strcase
(getstring "\nEnter address of used range <A1:C99>: ")))
(if (eq "" strRange)
(setq strRange "A1:C99"))
(initget "Yes No")
(setq Response (getkword
"\n Is the Excel table has the headers? (Y/N) <Y>: "))
(if (not Response)
(setq Response "Yes"))
(if (eq "Yes" Response)
(setq HeadFlag T)
(setq HeadFlag nil))
(setq PoinList (EXR FilePath ShtNum strRange))
(if HeadFlag
(setq PoinList (cdr PoinList)))
(if PoinList
(progn
(makepoint)
(if (not (tblsearch "BLOCK" "POINT_ELEV"))
(progn
(alert "Something wrong\nprogramm stopped")
(exit)
(princ)))
(setq osm (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(foreach pointPoinList
(command "._-insert" "POINT_ELEV" point 1 1 0)
(setq ent (entlast))
(setq next ent)
(while (setq next (entnext next))
(setq next_data (entget next))
(setq att_tag (cdr (assoc 2 next_data)))
(cond
((eq (strcase "XCOORD") att_tag)
(setq new_value (rtos (car point) 2 1)))
((eq (strcase "YCOORD") att_tag)
(setq new_value (rtos (cadr point) 2 1)))
((eq (strcase "ZCOORD") att_tag)
(setq new_value (rtos (caddr point) 2 1))))
(entmod
(subst (cons 1 new_value) (assoc 1 next_data) next_data))
(entupd ent)
)
)
(command "._zoom" "_e");by suit
)
(alert "Trouble with reading Excel data")
)
(setvar "osmode" osm)
(setvar "cmdecho" 1)
(princ)
)
;; TesT : (C:PP)
(prompt "\n====================================\n")
(prompt "\n\t>>>\tType PP to execute ... \t>>>\n")
(prompt "\n====================================\n")
(prin1)
~'J'~ 好的，胖子，尽力吧
祝你好运！
谢谢
哈沙德
页:
[1]
2