[求助]：求高人赐教展点的lisp

linjing3489 · 发表于 2009-1-8 13:27:37

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

我想搞一个展点的lisp，但是总是有点问题，请路过的高人指点
1/坐标点的格式是：1，，254552，45542，21.2
                              即：点号，点名，x，y，z  这里的x，y与cad 坐标系一致。
2/ 标注的z值只保留一位小数。
3/cad 图上的格式是：同时标注点位、点名、高程。
点位是一个直径0.3的圆，上面是点号，下面是高程，中间一条直线指向坐标点即圆心。  标注文字字高2.0或2.5。
4/ 要求自动形成点位、点名、分隔线、高程这四个层，以利于向mapgis转换之后的位置调整。
请问如何实现？
千恩万谢啊  最近有用，大量的这种展点要用到这个东西，我飞了很大劲就是做不到，服了，网上的例子好像都不是一体标注，况且位置形式都不符合测量规范。

eachy · 发表于 2009-1-8 13:38:49

发上 Dwg 及数据文件

kmdz · 发表于 2009-1-8 17:17:47

用南方CASS啥，即使展点编出来了也没多大用，做地形图还得编其它的程序，南方现在用起来感觉还是可以。

sjy2005 · 发表于 2009-1-8 17:47:43

可以实现你的部分要求，自编一个，但要花时间，可给我加15积分吗？

不好意思，下载文件要积分，我才4分，干什么都不行呀

zml84 · 发表于 2009-1-8 19:27:02

(setq mode
 (getkword
 "\n请选择输出项目：[编号(0)/编码(1)/X值(2)/Y值(3)/Z值(4)]:"
 )
 )

你要的东东，这里有：
http://zml84.blog.sohu.com/54345418.html

sexgjgj · 发表于 2009-1-8 20:09:45

good

linjing3489 · 发表于 2009-1-8 22:34:36

各位费心了  谢谢
  zml84提到的效果不好，kmdz  讲的南方展点只能一次一次的展，要手动分层，而且高程和点号位置重叠、没有分割线、展点号后必须另外一个个的移开，再展一次高程、再加上分割线，非常麻烦，同时，点位节点是两个重复的点，编辑时又添一层麻烦
   我要的是一次展完，达到效果，且分出四个层。
见附件中的效果图和数据格式
  我的最终用途，最后是用来转换成mapgis格式，但是由于转换之后，注释字符出现偏移，如果不能有层的分别，当点很多时，移动起来是极其痛苦的！

1,,1615553.6,4539731.1,313.1
2,,1615580.9,4539710.5,300.9
3,,1615644.3,4539658.2,266.6
4,,1615650.6,4539667.1,264.7
5,,1615657.3,4539662.5,266.9
6,,1615641.3,4539641.4,267.3
7,,1615613.2,4539628.1,267.2

Underway · 发表于 2009-1-9 12:10:35

