suriwaits 发表于 2022-7-6 00:00:34

Lisp从notep放置多行文字

你好
 
我有一个记事本，包含大约100个材料描述，如下所示。假设我已将记事本保存在D：列表中。txt文件
 
1001.预制混凝土块，类型：绑扎，饰面：抛丸，
颜色：棕色，尺寸：200x100x60MM
 
1002.砂岩，类型：插入，表面处理：喷丸，
颜色：棕褐色，尺寸：200x200x40MM
 
1003.铝，类型：围栏，饰面：聚酯粉末涂层，
颜色：RAL 3005，尺寸：1000MM高
 
我需要一个lisp来完成以下操作，
1、调用物料代码
如果我输入1001
应在“文字”层上放置一个带有多行文字的引线，该多行文字带有“预制混凝土块，类型：捆扎，饰面：抛丸，颜色：棕色，尺寸：200x100x60MM”。
 
谢谢你的建议
 
Suriwaits。

Lee Mac 发表于 2022-7-6 00:16:53

通过CAB查看此程序
 
[可能需要沼泽会员才能查看]

pBe 发表于 2022-7-6 00:25:50

这是一个旧代码[修改]
(defun c:mtl (/ source file a look4 found f pt1 pt2)
(defun *error* (msg)
   (command "._undo" "_end")
   (setvar 'osmode old_os)(setvar 'DIMTAD tad)
   (setvar 'DIMGAP gap) (setvar 'cmdecho 1)
)
(setvar 'cmdecho 0)
(command "._undo" "_begin")
(setq        tad    (getvar 'DIMTAD)
gap    (getvar 'DIMGAP)
old_os (getvar 'Osmode)
)
(setvar 'DIMTAD 0) (setvar 'DIMGAP -0.09)(setvar 'osmode 0)
(if (and (null data)
   (setq source        (getfiled "Select File for Material Specification"
                          (getvar 'DWgprefix)
                          "txt"
                          16
                )
   )
   )
   (progn
   (setq file (open source "r"))
   (while (setq a (read-line file))
(if (/= "" a)
(setq data (cons a data))
)
   )
   (close file)
   (setq data (reverse data))
   )
)
(while
   (and data (setq look4 (getint "\nEnter Material number: ")))
    (if (setq found
        (vl-some '(lambda (s)
                  (if        (wcmatch s (strcat (itoa look4) "*"))
                      s
                  )
                  )
               data
        )
)
      (progn
(setq pt1 (getpoint "\nPick Point for Label arrow: "))
(setq pt2 (getpoint pt1 "\n Place Material Specs: "))
(command
   "leader"
   pt1
   pt2
   ""
   (strcat (car (setq f (member found data))) "\\P" (cadr f))
   ""
   ^c
)
      )
      (princ "\n<<<Material number not found>>>")
    )
)
(*error* "")
(princ)
)


(defun c:resetD        nil
(setq data nil)
(princ "\n        <<<Ready to read updated Data file>>>        ")
(princ)
)

suriwaits 发表于 2022-7-6 00:27:41

谢谢LM，
CAB的程序看起来很棒。
 

suriwaits 发表于 2022-7-6 00:42:29

谢谢pBe，
 
你的程序看起来很简单，完全符合我的需要。
是否可以使用3点引线而不是2点引线，并且不带方框的文本将非常好。
没有数字的多行文字也不错。

pBe 发表于 2022-7-6 00:48:30

 
(defun c:mtl (/ source file a look4 found f pt1 pt2)
(defun *error* (msg)
   (command "._undo" "_end")
   (setvar 'osmode old_os)
   (setvar 'cmdecho 1)
)
(setvar 'cmdecho 0)
(command "._undo" "_begin")
(setq       old_os (getvar 'Osmode))
(setvar 'osmode 0)
(if (and (null data)
   (setq source        (getfiled "Select File for Material Specification"
                          (getvar 'DWgprefix)
                          "txt"
                          16
                )
   )
   )
   (progn
   (setq file (open source "r"))
   (while (setq a (read-line file))
(if (/= "" a)
(setq data (cons a data))
)
   )
   (close file)
   (setq data (reverse data))
   )
)
(while
   (and data (setq look4 (getint "\nEnter Material number: ")))
    (if (setq found
        (vl-some '(lambda (s)
                  (if        (wcmatch s (strcat (itoa look4) "*"))
                      s
                  )
                  )
               data
        )
)
      (progn
(setq pt1 (getpoint "\nPick Point for Label arrow: "))
(setq pt2 (getpoint pt1 "\n Pick second point: "))
(grdraw pt1 pt2 7)
(setq pt3 (getpoint pt2 "\n Place Material Specs: "))
(setq str (strcat (car (setq f (member found data))) "\\P" (cadr f)))
(command
   "leader"
   pt1
   pt2 pt3
   ""
   (substr str (+ 2 (vl-string-position 46 str)))
   ""
   ^c
)
      )
      (princ "\n<<<Material number not found>>>")
    )
)
(*error* "")
(princ)
)


(defun c:resetD        nil
(setq data nil)
(princ "\n        <<<Ready to read updated Data file>>>        ")
(princ)
)

suriwaits 发表于 2022-7-6 00:57:33

非常感谢pBe，
 
效果很好。
 
 
 
 

pBe 发表于 2022-7-6 01:05:00

 
很高兴我能帮忙
 
干杯
页: [1]
查看完整版本: Lisp从notep放置多行文字