如何利用lisp程序一次性提取CAD中点的坐标(不要点击每个点,太多了麻烦) 求助：如何用LISP读取CAD中许多散点的坐标
\u6c42\u4fee\u6539lisp\u7a0b\u5e8f\uff0c\u5982\u4f55\u63d0\u53d6CAD\u56fe\u4e2d\u591a\u6bb5\u7ebf\u7684\u5750\u6807\uff08\u8981\u5f53\u524ducs\u5750\u6807\u7cfb\uff09(defun c:tqzb (/)
(setq cm (getvar "cmdecho"))
(setvar "cmdecho" 0)
(if (setq wjm (getfiled "\u8bf7\u6307\u5b9a\u8981\u4fdd\u5b58\u7684\u5750\u6807\u6587\u4ef6" "e:\\" "txt" 1))
(if (setq ssa (ssget '((0 . "LWPOLYLINE"))))
(progn
(setq fff (open wjm "w")
n (sslength ssa)
i 0
no 0
)
(repeat n
(setq dxf (entget (ssname ssa i))
i (1+ i)
ptb (mapcar 'cdr (vl-remove-if-not '(lambda(x)(= (car x) 10)) dxf))
ptb (mapcar '(lambda(x)(trans x 0 1)) ptb)
)
(foreach pt ptb
(setq no (1+ no))
(write-line (strcat (itoa no) ","
(rtos (car pt) 2 2) ","
(rtos (cadr pt) 2 2) ","
)
fff
)
)
)
(close fff)
(princ (strcat "\n\u5750\u6807\u5df2\u5b58\u5165\"" wjm "\"\u4e2d"))
)
)
)
(setvar "cmdecho" cm)
(princ)
)
\u8bf7\u67e5\u770b\u9644\u4ef6\uff0c\u5199\u7684lisp\u7a0b\u5e8f\uff0c\u8f93\u5165tt\u8fd0\u884c\u7a0b\u5e8f\uff0c\u6279\u91cf\u9009\u62e9cad\u4e2d\u7684\u70b9\uff0c\u7136\u540e\u5c06\u5750\u6807\u5199\u5165txt\u6587\u4ef6\u3002
\u6307\u5b9a\u4fdd\u5b58\u6587\u4ef6\u7684\u4f4d\u7f6e\u53ca\u540d\u79f0\uff0c\u7136\u540e\u9009\u62e9\u70b9\u5c31\u6b27\u514b\u4e86\u3002
(DEFUN C:TT ( / ss ff ss1 en pt x y)
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(setvar "dimzin" 0)
(vl-load-com);;加载vlax扩展函数
(setq ss (ssget '((0 . "point"))) n 0);;请选择点
(if (/= ss nil)
(progn
(setq ff (open "d://文字到TXT.txt" "w") ss1 '());;在D盘建立记事本《文字到TXT》这里可以查看内容
(repeat (sslength ss);;循环选择
(setq en (ssname ss n) n (+ n 1);;提取图元
pt (cdr (assoc 10 (entget en)));;取得点坐标
ss1 (cons pt ss1);;加入表
)
)
(setq ss1 (vl-sort ss1 (function (lambda (x y)(< (car x) (car y))))));;X排序从左到右
(setq ss1 (vl-sort ss1 (function (lambda (x y)(> (cadr x) (cadr y))))));;Y排序从上到下
(foreach en ss1;;函数遍历表，将其中每一个元素依次赋给变量，并对每一个表达式求值
(setq x (rtos (car en) 2 5))
(setq y (rtos (cadr en)2 5));;取得Y坐标精确到小数点后5位
(princ x ff)
(princ "," ff)
(princ y ff)
(princ "
" ff)
)
(close ff)
)
)
(princ)
)
这个TT命令修改了一下，可以对点坐标排序，保存到D盘《文字到TXT》记事本里面；实际上坐标需要X=；Y=这个标记的，这个标记表示大地坐标；大地坐标X=cad里面的y坐标，同样的Y=cad里面的x坐标，所以不能够随便修改文字格式。
提供个思路:框选，获取点表，遍历输出
试过了，tt好用的。用tt即可，其余的可以到excel去处理。当然如果对lisp比较熟悉，也可以用lisp全部处理掉。
绛旓細(defun c:tqzb (/)(setq cm (getvar "cmdecho"))(setvar "cmdecho" 0)(if (setq wjm (getfiled "璇锋寚瀹氳淇濆瓨鐨勫潗鏍囨枃浠" "e:\\" "txt" 1))(if (setq ssa (ssget '((0 . "LWPOLYLINE")))(progn (setq fff (open wjm "w")n (sslength ssa)i 0 no 0 )(repeat ...
绛旓細璇锋煡鐪嬮檮浠讹紝鍐欑殑lisp绋嬪簭锛岃緭鍏t杩愯绋嬪簭锛屾壒閲忛夋嫨cad涓殑鐐癸紝鐒跺悗灏嗗潗鏍囧啓鍏xt鏂囦欢銆傛寚瀹氫繚瀛樻枃浠剁殑浣嶇疆鍙婂悕绉帮紝鐒跺悗閫夋嫨鐐瑰氨娆у厠浜嗐
绛旓細鍦–AD涓壒閲忛夋嫨鏂囧瓧銆佺嚎娈点佸浘褰㈢殑鏂规硶鏄娇鐢–AD鐨勯夋嫨闆嗗姛鑳芥垨鑰呴氳繃缂栧啓鑷畾涔夌殑LISP绋嬪簭鏉ュ疄鐜般侰AD鐨勯夋嫨闆嗗姛鑳藉彲浠ュ府鍔╃敤鎴峰熀浜庣壒瀹氬睘鎬э紙渚嬪棰滆壊銆佸浘灞傘佺嚎鍨嬬瓑锛夋潵閫夋嫨瀵硅薄銆傝浣跨敤姝ゅ姛鑳斤紝鐢ㄦ埛鍙互鍦–AD鐨勫懡浠よ涓緭鍏モ淪S鈥濇潵璋冪敤閫夋嫨闆嗗懡浠わ紝鐒跺悗鏍规嵁鎻愮ず閫夋嫨瑕侀夋嫨鐨勫璞＄被鍨嬶紙渚嬪鏂囧瓧銆佺嚎娈点...
绛旓細(defun C:shujuduqu()(shuju1)(shuju2))(defun shuju1()(setq dfn(getfiled "鏁版嵁鏂囦欢" "" "txt" 8)fn (open dfn "r"))(setq data (read-line fn))(command "pline")(if (/= data nil)(progn (while (setq data (read-line fn))(setq xy (read (strcat "(" data ")" ...
绛旓細鍒╃敤CAD杞欢鐨勬暟鎹鎻愬彇鍔熻兘鍙互鎵归噺鎻愬彇鍧愭爣锛屽叿浣撴搷浣滆鍙傜収浠ヤ笅姝ラ銆1銆侀鍏堝湪鐢佃剳涓婃墦寮CAD杞欢锛屾墦寮鍥剧焊锛屽崟鍑诲伐鍏蜂笅鎷夎彍鍗曚腑鐨勨滄暟鎹彁鍙栤濋夐」銆2銆佺劧鍚庡湪鍑虹幇鐨勭獥鍙ｄ腑閫夋嫨鈥滃垱寤烘柊鏁版嵁鎻愬彇鈥濓紝鍗曞嚮涓嬩竴姝ワ紝鎺ョ潃鍦ㄥ嚭鐜扮殑绐楀彛涓粰鏂囦欢鍛藉悕銆3銆佺劧鍚庡湪鍑虹幇鐨勭獥鍙ｄ腑閫夋嫨鈥滃浘绾/鍥剧焊闆嗏濓紝鍗曞嚮涓嬩竴姝ワ紝...
绛旓細璇峰弬鑰冧笅鍒绋嬪簭锛;*鎶婂瓧绗︿覆琛ㄧず鐨勮〃杞寲鎴愬疄鏁拌〃绀虹殑琛 (defun release (l / flag count slength single data itemlist temp)(if l (progn (foreach item l (setq count 1 flag T slength (strlen item) itemlist nil )(while (<= count slength)(setq single (substr item count 1))(...
绛旓細闅剧偣鏄鍙朎xcel鐨勬暟鎹紝缁欎綘涓摼鎺ュ埌閭ｄ笅杞戒釜CAD鐩存帴杩炴帴Excel鐨勬簮浠ｇ爜 http://www.atablex.com/download/vlxls.zip杩欎釜浼氫簡锛屽惊鐜墽琛岀缉鏀惧拰鍑芥暟搴旇閮芥槸鏋佺畝鍗曠殑浜嬫儏浜嗐
绛旓細鍦ㄥ畠鐨勬渶鍚庡姞涓婁綘鐨勫悗涓や釜鍑芥暟鍙ュ瓙锛屼繚瀛樹箣锛堣浠ヤ笅绗竴涓埅鍥撅級銆傝繖鏍峰湪AutoCAD鍚姩鍚庯紝灏变細鑷姩杩愯杩欎袱鍙ュ嚱鏁般傝屼笖涓鑸粯璁ょ殑鏄瘡鏂板缓涓寮犲浘鏃讹紝鍧囦細鑷姩杩愯銆傝繕鏈夊嚑涓枃浠朵篃浼氬湪鍔犺浇鏃惰嚜鍔ㄨ皟鍏ュ唴瀛樼殑锛屼粠鈥滃簲鐢绋嬪簭鍔犺浇鈥濆璇濇涓彲浠ョ湅鍑猴紙瑙佷笅闈㈢浜屼釜鎴浘鐨勫乏涓嬭锛夈傚鏋滀綘鍦ㄨ繖浜涙枃浠朵腑鍔犲叆...
绛旓細(prompt "閫夋嫨瑕佹嫹璐濈殑鐩爣:")(setq en (ssget))(prompt "杈撳叆鍩虹偣:")(setq p1 (getpoint))(command "copy" en "" p1 )(while (setq p2 (getpoint))(command p2)))鍦ㄤ笂闈㈢殑绋嬪簭涓簲娌¤緭鍏"m"铏界劧copy鍦ㄥ懡浠や笅鏄娆℃嫹璐濈殑鍦ㄧ▼搴忎腑缁欏畠浜嗗娆℃嫹璐濈殑鏉′欢锛屼絾鍙兘鎷疯礉涓娆銆(defun c:ccp...
绛旓細鍧楀睘鎬ч渶瑕佺敤entnext涓嶆柇鐨勫線鍚庡彇寰楀埌锛屼笅闈㈢粰浣犱竴涓緥瀛 ;;;鎶婁袱涓睘鎬у揩鐨勫睘鎬ф墽琛屼竴鑷 (defun C:bpp() ;;;澶嶅埗灞炴 (setq ent1 nil ent2 nil)(while (= nil ent1)(setq ent1 (car (entsel "\n鏁版嵁婧愬潡锛"))) ;;;鍙栧叾涓 涓涓潡 (while (= nil ent2)(setq ent2 (car (...
