复制坐标数据进剪贴板展线，表格文本均可
本帖最后由 wzg356 于 2022-3-17 21:56 编辑看起来这种方法有点老土，但却很强大，主要是操作相对方便、自由.
姊妹程序http://bbs.mjtd.com/forum.php?mod=viewthread&tid=184963&page=1&extra=#pid908231
坐标数据放在excel/word/notebook文件里面都没关系
表格、文本格式均可
逗号、空格分隔数据均可
有无坐标点名、点号没关系，每行坐标数据格式统一就行
把坐标数据复制进剪贴板（选定数据范围，然后ctrl+c或右键复制）后启动程序即可;一直对无法逾越lsp操控excel、word,只有用此办法处理了
;看起来这种方法有点老土，但却很强大，主要是操作相对方便、自由。
;wzg356完成于2014年11月22日
;;从剪贴板提取坐标数据画线程序
;通用函数
;;;=====================================
;;;功能：读取系统剪贴板中字符串(GET-CLIP-STRING)
;;来自 明经通道
(defun GET-CLIP-STRING ( / HTML RESULT)
(and (setq HTML (vlax-create-object "htmlfile"))
(setq RESULT (vlax-invoke
(vlax-get (vlax-get HTML 'PARENTWINDOW)'CLIPBOARDDATA)
'GETDATA
"Text"
)
)
(vlax-release-object HTML)
)
RESULT
)
;;;=====================================
;;这是一个很牛的字符串分割法
;;delim是一个字符串集合，其中的每一个字符都会被当作是分割符号 by qjchen@gmail.com
(defun parse4 (str delim / L1 L2)
(setqstr (vl-string->list str)delim (vl-string->list delim) )
(while str
(if(not (member (car str) delim))
(setq l1 (cons (car str) l1))
(if l1(setq l2 (cons (vl-list->string (reverse l1)) l2)l1 nil))
)
(setq str (cdr str))
)
(if l1(setq l2 (cons (vl-list->string (reverse l1)) l2)))
(reverse l2)
)
;;;=====================================
;[功能]entmake生成多段线，带线宽设置
;[用法](EntmakeLWPL vertices Lw)三维点表
(defun EntmakeLWPL (vertices Lw / elist seg)
(setq elist
(list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")
(cons 90 (length vertices)) (cons 70 0) (cons 38 (caddr (car vertices)))
(cons 40 Lw) (cons 41 Lw) (cons 43 Lw)
)
)
(foreach seg vertices (setq elist (append elist (list (cons 10 seg) (cons 42 0)))))
(entmake elist)
)
;=============================
;;; 主程序
;;;第一步
;;;=====================================
;剪贴板数据处理呈数据表，该表为全字符串表
;(setq str (GET-CLIP-STRING))(get-clip-strlst str)
(defun get-clip-strlst (str / strdelitem lst)
;字符串替换子串，一个不留
(defun strdelitem (newstr oldstr str)
(while (vl-string-searcholdstr str)
(setq str (vl-string-subst newstroldstr str))
)
str
)
(cond
((> (length (parse4 str "\t")) 1);优先制表符分隔,word excel复制的表格
(setq str (strdelitem "\r\n" "\r\n\t\t\r\n" (strdelitem "" " " str)));消除空格,空行
(while (or(vl-string-search "\r\n\t" str)(vl-string-search "\t\r\n" str))
(setq str (vl-string-subst "\t" "\r\n\t" str))
(setq str (vl-string-subst "\t" "\t\r\n" str))
);消除单元格多余的回车
(setq lst(mapcar '(lambda (x)(parse4 x "\t"))(parse4 str"\r\n")))
)
((or (> (length(parse4 str "，")) 1) (> (length(parse4 str ",")) 1));次之逗号分隔，txt,word复制的文本
(setq str (strdelitem " |" "," (strdelitem "," "，" str)));统一为半角逗号且确保每个逗号前有值
(setq lst(mapcar '(lambda (x)(parse4 x "|"))(parse4 str"\r\n")))
(setq lst
(mapcar '(lambda (x)(mapcar '(lambda(y)(strdelitem "" " " y)) x))lst)
);去除每个字符串的空格(上面strdelitem一句替换时加的)
)
(cond(> (length(parse4 str " ")) 1);空格分隔，txt,word复制的文本
(setq lst(mapcar '(lambda (x)(parse4 x " "))(parse4 str"\r\n")))
)
(t (setq lst (parse4 str"\r\n")));其它分隔符不识别，按行转为表
)
lst
)
;;;第二步
;;;=====================================
;字符串表中读取坐标数据，转化为数值并画线
(defun clip-coord-pl (form xypos ddx ddy / chechlst ZoomWindow info
str lstlstlen1 lstlen2 i ii tmplstplst y x z minmax)
(defun chechlst (lst / len1 len2);检查表子表长是否大于1，每个子表长度相同
(if (> (setq len1(length lst))1)
(if(= (setq len2(apply 'max (mapcar 'length lst)))
(apply 'min (mapcar 'length lst))
)
(list len1 len2)
)
)
)
;;[功能] 两点窗口缩放
(defun ZoomWindow (p1 p2)
(vla-ZoomWindow *ACAD*
(vlax-3d-point p1) (vlax-3d-point p2)
)
)
(if
(and
(setq str (GET-CLIP-STRING))
(mapcar 'set (list 'lstlen1 'lstlen2)(chechlst(setq lst(get-clip-strlst str))))
)
(progn
(setq ii 0tmplst nil )
(if (= form "1")
(progn;格式为：序号/X/Y的情况，避免与默认之一的X/Y/Z 混淆
(while (and
(<= ii (- lstlen1 1))
(setq y (distof(cadr (nth ii lst))))
(setq x (distof(caddr (nth ii lst))))
)
(setq tmplst(cons (list y x 0)tmplst))
(setq ii(+ ii 1))
)
(if (/= ii lstlen1)
(setq info (strcat "数据第" (rtos (+ ii 1) 2 0) "行有误，请检查！"))
)
)
(cond;以下为默认的四种坐标格式
((= lstlen2 2);X/Y格式
(while (and
(<= ii (- lstlen1 1))
(setq y (distof(car (nth ii lst))))
(setq x (distof(cadr (nth ii lst))))
)
(setq tmplst(cons (list y x 0)tmplst))
(setq ii(+ ii 1))
)
(if (/= ii lstlen1)
(setq info (strcat "数据第" (rtos (+ ii 1) 2 0) "行有误，请检查！"))
)
)
((= lstlen2 3);X/Y/Z格式
(while (and
(<= ii (- lstlen1 1))
(setq y (distof(car (nth ii lst))))
(setq x (distof(cadr (nth ii lst))))
(setq z (distof(caddr (nth ii lst))))
)
(setq tmplst(cons (list y x z)tmplst))
(setq ii(+ ii 1))
)
(if (/= ii lstlen1)
(setq info (strcat "数据第" (rtos (+ ii 1) 2 0) "行有误，请检查！"))
)
)
((= lstlen2 4);点号/X/Y/Z格式
(while (and
(<= ii (- lstlen1 1))
(setq y (distof(cadr (nth ii lst))))
(setq x (distof(caddr (nth ii lst))))
(setq z (distof(cadddr (nth ii lst))))
)
(setq tmplst(cons (list y x z)tmplst))
(setq ii(+ ii 1))
)
(if (/= ii lstlen1)
(setq info (strcat "数据第" (rtos (+ ii 1) 2 0) "行有误，请检查！"))
)
)
((>= lstlen2 5);点号/点名/X/Y/Z格式
(while (and
(<= ii (- lstlen1 1))
(setq y (distof(caddr (nth ii lst))))
(setq x (distof(cadddr (nth ii lst))))
(setq z (distof(nth 4 (nth ii lst))))
)
(setq tmplst(cons (list y x z)tmplst))
(setq ii(+ ii 1))
)
(if (/= ii lstlen1)
(setq info (strcat "坐标数据第" (rtos (+ ii 1) 2 0) "行有误，请检查！"))
)
)
(t (setq info (strcat "坐标信息有误，请检查！")))
)
)
(if info
(alert info)
(progn
(setq plst nil)
(if (= xypos "1")
(foreach pt tmplst
(setq plst (cons (mapcar '+ pt (list ddy ddx 0))plst))
)
(foreach pt tmplst
(setq plst
(cons (mapcar '+ (list(cadr pt)(car pt)(caddr pt)) (list ddy ddx 0))plst)
)
)
)
(setq plst(mapcar'(lambda (x) (trans x 1 0))plst))
(EntmakeLWPLplst 0.1)
(ZoomWindow (apply 'mapcar (cons 'minplst))(apply 'mapcar (cons 'maxplst)));缩放窗口
)
)
)
(alert "坐标数据无法识别,请检查！")
)
)
;对话框程序
;=====================================
;参数设置，通过对话框设置参数
(defun set_xydate ( / getdatesetdate oldcxydate dcl_id dd x y)
(defun getdate ()
(mapcar '(lambda (x) (get_tile x))
(list "xyform1" "xyform2" "XY-YX" "ddx" "ddy" ))
)
(defun setdate(lst / )
(mapcar '(lambda (x y) (set_tile x y))
(list "xyform1" "xyform2" "XY-YX" "ddx" "ddy" )
lst
)
)
(setq oldcxydate (list "0" "1" "0""0.00" "0.00"))
(setq dcl_id (load_dialog (make-xydwdcl)))
(new_dialog "clipxydw" dcl_id)
(if (= cxyrecordlst nil)(setq cxyrecordlst oldcxydate))
(setdatecxyrecordlst)
(action_tile "accept" "(if (or(not(member (type (read (get_tile \"ddx\"))) (list 'INT 'REAL)))(not(member (type (read (get_tile \"ddy\"))) (list 'INT 'REAL))))(alert \"输入框有非数字！\") (progn(setq cxyrecordlst (getdate))(done_dialog 1)))")
(setq dd (start_dialog))
(unload_dialog dcl_id)
(if (= dd 1)
(list
(nth 0 cxyrecordlst)
(nth 2 cxyrecordlst)
(atof (nth 3 cxyrecordlst))
(atof (nth 4 cxyrecordlst))
)
)
)
;===================================
;写对话框
(defun make-xydwdcl(/ lst_str str file f)
(setq lst_str '(
""
"clipxydw:dialog {"
" label = \"复制坐标信息展点-参数设置\" ;"
" :boxed_radio_row {"
" label = \"“坐标行”格式\" ;"
" :radio_button {"
" key = \"xyform1\" ;"
" label = \"|序号|X|Y|\" ;"
" }"
" :radio_button {"
" key = \"xyform2\" ;"
" label = \"默认的4种之一\" ;"
" }"
" }"
" :boxed_radio_column {"
" label = \"默认的4种坐标行\" ;"
" :text {"
" label = \"① |X|Y|② |X|Y|H|③ |序号|X|Y|H|④ |序号|点名|X|Y|H|\" ;"
" }"
" :spacer {}"
" :text {"
" label = \"从Excel,Word,记事本等复制坐标,表格、文本均可,空格或逗号分隔数据\" ;"
" }"
" }"
" :boxed_column {"
" :toggle {"
" key = \"XY-YX\" ;"
" label = \"X Y位置互换,即..|X|Y|..＝＞..|Y|X|..\" ;"
" }"
" }"
" :boxed_row {"
" alignment = centered ;"
" label = \"X Y平移量,例:y=29523356.3 ＝＞y=523356.3,则-29000000\" ;"
" :edit_box {"
" edit_width = 10.5 ;"
" fixed_width = true ;"
" key = \"ddx\" ;"
" label = \"X平移 m\" ;"
" width = 15 ;"
" }"
" :edit_box {"
" alignment = right ;"
" edit_width = 10.5 ;"
" fixed_width = true ;"
" key = \"ddy\" ;"
" label = \"Y平移 m\" ;"
" width = 15 ;"
" }"
" :spacer {}"
" :spacer {}"
" }"
" :spacer {}"
" :text {"
" label = \" 切记! 切记!坐标信息复制至剪贴板再按\\\"确定\\\"。 by wzg356 2014/11/11\" ;"
" }"
" :spacer {}"
" ok_cancel;"
"}"
)
)
(setq file (vl-filename-mktemp "DclTemp.dcl"))
(setq f (open file "w"))
(foreach str lst_str
(princ "\n" f)
(princ str f)
)
(close f)
;;返回
file
)
;;;=================================================================*
;;;发动程序
;;;=====================================
(defun c:cxy( / form xypos ddx ddy)
(vl-Load-COM)
(setq *ACAD*(vlax-get-acad-object))
(mapcar 'set (list 'form 'xypos'ddx 'ddy)(set_xydate))
(if(and form xypos ddx ddy)
(clip-coord-pl form xypos ddx ddy)
)
(princ)
)
(princ "从剪贴板提取坐标数据画线程序已加载,命令:cxy")
(princ)
(defun c:cxy( / form xypos ddx ddy)
(vl-Load-COM)
(setq *ACAD*(vlax-get-acad-object))
(mapcar 'set (list 'form 'xypos'ddx 'ddy)(set_xydate))
(if(and form xypos ddx ddy)
此段 (clip-coord-pl form xypos ddx ddy)出现异常。参数类型错误: stringp nil
35389914.024 3303257.464
35389874.852 3303137.260
35389867.604 3303118.306
35389840.114 3303061.687
使用的这种格式，选择的默认4种之一
decemc 发表于 2024-11-16 16:46
选默认的4种之一，发生错误，有人碰到过这种么
用VCCODE调试，没问题
加载后执行命令，又不行，
命令: cxy ; 错误: 参数类型错误: stringp nil 7年过去了，我才明白这是利器，谢谢楼主，我成长的太慢了 谢谢分享……………… 谢谢分享……………… 感谢楼主分享 很强大的功能 现在才发现 楼主厉害，这个操作简单准确！ 7年过去了，我才明白这是利器，谢谢楼主，我成长的太慢了 通用性很强，学习了 选默认的4种之一，发生错误，有人碰到过这种么
页:
[1]
2