[编程交流] 需要帮助快捷方式。

; 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))
)
; ****************************************************************************************************