复制坐标数据进剪贴板展线，表格文本均可

wzg356 · 发表于 2015-12-22 16:44:27

本帖最后由 wzg356 于 2022-3-17 21:56 编辑

看起来这种方法有点老土，但却很强大，主要是操作相对方便、自由.

姊妹程序http://bbs.mjtd.com/forum.php?mo ... mp;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)
(setq str (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-search oldstr str)
(setq str (vl-string-subst newstr oldstr 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 lst lstlen1 lstlen2 i ii tmplst plst 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 0 tmplst 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))
(EntmakeLWPL plst 0.1)
(ZoomWindow (apply 'mapcar (cons 'min plst))(apply 'mapcar (cons 'max plst)));缩放窗口
)
)
)
(alert "坐标数据无法识别,请检查！")
)
)
;对话框程序
;=====================================
;参数设置，通过对话框设置参数
(defun set_xydate ( / getdate setdate 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))
(setdate cxyrecordlst)
(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)

;一直对无法逾越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) 
  (setq  str   (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-search  oldstr str) 
      (setq str (vl-string-subst newstr  oldstr 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 lst  lstlen1 lstlen2 i ii tmplst  plst 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 0  tmplst 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))             
      (EntmakeLWPL  plst 0.1) 
      (ZoomWindow (apply 'mapcar (cons 'min  plst))(apply 'mapcar (cons 'max  plst)));缩放窗口 
      ) 
    ) 
        ) 
      (alert "坐标数据无法识别,请检查！") 
  )   
) 
 
;对话框程序 
;===================================== 
;参数设置，通过对话框设置参数 
(defun set_xydate ( / getdate  setdate 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)) 
  (setdate  cxyrecordlst) 
  (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)

decemc · 发表于 2024-11-16 16:59:16

(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:53:30

decemc 发表于 2024-11-16 16:46
选默认的4种之一，发生错误，有人碰到过这种么

用VCCODE调试，没问题
加载后执行命令，又不行，
命令: cxy ; 错误: 参数类型错误: stringp nil

注册 · 发表于 2022-6-27 15:04:53

7年过去了，我才明白这是利器，谢谢楼主，我成长的太慢了

知行ooo李肖坪 · 发表于 2015-12-22 16:55:03

谢谢分享………………

ymcui · 发表于 2015-12-22 17:25:54

谢谢分享………………

zhenz02 · 发表于 2019-7-26 14:54:57

感谢楼主分享

言戲無軍 · 发表于 2020-9-22 10:22:26

很强大的功能现在才发现

无厘崖 · 发表于 2021-4-1 15:08:41

楼主厉害，这个操作简单准确！

work0808 · 发表于 2022-6-6 15:41:05

7年过去了，我才明白这是利器，谢谢楼主，我成长的太慢了

20060510412 · 发表于 2022-6-27 15:09:06

通用性很强，学习了

decemc · 发表于 2024-11-16 16:46:41

选默认的4种之一，发生错误，有人碰到过这种么

账号		自动登录	找回密码
密码			注册

[源码] 复制坐标数据进剪贴板展线，表格文本均可

本帖子中包含更多资源

评分

相关帖子