多行文字即兴标记
您好，感谢您抽出时间查看我的帖子。感谢大家为像我这样的初学者提供了如此有用的知识体系，供他们学习。
我一直在搜索有关在AutoLISP中使用多行文字的课程
（不可否认，我发现了一些令人惊讶的例子）李-麦克对类似的问题发表了几条回复。很抱歉再次提起，但我有点不知所措。我希望有人会花时间将多行文字解决方案应用到附加的Lisp，我目前确实理解。它使用Text命令。。。我意识到使用命令是业余的，但我仍在学习
; 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)
干杯
再次感谢您抽出时间。
安迪。 好的，我已经找到了一些解决方法。我用了李的测试程序
http://www.cadtutor.net/forum/showthread.php?39325-AutoLISP中的多行文字
(defun c:test (/ ent)
(if (setq ent (car (entsel "\nSelect MTEXT: ")))
(foreach x (entget ent)
(print x)))
(textscr)
(princ))
把适合我需要的一对点着的多行文字扔掉。在使用entmake时，反复试验让我更好地理解了多行文字
我的Lisp程序现在看起来像这样。
; 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。
任何帮助都将不胜感激，如果有更简单的方法来做这一切，请不要犹豫纠正我。
最后，如果代码对任何人都有用，请随时使用。
干杯
安迪。
如果我的回答正确，您希望在模型空间中拾取一个点，检索北距和东距，然后切换到活动布局并放置文本。
我可以提供一种不同的方式来切换模型和布局吗？
(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
我甚至建议使用这些对象来创建多行文字。 谢谢你的回复。
要明确的是。我确实希望在模型空间中拾取一个点并检索北距和东距，但我是通过位于Layout1上的视口来执行此操作的。
很抱歉，根本没有记录。（希望这能帮助其他阅读本文的人）
绘图板上的绘图板位于布局1上
图纸空间（布局1）中存在一个或多个视口，用于查看模型空间。
所有注释都需要在图纸空间中。
所有网格线都存在于模型空间中。
因此，工作流程是：
-键入GLE（东距）或GLN（北距）
-Lisp将切换到视口中的模型空间
-提示选择网格线
-Lisp将切换回视口中的图纸空间
-提示选择标签位置
-使用前缀“E”表示东距，或使用前缀“N”表示北距
-在图纸空间中的拾取点创建多行文字
-类似于“E 1500.000”或“N 2400.000”
-东距文本旋转为垂直
-应用与背景色相同的背景遮罩
感谢您提供有关Visual Lisp扩展的代码。
我目前并不完全理解，但我会深入研究。
如果你有时间（或者其他人想帮忙），我想知道这种格式的多行文字是什么样子的。
干杯
安迪。 也许试试这个？我希望这有助于理解VLA对象。
(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
这将有助于将实体视为对象。
(vl-load-com)
(defun c:dmpobj ()
(vlax-dump-object (vlax-ename->vla-object (car (entsel "\nSelect Object:"))) T)
(command "TextScr")
(princ)
) 几点建议
; 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
谢谢Hippe013和BIGAL
这些代码片段看起来非常有用。
当我在本周晚些时候有更多的时间时，我将尝试使用VLA方法再次解决这个问题。这一次有了offets
干杯，伙计们！
安迪
页:
[1]