从中提取长度和角度乐筑天下 - Powered by Discuz! Archiver

Tiger 发表于 2022-7-6 10:11:03

输入MKLNS在加载Lisp后运行它。

JohnM 发表于 2022-7-6 10:14:54

复制此帖子中的代码
将其粘贴到记事本中
将记事本另存为“test.lsp”（使用“另存为”对话框中的引号将类型另存为.lsp）
在AutoCAD中应用测试。lsp
在命令行上键入mklns

fuccaro 发表于 2022-7-6 10:16:08

快速测试：从论坛复制源文件并将其粘贴到AutoCAD的命令行中。接下来键入名称（klns）以启动它。
如果保存了lisp文件，则可以使用Appload命令加载该文件，或仅在AutoCAD的绘图区域中拖动该文件。

pBe 发表于 2022-7-6 10:20:40

(defun c:test (/ CreateList _grAngle adoc Plines obj cnt ent ObjectPointList
            PtAngleList Xpoint gr NewLine
            )
;;; pBe April 2011;;;
(vl-load-com)
(defun CreateList (p)
(setq ObjectPointList (cons (cdr p) ObjectPointList))
)
;;;Alanjt;;;
(defun _grAngle (a b)
(grdraw (trans a 0 1) (cadr gr) 1 -1)
(angle a b)
)
;;;    ;;;
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(if (setq Plines (ssget ":L" '((0 . "LWPOLYLINE"))))
(progn
   (repeat (setq cnt (sslength Plines))
   (setq obj (ssname Plines (setq cnt (1- cnt)))
      ent (entget obj)
      )
   (mapcar 'CreateList
      (vl-remove-if-not '(lambda (x) (= (car x) 10)) ent)
      )
   (ssdel obj Plines)
   )
(if ObjectPointList
   (progn
   (setq PtAngleList (open (strcat (getvar 'Dwgprefix)(vl-filename-base (getvar 'Dwgname)) ".csv") "A"))
;;;Alanjt;;;
      (while (eq 5 (car (setq gr (grread T 15 0))))
         (setq Xpoint (trans (cadr gr) 1 0))
         (redraw)
         (foreach pts ObjectPointList (_grAngle pts Xpoint))
            )
;;;                ;;;
      (redraw)
      (foreach
         itm ObjectPointList
         (setq NewLine
            (vla-addline
            (vlax-get (vla-get-activelayout adoc) 'Block)
            (vlax-3d-point Xpoint)
            (vlax-3d-point itm)
            )
         )
               (write-line (strcat (rtos (vla-get-length NewLine) 2 2) ","
                  (rtos (vla-get-Angle NewLine) 2 2)) PtAngleList)
         )
   (close PtAngleList)
      )
   )
   )
)
(princ)
)

Lee Mac 发表于 2022-7-6 10:22:04

pBe，

一些建设性的批评，我希望能有所帮助：注意，在grRead循环中不需要角度计算，因为您没有使用“u grAngle”的返回，而且，在测量直线的长度和角度时，使用距离和角度函数可能更快。

我可以这样做：

(defun c:test ( / e fl gr i pt pu pw ss )
(if
(and
(setq ss (ssget '((0 . "LWPOLYLINE"))))
(setq fl (getfiled "Output File" "" "csv" 1))
)
(progn
(repeat (setq i (sslength ss))
   (foreach x (entget (setq e (ssname ss (setq i (1- i)))))
      (if (= 10 (car x))
      (setq pw (cons (trans (cdr x) e 0) pw)
            pu (cons (trans (cdr x) e 1) pu)
      )
      )
   )
)
(while (= 5 (car (setq gr (grread t 13 0)))) (redraw)
   (setq pt (cadr gr))
   (foreach x pu (grdraw x pt 1 -1))
)
(setq pt (trans pt 1 0))

(if (setq fl (open fl "w"))
   (progn
      (foreach x pw
      (entmakex (list (cons 0 "LINE") (cons 10 x) (cons 11 pt)))
      (write-line (strcat (rtos (distance pt x)) "," (angtos (angle pt x))) fl)
      )
      (close fl)
   )
)
)
)
(redraw) (princ)
)

pBe 发表于 2022-7-6 10:26:44

你的批评确实很有帮助，而且总是受欢迎的。我当时想知道为什么我在（当…读…）之后一直出错线路使用（cond…）。谢谢你的提醒。

我想完全消除线的创建，并使用点列表中的距离和角度，因为代码的目的是将数据写入文件。

我认识到你批评李的价值。
特纳克一百万

pBe 发表于 2022-7-6 10:30:17

消除无法使用运行osnap的问题

(defun c:test ( / e fl gr i pt pu pw ss Op accept )
(if
(and
(setq ss (ssget '((0 . "LWPOLYLINE"))))
(setq fl (getfiled "Output File" "" "csv" 1))
)
(progn
(repeat (setq i (sslength ss))
   (foreach x (entget (setq e (ssname ss (setq i (1- i)))))
      (if (= 10 (car x))
      (setq pw (cons (trans (cdr x) e 0) pw)
            pu (cons (trans (cdr x) e 1) pu)
      )
      )
   )
)
(while (not accept)
(setq pt (getpoint "\nSelect Point: ") op nil)
(foreach x pu (grdraw x pt 1 -1))
(while (not (member Op '(97 32)))
(princ "\n<A>ccept Spacebar for other point")(princ)
(setq Op (cadr (grread))))
(if ( = Op 97)(setq accept T))
(redraw))
(setq pt (trans pt 1 0))
(if (setq fl (open fl "w"))
   (progn
      (foreach x pw
      (entmakex (list (cons 0 "LINE") (cons 10 x) (cons 11 pt)))
      (write-line (strcat (rtos (distance pt x)) "," (angtos (angle pt x))) fl)
      )
      (close fl)
   )
)
)
)
(redraw) (princ)
)

Lee Mac 发表于 2022-7-6 10:30:54

好主意！

注意（trans nil）以及grdraw使用UCS点

另一种方法可能是使用getkword：

(defun c:test ( / e fl gr go i pt pu pw ss )
(if
(and
(setq ss (ssget '((0 . "LWPOLYLINE"))))
(setq fl (getfiled "Output File" "" "csv" 1))
)
(progn
(repeat (setq i (sslength ss))
   (foreach x (entget (setq e (ssname ss (setq i (1- i)))))
      (if (= 10 (car x))
      (setq pw (cons (trans (cdr x) e 0) pw)
            pu (cons (trans (cdr x) e 1) pu)
      )
      )
   )
)
(while (and (not go) (setq pt (getpoint "\nSpecify Point: ")))
   (redraw)
   (foreach x pu (grdraw x pt 1 -1))

   (initget "Yes No")
   (setq go (/= "No" (getkword "\nAccept Point? <Yes>: ")))
)

(if (and pt (setq fl (open fl "w")))
   (progn
      (setq pt (trans pt 1 0))
      (foreach x pw
      (entmakex (list (cons 0 "LINE") (cons 10 x) (cons 11 pt)))
      (write-line (strcat (rtos (distance pt x)) "," (angtos (angle pt x))) fl)
      )
      (close fl)
   )
)
)
)
(redraw) (princ)
)

pBe 发表于 2022-7-6 10:35:29

关于trans Lee（修改代码）tnx你死定了
你能给我解释一下Grdraw在UCS分数方面的可怕之处吗

Lee Mac 发表于 2022-7-6 10:38:28

这样更好

对不起，你说的“关于UCS分数的Grdraw的恐怖”是什么意思？

页: 1 [2]

乐筑天下's Archiver