口齿不清有点小问题！！！
我对下面的lisp代码有点问题。。。当Lisp程序的时候，让我调整一下音阶
Drawing scale factor 1= 1:100, 2 = 1:200, 3 = 1:500
1.当我选择1（比例1:100）时，文字高度为0.35
2.当我选择1（比例1:200）时，文字高度为0.70
3.当我选择1（比例1:100）时，文字高度为1.05
我需要在比例（1:200）的文字高度是0.35，或者我不知道有多容易手动给文字高度，（问我….给文字大小：）
请帮忙。。。
;------------------------------------------------------------------------------
; CAD Concepts Limited
;
; BEARING DISTANCE TEXT
;
; Copyright (C) 2011 CAD Concepts Limited.
; BEARING DISTANCE TEXT by CAD Concepts Ltd is licensed under
; a Creative Commons Attribution-ShareAlike 3.0 Unported License.
; http://creativecommons.org/licenses/by-sa/3.0/nz/deed.en
; For options available to you under this license.
; This software is provided "as is". No liability is taken of
; FITNESS FOR ANY PARTICULAR PURPOSE.
;------------------------------------------------------------------------------
; File : BD.lsp
; Author : Jason Bourhill
; Email : jason@cadconcepts.co.nz
; Web : http://www.cadconcepts.co.nz
; Date : 20/Mar/2011
; CAD Ver(s) : Tested on AutoCAD 2010 & Bricscad V11
; Purpose : Places Bearing & Distance text above and below selected lines
;
; Usage : To load type (load "BD.LSP") from the command line or drag
; and drop the file onto your drawing using explorer. Will
; automatically run on loading.
;
; Select a LINES or LIGHT WEIGHT POLYLINES on your drawing. Text
; placed above the line will give the Bearing. Text placed
; below the line gives the distance.
;
; If you use inside a viewport from paperspace the routine will
; automatically work out the scale factor. If you use in model
; space you will be prompted for a scale factor.
;
; Bearing given is always between 0 - 180 deg irrespective of
; the direction the line has been drawn in.
;
; Text is placed on the current layer using the default text
; style. Text height is based on the text height for the
; current dimension style.
;
; To run the routine again type BD at the command line.
;
; NOTE in AutoCAD bearing gives a D instead of the degree symbol
; in Bricscad you get the degree symbol.
;
; Requires : Nothing else
;------------------------------------------------------------------------------
; Rev no : A
; Reason : First release
; Rev Date : 20/Mar/2011
; Rev by : Jason Bourhill
; Email : jason@cadconcepts.co.nz
;
; Description:
; First release.
;------------------------------------------------------------------------------
(defun C:BD ( / ASK GETDWGSCALETEXTPOSITION LISTPLINEVER PLACETEXT sset num scalefac ent startpt endpt VerLst Ctr lstlen)
;ASK
;This routine allows default prompt issuing
(defun ASK (typ prmpt def / val vt)
(setq vt (type def))
(cond ((null vt) (princ (strcat prmpt ": ")))
((= vt 'STR) (princ (strcat prmpt " <" def ">: ")))
((= typ 'ANG) (princ (strcat prmpt " <" (rtd def) ">: ")))
((= vt 'REAL) (princ (strcat prmpt " <" (rtos def 2 2) ">: ")))
((= vt 'INT) (princ (strcat prmpt " <" (itoa def) ">: ")))
)
(cond ((= typ 'R) (setq val (getreal)))
((= typ 'S) (setq val (getkword)))
((= typ 'ANG) (setq val (getangle)))
((= typ 'DIST) (setq val (getdist)))
((= typ 'INT) (setq val (getint)))
((= typ 'STR) (setq val (getstring)))
((= typ 'STRT)(setq val (getstring T)))
)
(if (or (= val "")(= val ())) def val)
)
; find Drawing scale
; if user is inside a paperspace vport will work out dwgscale automatically
; if in paperspace set dwgscale = 1
; if in modelspace as user for dwgscale value
; Required as Bricscad doesn't support annotative text scaling
(defun getdwgscale ( )
(cond
((and (= 0 (getvar "TILEMODE")) (= 1 (getvar "CVPORT"))) ; in paperspace not inside a vport
(setq dwgscale 1)
)
((and (= 0 (getvar "TILEMODE")) (> (getvar "CVPORT") 1)) ; in paperspace and inside a vport
(setq dwgscale (/ 1.0 (caddr (trans '(0 0 1) 2 3))))
)
((= 1 (getvar "TILEMODE")) ; in modelspace, ask user for dwgscale
(if (not dwgscale) (setq dwgscale 0.5)) ; if not set, set dwgscale to 1:2000 assumes modelspace is in metres, and paperspace is mm
(setq dwgscale (ask 'R "Drawing scale factor 1= 1:100, 2 = 1:200, 3 = 1:500" dwgscale))
)
)
dwgscale ; return dwgscale value
) ; end getdwgscale
; Find and return the Text postion and angle value
; adjusts position and angle based on which quadrant the angle falls in
; Note internally Lisp uses radians, with 0 at East position and measures anticlockwise.
(defun textposition (LineMpt Langle TextOff / TestPos Langle)
(cond
((and (>= Langle 0 )(<= Langle (/ pi 2.0))) ; Langle between 0 - 90 degrees
(setq TextPos (polar LineMpt (+ Langle (/ pi 2.0)) TextOff))
(setq Langle Langle)
)
((and (> Langle (/ pi 2.0))(<= Langle pi)) ; Langle between 90 - 180 degrees
(setq TextPos (polar LineMpt (- Langle (/ pi 2.0)) TextOff))
(setq Langle (- Langle pi))
)
((and (> Langle pi)(<= Langle (* pi 1.5))); Langle between 180 - 270 degrees
(setq TextPos (polar LineMpt (- Langle (/ pi 2.0)) TextOff))
(setq Langle (- Langle pi))
)
((and (> Langle (* pi 1.5))(<= Langle (* pi 2.0))); Langle between 270 - 360 degrees
(setq TextPos (polar LineMpt (+ Langle (/ pi 2.0)) TextOff))
(setq Langle Langle)
)
)
(list Textpos Langle) ; return the text position and angle as a list
) ; end textpostion
; List LWpline Vertices
; Iterates through presented list retaining only Lwpline vertices
; returns the vertices found as a list.
(defun ListPlineVer (ent)
(mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) ent))
) ;end ListPlineVer
(defun PlaceText (startpt endpt dwgscale / Bunits Bprec Dunits Dprec dwgscale txtoff)
; Set BEARING display preferences
; Bunit Options are:
; 0 Degrees, 1 Degrees/minutes/seconds, 2 Grads, 3 Radians, 4 Surveyor's units
(setq Bunits 1) ; Degrees/minutes/seconds
(setq Bprec 4) ; Angle Precision, specifies the number of decimal places
; Set DISTANCE display preferences
; Dunit Options are:
; 1 Scientific, 2 Decimal, 3 Engineering (feet and decimal inches),
; 4 Architectural (feet and fractional inches), 5 Fractional
(setq Dunits 2) ; Decimal
(setq Dprec 2) ; Linear Precision, specifies the number of decimal places
; Set TEXT display options
; Text OFFSET. Distance that the text is offset from the line
(setq txtoff (* 0.25 dwgscale))
;(setq txtoff (* (getvar dimgap) dwgscale)) could use dimgap if it is set to a reasonable value
; Text HEIGHT.
(setq txtheight (* (getvar "DIMTXT") dwgscale)) ; use dimension text height
(setq
ang (angle startpt endpt) ; find angle between two points
dis (distance startpt endpt) ; find distance between two points
midpt (polar startpt ang (/ dis 2.0)) ; find the midpoint between the two ponts
angtxtval (textposition midpt ang txtoff) ; Find Bearing Text Position and Angle
angtxtpos (car angtxtval) ; Bearing text position
angtxt (angtos (cadr angtxtval) 2 Bprec) ; returns angle as a text string
distxtpos (car (textposition midpt ang (* -1.0 (+ txtoff txtheight)))) ; Find Distance Text position below line, taking text height into account
distxt (rtos dis Dunits Dprec) ; returns distance as a text string
)
(entmake (list (cons 0 "TEXT") (cons 10 angtxtpos) (cons 40 txtheight) (cons 1 angtxt) (cons 50 (cadr angtxtval)) (cons 72 1) (cons 11 angtxtpos)))
(entmake (list (cons 0 "TEXT") (cons 10 distxtpos) (cons 40 txtheight) (cons 1 distxt) (cons 50 (cadr angtxtval)) (cons 72 1) (cons 11 distxtpos)))
) ; end PlaceText
; Begin Main Program
;------------------------------------------------------------------------------
(princ "\nSelect LINES or LWPOLYLINES to attach Bearing Distance to") ; Provide prompt
(setq sset (ssget '((-4 . "<or")(0 . "LINE")(0 . "LWPOLYLINE")(-4 . "or>")))) ; select only LINES or Light Weight Polylines
(if sset
(progn
(setq num 0) ; zero counter
; Scale factor. Find drawing scale factor
(setq scalefac (getdwgscale))
(repeat (sslength sset) ; repeat for each object in the selection set
(setq ent (entget(ssname sset num))) ; find entity properties
(cond
((= (cdr (assoc 0 ent)) "LINE")
(setq startpt (cdr (assoc 10 ent))) ; find the start point of the line
(setq endpt (cdr (assoc 11 ent))) ; find the end point of the line
(PlaceText startpt endpt scalefac) ; Place Bearing Distance Text
)
((= (cdr (assoc 0 ent)) "LWPOLYLINE")
(setq VerLst (ListPlineVer ent)) ; find all the vertices for the pline
(setq ctr 0) ; Zero Counter
; Step through each vertice in list and place bearing distance text accordingly
(if (= 1 (boole 1 1 (cdr (assoc 70 ent)))) ; check if the pline is Open or Closed
(repeat (setq lstlen (length VerLst)) ; Assoc 70 = 1 pline Closed
(if (= (1+ ctr) lstlen) ; Check if we are at the last vertice in the list
(setq
startpt (nth ctr verlst)
endpt (nth 0 verlst) ; endpoint = 1st vertice in list
)
(setq
startpt (nth ctr verlst)
endpt (nth (1+ ctr) verlst)
)
)
(PlaceText startpt endpt scalefac) ; Place Bearing Distance Text
(setq ctr (1+ ctr)) ; iterate counter to next vertice in point list
)
(repeat (1- (length VerLst)) ; Assoc 70 = 0 pline Open
(setq
startpt (nth ctr verlst)
endpt (nth (1+ ctr) verlst)
)
(PlaceText startpt endpt scalefac) ; Place Bearing Distance Text
(setq ctr (1+ ctr)) ; iterate counter to next vertice in point list
)
)
)
)
(setq num (1+ num)) ; Iterate counter to next object in selection set
)
)
(princ "\nNo lines selected\n")
)
) ;end main function
;(C:BD) ; run automatically on loading
Why not use TEXTSIZE System Variable, or annotative text style instead? i dont know how can anyone convert this lisp to give manualy the text size ???????????? the easy way is to do this
(setq dwgscale (ask 'R "Drawing scale factor 1= 1:200, 2 = 1:500, 3 = 1:1000" dwgscale))
页:
[1]