社区 › Auto Lisp › Lisp从coo插入点

Kr1stal1 发表于 2022-7-5 16:46:04

Lisp从coo插入点

大家好，
 
我试图制作一个lisp，将点从txt文件导入autocad，然后将它们折线，并从这些点进行并集，创建一个iregular区域。主要目的是计算该创建对象的面积。
txt文件如下所示：
101 234.442 442.425
102 .....
103....
104...
105...
 
有谁能帮我做这个嘴唇？我有点需要它，直到明天。

BIGAL 发表于 2022-7-5 16:55:45

在excel中打开文件的最快方法，使用空格作为分隔符。
 
在单元格E1的顶部空白一行
然后在单元格E2中使用=串联（b2，“，”，c2）
根据需要将公式完全复制下来
你应该有
普林线
x、 y
x、 y
x、 y等
 
只需复制E列并粘贴到autocad命令行。
 
是的，我可以Lisp程序，但这也一样快。

satishrajdev 发表于 2022-7-5 17:03:10

你可以试试这个：-
(defun c:impnt (/ str->list a b c cm d s)
(defun str->list (str / b)
   (foreach x (reverse (vl-string->list str))
   (cond ((eq x 44) (setq b (cons (list x) b)))
    (t
   (if (not b)
       (setq b (cons (list x) b))
       (setq b (cons (cons x (car b)) (cdr b)))
   )
    )
   )
   )
   (setq b (mapcar '(lambda (x) (vl-list->string (vl-remove 44 x))) b))
   (if        (and (> (length b) 1)
   (numberp (read (car b)))
   (numberp (read (cadr b)))
   (numberp (read (caddr b)))
)
   (list (atof (car b)) (atof (cadr b)) (atof (caddr b)))
   )
)
(if
   (and (setq
   a (getfiled "Select CSV File" (getvar "dwgprefix") "txt;csv" 16)
)
(setq s (getdist "\nSpecify Point Size : "))
(setq a (open a "r"))
(setq c (while        (setq b (read-line a))
           (setq c (cons (str->list b) c))
       )
)
   )
    (progn
      (close a)
      (setq cm (getvar 'cmdecho))
      (setvar 'cmdecho 0)
      (setvar 'pdmode 35)
      (setvar 'pdsize s)
      (setq d (ssadd)
   c (vl-remove nil c)
      )
      (foreach        x c
(ssadd        (entmakex (list        (cons 0 "POINT")
                        (cons 62 3)
                        (cons 10 x)
                  )
        )
        d
)
      )
      (ssadd (entmakex
        (append        (list (cons 0 "LWPOLYLINE")
                      (cons 100 "AcDbEntity")
                      (cons 100 "AcDbPolyline")
                      (cons 90 (length c))
                      (cons 70 1)
                )
                (mapcar (function (lambda (p) (cons 10 p))) c)
        )
      )
      d
      )
      (command "_.zoom" "_o" d "")
      (setvar 'cmdecho cm)
      (sssetfirst nil d)
    )
)
(princ)
)
 
TXT/CSV格式应该是这样的。程序自动跳过标题。
Easting (x),Northing (Y),Elevation (Z)
373247.97,2051482.34,0
373271.02,2051446.02,0
373215.57,2051471.86,0
373210.14,2051497.24,0

BIGAL 发表于 2022-7-5 17:07:00

satishrajdev第1篇文章中的2件事csv文件是Ptnum X Y，所以需要去掉点数，第2件事是他想做一个点线，所以问题是你真的需要点吗？当您使用“car cadr&caddr”时，您可以删除“car”，这将是pt编号。
 
根据我的帖子
普林线
x、 y
x、 y
 
如果两者都需要，那么做一个双通道导入点，然后第二个通道使pline。

Kr1stal1 发表于 2022-7-5 17:15:27

 
谢谢你的帮助。我正努力为我的老师们实现教育目标。
我会检查一下，但直到现在它工作得很好。
祝您有个美好的一天。

satishrajdev 发表于 2022-7-5 17:16:22

我知道，我为某人写了这个例程并直接发布了。我已经根据OP的要求修改了以下代码。
 
(defun c:impnt (/ str->list a b c cm d s)
(defun str->list (str / b)
   (foreach x (reverse (vl-string->list str))
   (cond ((eq x 44) (setq b (cons (list x) b)))
    (t
   (if (not b)
       (setq b (cons (list x) b))
       (setq b (cons (cons x (car b)) (cdr b)))
   )
    )
   )
   )
   (setq b (mapcar '(lambda (x) (vl-list->string (vl-remove 44 x))) b))
   (if        (and (> (length b) 1)
   (numberp (read (cadr b)))
   (numberp (read (caddr b)))
   (numberp (read (cadddr b)))
)
   (list (atof (cadr b)) (atof (caddr b)) (atof (cadddr b)))
   )
)
(if
   (and (setq
   a (getfiled "Select CSV File" (getvar "dwgprefix") "txt;csv" 16)
)
(setq s (getdist "\nSpecify Point Size : "))
(setq a (open a "r"))
(setq c (while        (setq b (read-line a))
           (setq c (cons (str->list b) c))
       )
)
   )
    (progn
      (close a)
      (setq cm (getvar 'cmdecho))
      (setvar 'cmdecho 0)
      (setvar 'pdmode 35)
      (setvar 'pdsize s)
      (setq d (ssadd)
   c (vl-remove nil c)
      )
      (foreach        x c
(ssadd        (entmakex (list        (cons 0 "POINT")
                        (cons 62 3)
                        (cons 10 x)
                  )
        )
        d
)
      )
      (ssadd (entmakex
        (append        (list (cons 0 "LWPOLYLINE")
                      (cons 100 "AcDbEntity")
                      (cons 100 "AcDbPolyline")
                      (cons 90 (length c))
                      (cons 70 1)
                )
                (mapcar (function (lambda (p) (cons 10 p))) c)
        )
      )
      d
      )
      (command "_.zoom" "_o" d "")
      (setvar 'cmdecho cm)
      (sssetfirst nil d)
    )
)
(princ)
)
 
 
另一个没有点实体：
 
(defun c:impnt (/ str->list a c cm d)
(defun str->list (str / b)
   (foreach x (reverse (vl-string->list str))
   (cond ((eq x 44) (setq b (cons (list x) b)))
    (t
   (if (not b)
       (setq b (cons (list x) b))
       (setq b (cons (cons x (car b)) (cdr b)))
   )
    )
   )
   )
   (setq b (mapcar '(lambda (x) (vl-list->string (vl-remove 44 x))) b))
   (if        (and (> (length b) 1)
   (numberp (read (cadr b)))
   (numberp (read (caddr b)))
   (numberp (read (cadddr b)))
)
   (list (atof (cadr b)) (atof (caddr b)) (atof (cadddr b)))
   )
)
(if
   (and (setq
   a (getfiled "Select CSV File"
             (getvar "dwgprefix")
             "txt;csv"
             16
   )
)
(setq a (open a "r"))
(setq c (while        (setq b (read-line a))
           (setq c (cons (str->list b) c))
       )
)
   )
    (progn
      (close a)
      (setq cm (getvar 'cmdecho))
      (setvar 'cmdecho 0)
      (setq d (ssadd)
   c (vl-remove nil c)
      )
      (ssadd (entmakex
        (append        (list (cons 0 "LWPOLYLINE")
                      (cons 100 "AcDbEntity")
                      (cons 100 "AcDbPolyline")
                      (cons 90 (length c))
                      (cons 70 1)
                )
                (mapcar (function (lambda (p) (cons 10 p))) c)
        )
      )
      d
      )
      (command "_.zoom" "_o" d "")
      (setvar 'cmdecho cm)
      (sssetfirst nil d)
    )
)
(princ)
)

satishrajdev 发表于 2022-7-5 17:24:04

 
不客气：）

prodromosm 发表于 2022-7-5 17:29:31

嗨，Kr1stal1。我使用这个lisp来完成这项工作。支持文件选项。
http://www.hawsedc.com/gnu/pointsin.php

BIGAL 发表于 2022-7-5 17:35:01

Satishrajdev这就是调查csv文件的问题，它们可以在CIV3D中到处都是，你有样式，所以指定csv的外观P、x、y、z、d等。
 
导入csv和基于代码的字符串还有一天要做。

hanhphuc 发表于 2022-7-5 17:45:09

1+
 
 
vlisp建议vl every
 
(list (atof (cadr b)) (atof (caddr b)) (atof (cadddr b)))
仅供参考

查看完整版本: Lisp从coo插入点