多行文字即兴标记

andy81 · 发表于 2022-7-5 23:45:49

您好，感谢您抽出时间查看我的帖子。
感谢大家为像我这样的初学者提供了如此有用的知识体系，供他们学习。

我一直在搜索有关在AutoLISP中使用多行文字的课程
（不可否认，我发现了一些令人惊讶的例子）李-麦克对类似的问题发表了几条回复。很抱歉再次提起，但我有点不知所措。我希望有人会花时间将多行文字解决方案应用到附加的Lisp，我目前确实理解。它使用Text命令。。。我意识到使用命令是业余的，但我仍在学习

copy

; Northing & Easting labeling
; Ryan Anderson December 2013
; The Label will use the current Text Style and current Units Settings
; This Lisp borrows ideas from the tutorials I have been working through.
; http://www.afralisp.net/ http://lee-mac.com/ http://www.cadtutor.net/ http://www.cad-notes.com/
(defun c:gln (/ p x y TxtPos)
(command "_.MSPACE")
(while
(setq p (getpoint "Select a Northing Gridline:"))
(command "_.PSPACE")
(setq TxtPos (getpoint "Pick Label Location: "))
(setq y (rtos (cadr p)))
(setq y (strcat "N " y))
(command "_TEXT" TxtPos "0" y "") ; I would prefer to use MText with a backbround mask and an offset
)
(princ)
)
(princ)
(defun c:gle (/ p x y TxtPos)
(command "_.MSPACE")
(while
(setq p (getpoint "
Select an Easting Gridline:"))
(command "_.PSPACE")
(setq TxtPos (getpoint "
Pick Label Location: "))
(setq x (rtos (car p)))
(setq x (strcat "E " x))
(command "_TEXT" TxtPos "90" x "") ; I would prefer to use MText with a backbround mask and an offset
)
(princ)
)
(princ "Use GLN for Northings, and GLE for Eastings") ;Could both Northings and Eastings be done from one command?
(princ)

干杯
再次感谢您抽出时间。
安迪。

andy81 · 发表于 2022-7-5 23:55:04

好的，我已经找到了一些解决方法。我用了李的测试程序
http://www.cadtutor.net/forum/showthread.php?39325-AutoLISP中的多行文字

copy

(defun c:test (/ ent)
 (if (setq ent (car (entsel "\nSelect MTEXT: ")))
   (foreach x (entget ent)
     (print x)))
 (textscr)
 (princ))

把适合我需要的一对点着的多行文字扔掉。在使用entmake时，反复试验让我更好地理解了多行文字
我的Lisp程序现在看起来像这样。

copy

; Northing & Easting labeling with MText
; Ryan Anderson December 2013
; This Lisp borrows ideas from the tutorials I have been working through.
; http://www.afralisp.net/ http://lee-mac.com/ http://www.cadtutor.net/ http://www.cad-notes.com/
(defun c:gln (/ p x y TxtPos)
(command "_.MSPACE")
(while
(setq p (getpoint "Select a Northing Gridline: "))
(command "_.PSPACE")
(setq TxtPos (getpoint "Pick Label Location: "))
(setq y (rtos (cadr p)))
(setq y (strcat "N " y))
(entmake
 (list
 (cons 0 "MTEXT")
 (cons 5 "549c")
 (cons 100 "AcDbEntity")
 (cons 67 1)
 (cons 410 "Layout1")                        ;Model space or layout tab to place MText on
 (cons 8 "TXT-GEN")                        ;Layer
 (cons 100 "AcDbMText")
 (cons 10 TxtPos)                        ;Location of text
 (cons 40 5.0)                                ;Font Height
; (cons 41 50)                                ;length of MText Field, if unspecified it will grow or shrink with the input length
 (cons 46 0.0)
 (cons 71 7)                                ;Text Justification inside MText (1 is top left 7 is bottom left)
 (cons 72 5)
 (cons 1 y)                                        ;Text Writen in MText Field
 (cons 7 "Text-03")                        ;Text Style
 (cons 210 '(0.0 0.0 1.0))
 (cons 11 '(1.0 0.0 0.0))
 (cons 43 5)
 (cons 50 0.0)                                ;Rotation of Text for North Coordinate labels
 (cons 73 1)
 (cons 44 1.0)
 (cons 90 3)                                ;Mask color 3 is "use drawing background color"
 (cons 63 256)                                ;Turns on background Mask
 (cons 45 1.5)                                ;Border offset Factor of Background Mask
 (cons 441 0)                                ;Something to do with background Mask
)
)
(command "_.MSPACE")
)
(princ)
)
(princ)
(defun c:gle (/ p x y TxtPos)
(command "_.MSPACE")
(while
(setq p (getpoint "Select an Easting Gridline: "))
(command "_.PSPACE")
(setq TxtPos (getpoint "Pick Label Location: "))
(setq x (rtos (car p)))
(setq x (strcat "E " x))
(entmake
 (list
 (cons 0 "MTEXT")
 (cons 5 "549c")
 (cons 100 "AcDbEntity")
 (cons 67 1)
 (cons 410 "Layout1")                        ;Model space or layout tab to place MText on
 (cons 8 "TXT-GEN")                        ;Layer
 (cons 100 "AcDbMText")
 (cons 10 TxtPos)                        ;Location of text
 (cons 40 5.0)                                ;Font Height
; (cons 41 50)                                ;length of MText Field, if unspecified it will grow or shrink with the input length
 (cons 46 0.0)
 (cons 71 7)                                ;Text Justification inside MText (1 is top left 7 is bottom left)
 (cons 72 5)
 (cons 1 x)                                        ;Text Writen in MText Field
 (cons 7 "Text-03")                        ;Text Style
 (cons 210 '(0.0 0.0 1.0))
 (cons 11 '(1.0 0.0 0.0))
 (cons 43 5)
 (cons 50 1.5708)                        ;Rotation of Text for East Coordinate labels
 (cons 73 1)
 (cons 44 1.0)
 (cons 90 3)                                ;Mask color 3 is "use drawing background color"
 (cons 63 256)                                ;Turns on background Mask
 (cons 45 1.5)                                ;Border offset Factor of Background Mask
 (cons 441 0)                                ;Something to do with background Mask
)
)
(command "_.MSPACE")
)
(princ)
)
(princ "Use GLN for Northings, and GLE for Eastings") ;Could both Northings and Eastings be done from one command?
(princ)

我还有最后一个问题。我希望有人能帮我。标签的位置存储在变量TxtPos中。我想要的是能够偏移文本，使其不直接位于我选择的网格线上。例如，对于北距，将TxtPos的Y值增加5mm，对于东距，将X值增加5mm。

任何帮助都将不胜感激，如果有更简单的方法来做这一切，请不要犹豫纠正我。
最后，如果代码对任何人都有用，请随时使用。
干杯
安迪。

Hippe013 · 发表于 2022-7-6 00:03:15

如果我的回答正确，您希望在模型空间中拾取一个点，检索北距和东距，然后切换到活动布局并放置文本。

我可以提供一种不同的方式来切换模型和布局吗？

copy

(vl-load-com);Load Visual Lisp Extensions
(setq *acad* (vlax-get-acad-object));Get the ACAD Object
(setq *ad* (vla-get-ActiveDocument *acad*));Get the Active Document
(vlax-put-property *ad* 'ActiveSpace 1);For ModelSpace
(vlax-put-property *ad* 'ActiveSpace 0);For Paperspace
(vlax-release-object *acad*);release object when done using it
(vlax-release-object *ad*);release object when done using it

我甚至建议使用这些对象来创建多行文字。

andy81 · 发表于 2022-7-6 00:18:34

谢谢你的回复。
要明确的是。我确实希望在模型空间中拾取一个点并检索北距和东距，但我是通过位于Layout1上的视口来执行此操作的。

很抱歉，根本没有记录。（希望这能帮助其他阅读本文的人）

绘图板上的绘图板位于布局1上
图纸空间（布局1）中存在一个或多个视口，用于查看模型空间。
所有注释都需要在图纸空间中。
所有网格线都存在于模型空间中。

因此，工作流程是：
-键入GLE（东距）或GLN（北距）
-Lisp将切换到视口中的模型空间
-提示选择网格线
-Lisp将切换回视口中的图纸空间
-提示选择标签位置
-使用前缀“E”表示东距，或使用前缀“N”表示北距
-在图纸空间中的拾取点创建多行文字
-类似于“E 1500.000”或“N 2400.000”
-东距文本旋转为垂直
-应用与背景色相同的背景遮罩

感谢您提供有关Visual Lisp扩展的代码。
我目前并不完全理解，但我会深入研究。
如果你有时间（或者其他人想帮忙），我想知道这种格式的多行文字是什么样子的。

干杯
安迪。

Hippe013 · 发表于 2022-7-6 00:21:34

也许试试这个？我希望这有助于理解VLA对象。

copy


(vl-load-com);Load Visual Lisp Extensions
(defun c:glne ()
 
 (setq *acad* (vlax-get-acad-object));Get the acad object
 (setq *ad* (vlax-get-property *acad* 'ActiveDocument));Get the Active Document
 (setq *PS* (vlax-get-property *ad* 'PaperSpace));Get the Active Paper Space
 (vlax-put-property *ad* 'ActiveSpace 1);Go to Model Space
 (setq pnt (getpoint "\Select Point on Grid: "));Prompt User to Select Point:
 (if pnt
   (progn ;If Point Exists
     (vlax-put-property *ad* 'ActiveSpace 0);Go to Paper Space
     
     (setq x (car pnt));Get the X value of Point
     
     (setq y (cadr pnt));Get the Y Value of Point
     (initget 1 "Northing Easting");Initialize getkword
     (setq ret (getkword "Label Northing or Easting?"));Ask user if they are labeling Northing or Easting
     (cond
((= ret "Northing")(setq str (strcat "N:" (rtos y 2 2)) rot 0))
((= ret "Easting")(setq str (strcat "E:" (rtos x 2 2)) rot (/ pi 2.0))));Format the string accordingly and Set the Roation
     (setq txtpos (getpoint "\nSelect Label Position:"));Prompt User for Label Position
     (if txtpos
(progn ;If Point Exists
  (setq MTEXT-OBJECT (vlax-invoke-method *PS* 'AddMText (vlax-3d-point txtpos) 1 str));Create the MTEXT Object
  (vlax-put-property MTEXT-OBJECT 'Layer "TXT-GEN");Set the layer for the MText
  (vlax-put-property MTEXT-OBJECT 'Height 0.12);Set the Text Height
  (vlax-put-property MTEXT-OBJECT 'BackgroundFill :vlax-true);Set the BackgroundFill to true
  (vlax-put-property MTEXT-OBJECT 'AttachmentPoint acAttachmentPointBottomLeft);Set the Jusstification
  (vlax-put-property MTEXT-OBJECT 'InsertionPoint (vlax-3d-Point txtpos));Reset the InsertionPoint
  (vlax-put-property MTEXT-OBJECT 'Rotation rot);Set the rotation
  
  (vlax-release-object *acad*)
  (vlax-release-object *ad*)
  (vlax-release-object *PS*)
  (vlax-release-object MTEXT-OBJECT)
  ;Not sure if its necessary to release every object or just *acad*
  ;either way... it doesn't hurt to just release it
  
  );end progn
;if Point doesn't exist
);end if
     );end progn
   ;if Point doesn't exist
   );end if
 );end defun

Hippe013 · 发表于 2022-7-6 00:32:23

这将有助于将实体视为对象。

copy

(vl-load-com)
(defun c:dmpobj ()
 (vlax-dump-object (vlax-ename->vla-object (car (entsel "\nSelect Object:"))) T)
 (command "TextScr")
 (princ)
 )

BIGAL · 发表于 2022-7-6 00:38:06

几点建议

copy

; use POLAR to work out a new insert pt for the text
(setq txtpos (polar (polar P 5.0 0.0) -5.0 1.5707963)
(setq y (rtos (cadr p)))
(setq y (rtos (cadr p) 2 0)) ; this is integer
(setq y (rtos (cadr p)1 1)) ; this is 1 decimal place

andy81 · 发表于 2022-7-6 00:51:45

谢谢Hippe013和BIGAL
这些代码片段看起来非常有用。

当我在本周晚些时候有更多的时间时，我将尝试使用VLA方法再次解决这个问题。这一次有了offets
干杯，伙计们！
安迪

[编程交流] 多行文字即兴标记

发表回复

精选推荐