;;;=======================================
;;; 字形字高用内定值
(defun zd (str)
;; (parse "1,,1615553.6,4539731.1,313.1" ",")
(setq strss (parse str ",")
Num (car strss)
strss (reverse strss)
strz (car strss)
stry (cadr strss)
strx (caddr strss)
ptc (list (atof strx) (atof stry))
pta (mapcar '+ ptc '(2.5 0))
ptb (mapcar '+ pta '(10.0 0))
ptm (mapcar '+ pta '(5.0 0))
dd (list 0.0 (/ 13.0 64))
ptm上 (mapcar '+ ptm dd)
ptm下 (mapcar '- ptm dd)
)
(entmake
(list
'(0 . "CIRCLE")
'(8 . "\\M+5B5E3\\M+5CEBB")
(cons 10 ptc)
(cons 40 0.15) ; Dia = 0.3
)
)
(entmake
(list
'(0 . "LINE")
'(8 . "\\M+5B7D6\\M+5B8EE\\M+5CFDF")
(cons 10 pta)
(cons 11 ptb)
)
)
(setvar "Clayer" "\\M+5B5E3\\M+5BAC5")
(command "Text" "BC" ptm上 "" 0 Num)
(setvar "Clayer" "\\M+5B8DF\\M+5B3CC")
(command "Text" "TC" ptm下 "" 0 Strz)
)
;;; for test only
;;; ZdDwt.dwg 需在支援路径之下
(defun C:zd4L ()
(setvar "Osmode" 0)
(cond
((setq file (getfiled "选择展点文件" "" "" 4))
(command "Insert" "ZdDwt" ^M)
(if parse nil (load "Parse"))
(setq fp (open file "r"))
(while (setq STR (read-line fp))
(zd str)
)
(close fp)
(command "Zoom" "E")
)
(T nil)
)
(princ)
)

;;;======================================= 
;;; 字形字高用内定值 
(defun zd (str) 
  ;; (parse "1,,1615553.6,4539731.1,313.1" ",") 
  (setq strss (parse str ",") 
        Num   (car strss) 
        strss (reverse strss) 
        strz  (car strss) 
        stry  (cadr strss) 
        strx  (caddr strss) 
        ptc   (list (atof strx) (atof stry)) 
        pta   (mapcar '+ ptc '(2.5 0)) 
        ptb   (mapcar '+ pta '(10.0 0)) 
        ptm   (mapcar '+ pta '(5.0 0)) 
        dd    (list 0.0 (/ 13.0 64)) 
        ptm上 (mapcar '+ ptm dd) 
        ptm下 (mapcar '- ptm dd) 
  ) 
  (entmake 
    (list 
      '(0 . "CIRCLE") 
      '(8 . "\\M+5B5E3\\M+5CEBB") 
      (cons 10 ptc) 
      (cons 40 0.15)                    ; Dia = 0.3 
 
    ) 
  ) 
 
  (entmake 
    (list 
      '(0 . "LINE") 
      '(8 . "\\M+5B7D6\\M+5B8EE\\M+5CFDF") 
      (cons 10 pta) 
      (cons 11 ptb) 
    ) 
  ) 
 
  (setvar "Clayer" "\\M+5B5E3\\M+5BAC5") 
  (command "Text" "BC" ptm上 "" 0 Num) 
 
  (setvar "Clayer" "\\M+5B8DF\\M+5B3CC") 
  (command "Text" "TC" ptm下 "" 0 Strz) 
) 
 
;;; for test only 
;;; ZdDwt.dwg 需在支援路径之下 
 
(defun C:zd4L () 
  (setvar "Osmode" 0) 
  (cond 
    ((setq file (getfiled "选择展点文件" "" "" 4)) 
     (command "Insert" "ZdDwt" ^M) 
     (if parse nil (load "Parse")) 
     (setq fp (open file "r")) 
     (while (setq STR (read-line fp)) 
       (zd str) 
     ) 
     (close fp) 
     (command "Zoom" "E") 
    ) 
    (T nil) 
  ) 
  (princ) 
)

;; 请搭配附件测试

eachy · 发表于 2009-1-9 14:26:57

(setq *acad* (vlax-get-acad-object)
*Acdocument* (vla-get-activedocument *acad*)
*modelspace* (vla-get-modelspace *Acdocument*)
)
(vl-load-com)
(defun c:tt (/ addtxt fl lst)
(defun addmark (lst / addtxt p1 p2 p3 p4 num pt z)
(defun addtxt (str p lyr mode / txt)
(setq txt (vla-addtext *modelspace* str p 2.5))
(vla-put-alignment txt mode)
(vla-put-textalignmentpoint txt p)
(vla-put-layer txt lyr)
txt
)
(setq num (rtos (car lst) 2 0)
pt (list (cadr lst) (caddr lst) (cadddr lst))
z (rtos (cadddr lst) 2 1)
)
(setq p1 (vlax-3d-point (mapcar '+ pt '(2.4 0. 0.)))
p2 (vlax-3d-point (mapcar '+ pt '(12.4 0. 0.)))
p3 (vlax-3d-point (mapcar '+ pt '(7.4 0.7 0.)))
p4 (vlax-3d-point (mapcar '+ pt '(7.4 -0.7 0.)))
)
(vla-put-layer
(vla-addcircle *modelspace* (vlax-3d-point pt) 0.3)
"点位"
)
(vla-put-layer
(vla-addline *modelspace* p1 p2)
"分割线"
)
(addtxt num p3 "点号" acAlignmentBottomCenter)
(addtxt z p4 "高程" acAlignmentTopCenter)
)
(defun ybl-readfile (fn / f line re)
(setq f (open fn "r"))
(while (setq line (read-line f))
(setq re (cons line re))
)
(close f)
(reverse re)
)
(if (setq fl (getfiled "选择dat文件"
""
"dat"
4
)
)
(progn
;;1,,1615553.6,4539731.1,313.1
(setq lst (mapcar '(lambda (x)
(read (vl-string-translate
","
" "
(strcat "(" x ")")
)
)
)
(ybl-readfile fl)
)
)
(vl-cmdf ".layer" "m" "点位" "m" "分割线" "m" "点号" "m" "高程" "")
(foreach x lst
(addmark x)
)
)
)
(princ)
)

(setq *acad*           (vlax-get-acad-object) 
      *Acdocument* (vla-get-activedocument *acad*) 
      *modelspace* (vla-get-modelspace *Acdocument*) 
) 
(vl-load-com) 
(defun c:tt (/ addtxt fl lst) 
  (defun addmark (lst / addtxt p1 p2 p3 p4 num pt z) 
    (defun addtxt (str p lyr mode / txt) 
      (setq txt (vla-addtext *modelspace* str p 2.5)) 
      (vla-put-alignment txt mode) 
      (vla-put-textalignmentpoint txt p) 
      (vla-put-layer txt lyr) 
      txt 
    ) 
    (setq num (rtos (car lst) 2 0) 
          pt  (list (cadr lst) (caddr lst) (cadddr lst)) 
          z   (rtos (cadddr lst) 2 1) 
    ) 
    (setq p1 (vlax-3d-point (mapcar '+ pt '(2.4 0. 0.))) 
          p2 (vlax-3d-point (mapcar '+ pt '(12.4 0. 0.))) 
          p3 (vlax-3d-point (mapcar '+ pt '(7.4 0.7 0.))) 
          p4 (vlax-3d-point (mapcar '+ pt '(7.4 -0.7 0.))) 
    ) 
 
    (vla-put-layer 
      (vla-addcircle *modelspace* (vlax-3d-point pt) 0.3) 
      "点位" 
    ) 
    (vla-put-layer 
      (vla-addline *modelspace* p1 p2) 
      "分割线" 
    ) 
    (addtxt num p3 "点号" acAlignmentBottomCenter) 
    (addtxt z p4 "高程" acAlignmentTopCenter) 
  ) 
  (defun ybl-readfile (fn / f line re) 
    (setq f (open fn "r")) 
    (while (setq line (read-line f)) 
      (setq re (cons line re)) 
    ) 
    (close f) 
    (reverse re) 
  ) 
  (if (setq fl (getfiled "选择dat文件" 
                         "" 
                         "dat" 
                         4 
               ) 
      ) 
    (progn 
      ;;1,,1615553.6,4539731.1,313.1 
      (setq lst        (mapcar        '(lambda (x) 
                           (read (vl-string-translate 
                                   "," 
                                   " " 
                                   (strcat "(" x ")") 
                                 ) 
                           ) 
                         ) 
                        (ybl-readfile fl) 
                ) 
      ) 
      (vl-cmdf ".layer"        "m" "点位" "m" "分割线"        "m" "点号" "m" "高程" "") 
      (foreach x lst 
        (addmark x) 
      ) 
    ) 
  ) 
  (princ) 
)

xiaoyu5068 · 发表于 2009-1-9 18:40:58

我们这里也是这样的格式，可惜不是很懂，8、9楼的程序怎么用啊，不会用！哪位说明一下好吗？

linjing3489 · 发表于 2009-1-9 19:02:55

Underway 的效果太好了！完全满足需要！太感谢了!

斑竹出现错误提示no function definition: VLAX-GET-ACAD-OBJECT,

两位的代码高深莫测，只能用，一时半会儿看不明白，呵呵，看来我的路还很长，天上人间呀

Free-Lancer · 发表于 2009-1-9 19:42:31

在命令行先输入(vl-load-com),在执行命令

linjing3489 · 发表于 2009-1-9 23:08:32

明白了，我在代码的第一行加上(vl-load-com)就可以了，多谢，斑竹的比较干脆利落，借鉴一下Underway 的层颜色设置，太好了！
感谢各位师兄！

cy4162465 · 发表于 2009-9-5 08:13:19

正是我想要的谢谢

hehaidizhi · 发表于 2016-12-15 17:51:53

Underway 发表于 2009-1-9 12:10

附件在哪里啊？都看不到啊？还有人在吗？

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

[求助] [求助]：求高人赐教展点的lisp

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子