高度当前由TEXTSIZE系统变量控制-也许DIMTXT系统变量更好？
*咳嗽*在我的网站上捐赠按钮*咳嗽* 好的，你说得对，这很有效。我们可以跳过一个点后的2个零，然后它就完美了（很抱歉，在最后一个点中，我确实更改了它）。如果我有要求，你能为cad做一些其他定制Lsp吗？给我写封私人信件 I apologize for my bad English, I wrote this lisp
I hope it will be useful.
SimbQuota9-EN.lsp Thank you for your help. Unfortunately it makes only one measuring and then you need to replay command (or I'm doing something wrong). I need to make couple measuring's on one drawing just like LSP from Lee Mac does.
But one more time MANY THANKS !!! Hi Barteek,
Give the following a try:
(defun c:em ( / *error* nm p1 p2 p3 p4 ts tx xa ) ;; Elevation Marker ;; © Lee Mac 2011-www.lee-mac.com (defun *error* ( msg ) (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")) (princ (strcat "\n** Error: " msg " **")) ) (princ) ) (setq ts (getvar 'TEXTSIZE) nm (trans '(0.0 0.0 1.0) 1 0 t) xa (angle '(0.0 0.0 0.0) (trans (getvar 'UCSXDIR) 0 nm t)) ) (terpri) (while (setq p1 (getpoint "\rPick Elevation Line Point: ")) (setq tx (rtos (cadr p1)) p2 (polar p1 (/ pi 2.) (* ts (/ (sqrt 3.0) 2.0))) p3 (polar p2 pi (* ts (strlen tx))) p4 (polar (polar p2 pi (* ts 0.5 (strlen tx))) (/ pi 2.) ts) ) (foreach sym '(p1 p2 p3 p4) (set sym (trans (eval sym) 1 nm))) (entmakex (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 3) (cons 70 0) (cons 38 (caddr p1)) (cons 10 p1) (cons 40 0.0) (cons 41 ts) (cons 10 p2) (cons 40 (* ts 0.05)) (cons 41 (* ts 0.05)) (cons 10 p3) (cons 210 nm) ) ) (entmakex (list (cons 0 "TEXT") (cons 7 (getvar 'TEXTSTYLE)) (cons 1tx) (cons 50 xa) (cons 40 ts) (cons 10 p4) (cons 72 1) (cons 73 2) (cons 11 p4) (cons 210 nm) ) ) ) (princ)) Dear Sir,
program by mr. lee mac
its very use full
http://www.cadtutor.net/forum/showthread.php?31363-floor-amp-height-lsp
; Multiple Floor Height by Lee McDonnell 14th January 2009; Places Height and Floor Text above Midpoint on Floor Level Line.; ; (defun c:fht (/ varlist oldvars cCurve cVlist cAng cMpt cStpt cEnpt dCurve fStr dVlist dStpt dEnpt dAng) (vl-load-com) (setq varlist (list "CMDECHO" "CLAYER") oldvars (mapcar 'getvar varlist)) (setvar "CMDECHO" 0)(if (and (setq cCurve (car (entsel "\nSelect Ground Floor > "))) (member (cdr (assoc 0 (entget cCurve))) '("LINE" "LWPOLYLINE"))) (progn (if (not (tblsearch "LAYER" "TEXT")) (vl-cmdf "-layer" "M" "TEXT" "C" "2" "TEXT" "")) (cond ((= "LWPOLYLINE" (cdr (assoc 0 (entget cCurve)))) (setq cVlist (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget cCurve))) cAng (angle (nth 0 cVlist)(nth 1 cVlist)) cMpt (polar (nth 0 cVlist) cAng (/ (distance (nth 0 cVlist)(nth 1 cVlist)) 2))) (if (>= cAng pi) (setq cAng (- cAng pi))) (Make_Text (polar cMpt (+ cAng (/ pi 2)) 2.0) "%%P0.00 Mt.Gr. Level" cAng)) ((= "LINE" (cdr (assoc 0 (entget cCurve)))) (setq cStpt (cdr (assoc 10 (entget cCurve))) cEnpt (cdr (assoc 11 (entget cCurve))) cAng (angle cStpt cEnpt) cMpt (polar cStpt cAng (/ (distance cStpt cEnpt) 2))) (if (> cAng pi) (setq cAng (- cAng pi))) (if (= cAng pi) (setq cAng 0.0)) (Make_Text (polar cMpt (+ cAng (/ pi 2)) 2.0) "%%P0.00 Mt. Gr. Level" cAng))) (while (and (setq dCurve (car (entsel "\nSelect a Floor > "))) (member (cdr (assoc 0 (entget dCurve))) '("LINE" "LWPOLYLINE")) (/= (setq fStr (getstring t "\nSpecify Name of Floor > ")) "")) (cond ((= "LWPOLYLINE" (cdr (assoc 0 (entget dCurve)))) (setq dVlist (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget dCurve))) dAng (angle (nth 0 dVlist)(nth 1 dVlist)) cdDist (distance (vlax-curve-getClosestPointto dCurve cMpt T) cMpt)) (cond ((> (/ (* 3 pi) 2) dAng (/ pi 2)) (setq dAng (- dAng pi))) ((= dAng pi) (setq dAng 0.0))) (Make_Text (polar cMpt (+ dAng (/ pi 2)) (+ cdDist 2)) (strcat "+" (rtos cdDist 2 2) " Mt. " fStr) dAng)) ((= "LINE" (cdr (assoc 0 (entget dCurve)))) (setq dStpt (cdr (assoc 10 (entget dCurve))) dEnpt (cdr (assoc 11 (entget dCurve))) dAng (angle dStpt dEnpt) cdDist (distance (vlax-curve-getClosestPointto dCurve cMpt T) cMpt)) (cond ((> (/ (* 3 pi) 2) dAng (/ pi 2)) (setq dAng (- dAng pi))) ((= dAng pi) (setq dAng 0.0))) (Make_Text (polar cMpt (+ dAng (/ pi 2)) (+ cdDist 2)) (strcat "+" (rtos cdDist 2 2) " Mt. " fStr) dAng))))) (princ "\n No Floor Selected")) (mapcar 'setvar varlist oldvars) (princ))(defun Make_Text (txt_pt txt_val txt_ang) (entmake (list '(0 . "TEXT") '(8 . "TEXT") (cons 10 txt_pt) (cons 40 (max 2.5 (getvar "TEXTSIZE"))) (cons 1 txt_val) (cons 50 txt_ang) '(7 . "STANDARD") '(71 . 0) '(72 . 1) '(73 . 2) (cons 11 txt_pt)))) This one is looking fantastic only thing is can you put in a scale option like you had it before because they are very small. Let me know how can I repayYou are doing fantastic job.
The height is currently controlled by the TEXTSIZE System Variable - perhaps the DIMTXT System Variable may be better?
*cough* donate buttons on my site *cough* Ok you are right that works. Just small change can we skip those 2 zeros after a dot and then its perfect(sorry for that in last one i did change it). Can you do some other custom Lsp's for cad If I will have a request ? just wright me on my private mail
页:
1
[2]