需要帮助快捷方式。
嗨，CadTutorers的第一个帖子，希望还有更多。我有一条14公里长的控制线，不需要手动编辑每个多行文字。
im使用的（部门）链测长度宏会输出多行文字，如1000.00 1100.000，但是我的项目经理希望在计划中以公里为单位。
它将被标为1.1km和1.2km，以任何快速的方式完成。
提前感谢绿色用户。 那个宏是什么？我的意思是AutoLISP、VBA、ARX或。Net例程？
您熟悉上述宏的编程语言吗？如果答案是肯定的，那么只需定位打印标签的行并调整字符串-需要除法操作和后缀追加。如果没有，要么试着找到开发该工具的人并请求修改，要么调查是否允许您在此处发布例程并让他人查看。
我不熟悉它编码lisp Vba等。因此加入这里学习。我敢肯定，这是一个定制，虽然它的标准为该部门。这是一个。exe，提取到Acad这就是我所知道的这个（CHG）链接宏是存储在定制中的许多宏之一。如果可能的话，我希望在CHG宏后对问题进行排序，或者我可以尝试定位是否存储了代码（我需要一些说明）。我不能张贴。exe，但谷歌主要raods自定义和它的顶部链接即时消息使用2010年地图。谢谢MSasu
; Functions used in MR_Chainage (CHG)
;; Build a list containing all the Vertexes and bulge factors
; Requires a variable entlist for use in the locate1stvert routine as well
; ****************************************************************************************************
(defun BuildVertList ()
(locate1stvert entlist) ; locate the first vertex in the entity data
(setq VertCount 1) ; Initialise the vertex number count
(setq VertList nil) ; Initialise the VertList Variable
(while (<= VertCount VertNum)
(setq checkval (car (nth n entlist)))
(if (= (car (nth n entlist)) 10)
(progn
; Set the point data to a point variable in the form of a list (X, Y, Z)
(setq VertPt (trans (list (cadr (nth n entlist )) (caddr (nth n entlist )) 0.0) 0 1))
; Extract the bulge factor
(setq n (+ n 3))
(setq BulgeFactor (cdr (nth n entlist)))
(setq VertList (append VertList (list VertPt BulgeFactor)))
(setq n (1+ n))
(setq VertCount (1+ VertCount))
) ; end of progn
) ; end of if
(setq n (1+ n))
) ; End While
)
; ****************************************************************************************************
; This function converts Cartesian to Compass and vice versa
; ****************************************************************************************************
(defun cart2comp (angdegs)
(if (< angdegs 90)
(setq angdegs (- 90 angdegs))
(progn
(if (< angdegs 180)
(setq angdegs (+ (- 90 angdegs) 360))
(progn
(if (< angdegs 270)
(setq angdegs (+ (- 90 (- angdegs 180)) 180))
(setq angdegs (+ (- 90 (- angdegs 270)) 90))
)
)
)
)
)
)
; ****************************************************************************************************
; Configures the retrieved DIMSCALE and USERI2 values for display in a message dialogue
; ****************************************************************************************************
(defun ConfigSc4Disp ()
(if (= (rtos basesel 2 0) "") ; Start of If 1
(setq basesel 0)
) ; End of If 1
(if (= basesel 0) ; Start of If 2
(progn ; Then
(setq DispScText (strcat "The Current scale is " DimScVal ". Is this correct?"))
) ; End of If 2 then progn
(progn ; Else
(setq DispScText (strcat "The Current scale is " DimScVal ". Is this correct?"))
) ; End of If 2 Else progn
) ; End of If 2
(setq dcl_id (load_dialog "MR_Dialogues.dcl")) ; Initialise the Dialogue box
(if (not (new_dialog "message_disp_curr_scale" dcl_id)) (exit)) ; Open the dialogue box
(set_tile "msg" DispScText)
(action_tile "Yesbtn" "(done_dialog 1)" ) ; Set and action for the OK Button
(setq msgresp (start_dialog)) ; Execute the dialogue box and retrieve a response when a button is pushed
(unload_dialog dcl_id) ; Remove the dialogue box from memory
) ; End of ConfigSc4Disp
; ****************************************************************************************************
; Create a dumbell block
; ****************************************************************************************************
(defun createdumbell ()
; Create a selection set to capture any existing dumbell blocks
(setq dbellsset (ssget "X" (list (cons 2 "dumbell"))))
(if (= dbellsset nil) ; If there are no dumbell blocks in the drawing
(progn ; then create it
(command "zoom" "w" "-10,-10" "10,10")
(command "line" "-2.5,0" "2.5,0" "")
(command "circle" "-3.5,0" "1")
(command "circle" "3.5,0" "1")
(setq CURRANNOSCALE (getvar "CANNOSCALE"))
(setvar "CANNOSCALE" "1:1000 (m)")
(command "block" "dumbell" "A" "Y" "N" "0,0" "w" "-5,-2" "5,2" "")
(setvar "CANNOSCALE" CURRANNOSCALE)
(command "zoom" "p")
) ; end of block create
) ; End of if
) ; End of defun
; ****************************************************************************************************
; Create a dumbell block
; ****************************************************************************************************
(defun createchgtick ()
; Create a selection set to capture any existing dumbell blocks
(setq chgticksset (ssget "X" (list (cons 2 "chgtick"))))
(if (= chgticksset nil) ; If there are no dumbell blocks in the drawing
(progn ; then create it
(command "zoom" "w" "-10,-10" "10,10")
(command "line" "-2.5,0" "2.5,0" "")
(setq CURRANNOSCALE (getvar "CANNOSCALE"))
(setvar "CANNOSCALE" "1:1000 (m)")
(command "block" "chgtick" "A" "Y" "N" "0,0" "w" "-5,-2" "5,2" "")
(setvar "CANNOSCALE" CURRANNOSCALE)
(command "zoom" "p")
) ; end of block create
) ; End of if
) ; End of defun
; **********************************************************************************************
; Find where a nominated point is on the alignment
; **********************************************************************************************
(defun FindSegmentNumber (CheckPt)
(setq whilecheck 1) ; Initialise the whilecheck variable. This keeps a count on the vertexes.
(setq segnumber nil) ; INitialise the detected segment number variable
(setq n 0 ) ; Initialise the group code counter to 0
(locate1stvert entlist) ; locate the first vertex. function defined above.
(While (< (1- whilecheck) VertNum) ; While there are still vertexes to process
; Set the point data to a point variable in the form of a list (X, Y, Z)
(setq ptStartSeg (trans (list (cadr (nth n entlist )) (caddr (nth n entlist )) 0.0) 0 1))
; Extract the bulge factor
(setq n (+ n 3))
(setq BulgeFactor (cdr (nth n entlist)))
; **************************************************************************************
; Establish whether the element is a curve or a straight
; **************************************************************************************
(if (/= BulgeFactor 0) ; If the Bulgfactor is not equal to 0 then we are on a curve
(progn ; Then we are on a curve
; Extract the next point
(setq n (+ n 2))
(setq ptEndSeg (trans (list (cadr (nth n entlist )) (caddr (nth n entlist )) 0.0) 0 1)) ; Set the point data to a point variable in the form of a list (X, Y, Z)
(GetRadiusBulgeAndPoints BulgeFactor ptStartSeg ptEndSeg) ; Calculate the radius (GetRadiusBulgeAndPoints sets a variable Radius and is defined in system.lsp)
(setq CurveFlag 1)
) ; End of progn
(progn ; Else extract the next point to process a straight
(setq n (+ n 2))
(setq ptEndSeg (trans (list (cadr (nth n entlist )) (caddr (nth n entlist )) 0.0) 0 1)) ; Set the point data to a point variable in the form of a list (X, Y, Z)
(setq CurveFlag 0)
) ; End of progn
) ; End of If
; **************************************************************************************
; Is the Start Point within the element
; **************************************************************************************
; **************************************************************************************
; **************************************************************************************
(If (= CurveFlag 0) ; If the element is a straight
(Progn ; Then
(setq SegLength (distance ptStartSeg ptEndSeg) ; Get the length and angle of the first segment
SegAngle (rtd (angle ptStartSeg ptEndSeg)))
(setq ReqdPtLen (distance ptStartSeg CheckPt) ; Get the distance from the first segment point to the selected point
ReqdPtAng (rtd (angle ptStartSeg CheckPt)))
; If the distance and angle to the required point are zero, then we have coincident points at the start of the segment
; and the current segment is the one required
(if (and (= ReqdPtLen 0) (= ReqdPtAng 0))
(progn
(setq SegNumber whilecheck) ; Set the segment number (the whilecheck value can be used for this)
(setq whilecheck Vertnum) ; Now that the element has been found we need to set the whilecheck to exit the routine
)
(progn
(If (and (<= ReqdPtLen Seglength) (= (rtos SegAngle 2 3) (rtos ReqdPtAng 2 3))) ; If the Segment length is greater and the angle is the same
; to three decimals, then the point must be on the segment
(progn
(setq SegNumber whilecheck) ; Set the segment number (the whilecheck value can be used for this)
(setq whilecheck Vertnum) ; Now that the element has been found we need to set the whilecheck to exit the routine
) ; End of Progn
); End if If
)
)
; This can be used now to determine the vertexes to be extracted. i.e. Segment number 1 goes from Vertex 1 to Vertex 2
; It is safe to say that the Segment number is also the first point number on the segment.
); End of first Progn
; **************************************************************************************
; **************************************************************************************
(Progn ; Else if the element is a curve
(setq InclAngle (rtd (* (atan BulgeFactor) 4))) ; Calculate the included angle (rtd is defined in system.lsp)
; Make the Included Angle positive if it is negative. The bulge factor can be used later to determine the hand of the arc
(if (< InclAngle 0) ; If the angle is negative
(setq InclAngle (* InclAngle -1))
)
(setq triAngles (/ (- 180 InclAngle) 2)) ; Calculate the other equilateral angles
; Find the centre of the arc
(if (< BulgeFactor 0) ; If the Bulge Factor is negative
(progn ; Then the arc is clockwise
(setq ChordAng (rtd (angle ptStartSeg ptEndSeg)))
(setq CentAng (dtr (- ChordAng triAngles)))
(setq CentPt (polar ptStartSeg CentAng Radius))
;(command "line" CentPt ptStartSeg "")
)
(progn ; Else the arc is Anticlockwise
(setq ChordAng (rtd (angle ptStartSeg ptEndSeg)))
(setq CentAng (dtr (+ ChordAng triAngles)))
(setq CentPt (polar ptStartSeg CentAng Radius))
;(command "line" CentPt ptStartSeg "")
)
) ; End of find centre If
; Determine the angle between the centre and the selected point
(setq ptAngle (rtd (angle CentPt CheckPt))) ; Calculate the angle from centrepoint to selected point
(setq SegStAngle (rtd (angle CentPt ptStartSeg))) ; Calculate the angle from centrepoint to segment start point
(setq SelPtAngDiff (- SegStAngle PtAngle)) ; Calculate the angle difference
(setq SelPt2CentDist (distance CentPt CheckPt)) ; Calculate the distance from centrepoint to selected point
(if (and (<= SelPtAngDiff InclAngle) (= (rtos Radius 2 3) (rtos SelPt2CentDist 2 3))) ; If the angle is less than the curve angle and the distance
; equals the radius, then the point must be on the current arc
(progn
(setq SegNumber whilecheck) ; Set the segment number (the whilecheck value can be used for this)
(setq whilecheck Vertnum) ; Now that the element has been found we need to set the whilecheck to exit the routine
) ; End of progn
) ; End of Pt Check If
) ; End of curve Progn
) ; End of If
(setq whilecheck (1+ whilecheck)) ; Increment the whilecheck by 1
); End Of While
)
; ****************************************************************************************************
; Displays a dialogue requesting a scale value
; ****************************************************************************************************
(defun getascale()
; This is the original LISP code now replaced by the VBA routine above in ACAD.DVB
(setq dcl_id (load_dialog "MR_Dialogues.dcl")) ; Load the dialogue file
(if (not (new_dialog "ScaleList" dcl_id)) (exit)) ; Load the dialogue definition from the file
(start_list "scale_val") ; Start the process for adding values to the pop-ip
(setq scalelist (list "" "1" "2" "5" "10" "20" "25" "50" "100" "125" "200" "250" "500" "1000" "1250" "2000" "2500" "5000" "10000" "20000" "25000" "50000" "100000"))
(mapcar 'add_list scalelist) ; process the values in ListOfLayouts into the list
(end_list) ; Close the list creation process
;(setq SelLayout (nth 0 ListOfLayouts)) ; Set the first entry as a default value
(action_tile "one2one" "(setq basesel \"1\")") ; get the response if 1:1 is selected
(action_tile "onethous" "(setq basesel \"0\")") ; get the response if 1:1 is selected
(action_tile "scale_val" "(process_scalepopup)") ; Set a variable based on the value in the box
(action_tile "cancel" "(done_dialog 0)" ) ; Set and action for the cancel button
(action_tile "ok" "(done_dialog 1)" ) ; Set and action for the OK Button
(setq setcmd (start_dialog)) ; Get a response from the dialogue box.vp
(unload_dialog dcl_id) ; Ensure that the dialogue box is unloaded
)
; ****************************************************************************************************
; Retrieves the first vertex from the list generated by BuildVertList
; Used in LAA defined in acaddoc.lsp
; ****************************************************************************************************
(defun getvertex1 (entname)
; Get the entity list using the entity name
(setq entlist (entget entname))
; Get the number of vertices
(setq VertNum (cdr (assoc 90 entlist)))
; Build a more easily used list of the vertices and the bulge factors
(BuildVertList)
; Extract the first and second vertices from the list
(setq vertpt1 (nth 0 vertlist))
)
; ****************************************************************************************************
剩下的代码。（字符太多。）
；**************************************************************************************************************；用于放置蝌蚪符号的可重复代码****************************************************************************************************（defun placetad（TadPt ScalePt）（命令“layer”“T”“MRR\u tadpolis”“）（if（=（getvar“PSTYLEMODE”）0）（命令“layer”“M”“MRR\u tadpolis”“C”“2”“L”“Continuous”“LW”“0.25”“PS”“Black\u 025”“）；创建文本要进入的层（命令“layer”“M”“MRR\u tadpolis”“C”“2”“L”“Continuous”“”“LW”“0.25”“”“）；为要进入的文本创建层）（setq SaveOSMode（getvar“OSMODE”）（setq scaledit（distance TadPt ScalePT））（setvar“ANGBASE”0）（setvar“ANGDIR”0）（setvar“OSMODE”0）（if（=TadStyle“Tadpole”）（progn（if（=（rem half count 2）0）；如果半计数是偶数，则（setq ScaleDist（rtos（/ScaleDist 3）2 3））；将蝌蚪再缩放0.5（setq ScaleDist（rtos（/ScaleDist 1.5）2 3））；否则缩放以适应接口之间。）（命令“insert”“Tadpole”TadPt ScaleDist”“ScalePt））；蝌蚪插入结束（progn；如果这是一只扁虱式蝌蚪（If（=（rem half count 2）0）；如果半计数是偶数，则（progn（命令行“TadPt ScalePt”“）（命令“length”“P”50 ScalePt”“）（progn（命令行“TadPt ScalePt”“）））（setvar“OSMODE”SaveOSMode）（setvar“ANGDIR”currANGDIR）（setvar“ANGBASE”currANGBASE））；**************************************************************************************************************************************************************************************************************************************；用于放置哑铃的可重复代码****************************************************************************************************（defun placedbell（TickPt TextAngle）（if（=（getvar“PSTYLEMODE”）0）（命令“layer”“M”“MR\u chaineage\u TICKS”“C”“7”“L”“Continuous”“PS”“Black\u 025”“）；为文本创建图层（命令“layer”“M”“MR\u CHAINAGE\u TICKS”“C”“7”“L”“Continuous”“”“”）；为要进入的文本创建层）（setq SaveOSMode（getvar“OSMODE”））（setvar“ANGBASE”0）（setvar“ANGDIR”0）（setvar“OSMODE”0）（命令“insert”“dumbell”TickPt 1”“TextAngle）（setvar“OSMODE”SaveOSMode）（setvar“ANGDIR”currANGDIR）（setvar“ANGBASE”currANGBASE））；**************************************************************************************************************************************************************************；用于设置默认命名打印样式的可重复代码****************************************************************************************************（defun c:SetDefaultPStyle（）（vl load COM）（vla put样式表（vla get ActiveLayout（vla get ActiveDocument（vlax get acad object）））“MR_Full Size Colour.stb”）；********************************************************************************************************************************************************************************************************************************；设置默认的DWS文件；******************************************************************************************************************************************************************；；；用法（c:AddDWS（findfile“MyStandards.dws”）；；；迈克尔·帕克特；；；R、 罗伯特·贝尔；；（defun c:SetDefaultDWS（fileN/dictN eDict xrInt）（defun c:SetDefaultDWS（/dictN eDict xrInt）（setq fileN“c:/Apps/MR\u CUST/ACAD/ACAD2010/templates/Main Roads Standard.dws”）；查找主要道路图纸标准文件的位置（setq dictN“AcStStandard”法令（cond（（cdr（assoc-1（dictsearch（namedobjdict）dictN））（（dictadd（namedobjdict）dictN（entmakex’（（0。“DICTIONARY”）（100。“AcDbDictionary”）））（if（setq xrInt（cdrs 3（entget DICTT）））（setq xrInt（1+（应用‘max（mapcar’atoi xrInt）））））（setq xrInt 0））（dictadd DICTT（itoa xrInt）（entmakex（list’（0。“XRECORD”）'（100。“AcDbXrecord”）（cons 1 fileN）））；函数结束（defun cdrs（key lst/pair rtn）（while（setq pair（assoc key lst））（setq rtn（cons（cdr pair）rtn）lst（cdr（member pair lst））））（reverse rtn））；；；；***************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************；；；；确保正确设置了标准层；；；；***************************************************************************************************************************************************；；；（defun c:SetLayerDefaults（）；查找图层标准文本文件的位置。应在C:\Apps\MR\u CUST\ACAD\ACAD2010\lsp\u dotNet\LISP；；；（setq LayStdFile（findfile“MR Standard Layer Definitions.txt”）；打开文件进行读取；；；（setq#LayStdFile（open LayStdFile“r”）；阅读标题行。为了三行，就把它们一行接一行读；；；（setq文件行（读取行#LayStdFile））；；；（setq文件行（读取行#LayStdFile））；；；（setq文件行（读取行#LayStdFile））；现在我们进入了文件主体；；；（while；while我们不在文件的末尾；；（setq FileLine（read line#LayStdFile））；阅读下一行；；结束层默认值；**************************************************************************************************************************************************************；用于定位文本插入和文本角度的可重复代码****************************************************************************************************（defun txtptandagline（AlignPt SegAngle）（setq TextAngle（+SegAngle 90））（setq TextPt（polar AlignPt（dtr TextAngle）Choff））（defun txtptandagarc（AlignPt PtAngle）（if（<凸度因子0）；如果凸出系数为负（setq TextAngle PtAngle）；存储Chaiage文本的角度（setq TextAngle（-PtAngle 180））；存储字符文本的角度）（setq TextPt（polar AlignPt（dtr TextAngle）Choff））；***************************************************************************************************************************************************************************************************************************************；用于定位蝌蚪角度的可重复代码****************************************************************************************************（defun TadAngLine（AlignPt SegAngle）（setq TadAngle（+SegAngle 90）））（defun TadAngArc（AlignPt PtAngle）（if（<凸度因子0）；如果凸出系数为负（setq TadAngle PtAngle）；存储蝌蚪的角度（setq TadAngle（-PtAngle 180））；存储蝌蚪的角度）；*****************************************************************************************************************；根据getascale中的选择重置DIMSCALE和USERI2系统变量****************************************************************************************************（defun ResetScVals（）；根据选择重置DIMSCALE和USERI2变量（如果（=basesel“”）；如果答案为nothing（从If 3开始（setq basesel“0”）；将1:1000的答案设置为0）；if 3结束（if（=basesel“0”）；If 4的开始（progn；Then（setq AnnoScaleText（strcat“1:（rtos selscale 2 0）”（m）”）（setvar“CANNOSCALE”AnnoScaleText）；（setvar“DIMSCALE”（/selscale 1000））；变量从2008年起不再可用（setvar“USERI2”0）；If 4 Then progn结束（progn；Else（setq AnnoScaleText（strcat“1:（rtos selscale 2 0）”（mm）”）（setvar“CANNOSCALE”AnnoScaleText）；（setvar“DIMSCALE”selscale）；变量从2008年起不再可用（setvar“USERI2”1）；If 4 Else程序结束）；If 4结束）；ResetScVals函数结束（defun purgegroups1（一个/计数i个组）（vl load com）；；当前文档的get groups集合（setq groups（vla get groups（vla get activedocument（vlax get acad object）））count（vla get count groups）；#图纸i 0中的组数；循环计数器）（如果有（setq num 1）；清除一个实体和空组（setq num 0）；仅清除空组）（while（<i（vla get count group））；删除时更新vla get count！（如果（ 我已经使用Lisp有一段时间了，但从未想过学习创建Lisp会有好处。现在重新考虑一下，我知道有一个支持我的论坛来满足我的好奇心。 您如何使用上述代码？有3个函数可以打印多行文字标签（角度、半径和通用标签），但这些函数在代码中的任何地方都没有使用。 下拉菜单是定制的一部分。 希望这有帮助 即使看起来是由政府机构发布的，该安装程序（来自post#10）是一个EXE文件，我不打算在我的工作站上安装它。很抱歉。
我相信有更多的文件，你张贴在上面；要找到可能负责打印上述标签的人，请在安装目录中搜索“（placetext）（不带逗号）。如果发现一些，请在这里发布代码。
页:
[1]
2