一点问题都没有-为了您的利益，我将包括一个*调整菜单*
哈哈，如果说有什么的话，我自己就是一个拼写纳粹——真不敢相信我在发布之前没有查过 好的，请在顶部找到调整菜单
；；；============姓名。lsp=============；；；；；；函数：；；；将使用工件代码标记曲线，；；；模块、方向、材料和说明；；；；；；平台：；；；无限制，仅在ACAD 2004上测试；；；；；；曲线兼容性：；；；圆弧、圆、椭圆、*多段线、，；；；区域和样条。；；；；；；作者：；；；版权所有（c）04.2009 Lee McDonnell；；；（联系CADTutor.net的李·麦克）；；；；；；版本：；；；1.002.04.09;;;2.003.04.09;;;3.003.04.09;;;;;; ======================================（defun c:namer（/*error*APrec VCol tStyl ptxt detxt cEnt cObj Area m） Ok, Please find adjustment menu at the top
;;; =============Namer.lsp =============;;;;;;FUNCTION:;;;Will label a Curve with Piece Code,;;;Module, Direction, Material, and Description;;;;;;PLATFORMS:;;;No Restrictions, only tested on ACAD 2004;;;;;;CURVE COMPATIBILITY:;;;Arcs, Circles, Ellipses, *Polylines,;;;Regions & Splines.;;;;;;AUTHOR:;;;Copyright (c) 04.2009 Lee McDonnell;;; (contact Lee Mac, CADTutor.net);;;;;;VERSION:;;;1.002.04.09;;;2.003.04.09;;;3.003.04.09;;;;;; ======================================(defun c:namer (/ *error* APrec VCol tStyl ptxt detxt cEnt cObj Area motxt dtxt mtxt tStr tBox tWid tHgt ClsPt btPt tpPt pt1 pt2 pt3 pt4 tAngl tObj) (vl-load-com) ;; ===== Adjustments ===== (setq APrec 2) ; Area Precision, integer >= 0 (setq VCol 3) ; Vector Colour, integer (0-255) (setq tStyl "STANDARD"); TextStyle, if non-existent, Standard. ; ======================== ; === Error Prevention === (or (and (eq 'INT (type APrec)) (>= APrec 0)) (setq APrec 2)) (or (and (eq 'INT (type VCol)) ( You, sir, are awesome!
Works perfectly, and thanks for the adjustment menu.
Is there anyway to control the text size?What I'm seeing right now through my testing, it's dependent upon where you place the text.I'd prefer it to be a single size.How can I adjust that in the code?
Thanks I've had fun making this one tbh
The textsize is retrieved from the "TEXTSIZE" variable, which will be dependent on your text style. But I shall add a manual override for you Try this:
;;; =============Namer.lsp =============;;;;;;FUNCTION:;;;Will label a Curve with Piece Code,;;;Module, Direction, Material, and Description;;;;;;PLATFORMS:;;;No Restrictions, only tested on ACAD 2004;;;;;;CURVE COMPATIBILITY:;;;Arcs, Circles, Ellipses, *Polylines,;;;Regions & Splines.;;;;;;AUTHOR:;;;Copyright (c) 04.2009 Lee McDonnell;;; (contact Lee Mac, CADTutor.net);;;;;;VERSION:;;;1.002.04.09;;;2.003.04.09;;;3.003.04.09;;;;;; ======================================(defun c:namer (/ *error* APrec VCol tStyl tSze ptxt detxt cEnt cObj Area motxt dtxt mtxt tStr tBox tWid tHgt ClsPt btPt tpPt pt1 pt2 pt3 pt4 tAngl tObj) (vl-load-com) ;; ===== Adjustments ===== (setq APrec 2) ; Area Precision, integer >= 0 (setq VCol 3) ; Vector Colour, integer (0-255) (setq tStyl "STANDARD"); TextStyle, if non-existent, Standard. (setq tSze 2.5); TextSize, real > 0, if nil, will be Textstyle dependent. ; ======================== ; === Error Prevention === (or (and (eq 'INT (type APrec)) (>= APrec 0)) (setq APrec 2)) (or (and (eq 'INT (type VCol)) ( tSze 0)) (setq tSze (getvar "TEXTSIZE"))) (defun *error* (msg) (redraw) (if tObj (entdel tObj)) (if ovar (mapcar 'setvar vlst ovar)) (if (not (member msg '("Function cancelled" "quit / exit abort"))) (princ (strcat "\nError: " (strcase msg)))) (princ)) ; ======================== (setq vlst '("CLAYER" "OSMODE" "CMDECHO") ovar (mapcar 'getvar vlst)) (mapcar 'setvar (cdr vlst) '(0 0)) (if (not (tblsearch "LAYER" "NAME")) (command "_-layer" "_M" "NAME" "_C" "2" "NAME" "")) (or mo:def (setq mo:def "BK")) (or d:def (setq d:def "R")) (or m:def (setq m:def "L")) (setq ptxt "" detxt "") (if (and (setq cEnt (car (entsel "\nSelect Curve to Label: "))) (member (cdr (assoc 0 (entget cEnt))) '("ARC" "CIRCLE" "ELLIPSE" "LWPOLYLINE" "POLYLINE" "REGION" "SPLINE"))) (progn (setq cObj (vlax-ename->vla-object cEnt) Area (rtos (/ (vla-get-area cObj) 144.0) 2 APrec)) (while (= ptxt "") (setq ptxt (getstring "\nInput Piece Code: "))) (setq ptxt (substr ptxt 1 3)) (while (not (member motxt '("BK" "DK" "SC" "BC" "AR" "AC"))) (setq motxt (strcase (getstring (strcat "\nInput Module : ")))) (or (and (eq motxt "") (setq motxt mo:def)) (setq mo:def motxt))) (while (not (member dtxt '("R" "L" "S"))) (setq dtxt (strcase (getstring (strcat "\nInput Direction : ")))) (or (and (eq dtxt "") (setq dtxt d:def)) (setq d:def dtxt))) (while (not (member mtxt '("L" "S" "P" "D" "Q" "E"))) (setq mtxt (strcase (getstring (strcat "\nInput Material : ")))) (or (and (eq mtxt "") (setq mtxt m:def)) (setq m:def mtxt))) (while (= detxt "") (setq detxt (getstring t "\nInput Description: "))) (setq detxt (substr detxt 1 20) tStr (strcat ptxt (chr 32) motxt (chr 32) dtxt (chr 32) mtxt (chr 32) Area (chr 32) detxt) tBox (textbox (list (cons 1 tStr))) tWid (- (caadr tBox) (caar tBox)) tHgt (- (cadadr tBox) (cadar tBox))) (prompt "\nPlace Text... ") (while (= 5 (car (setq grdat (grread t 1)))) (redraw) (if (= 'list (type (setq sPt (cadr grdat)))) (progn (setq ClsPt (vlax-curve-getClosestPointto cObj sPt) cAngl (angle ClsPt sPt) btPt (polar ClsPt cAngl (/ (getvar "TEXTSIZE") 2.0)) tpPt (polar ClsPt cAngl (+ (/ (getvar "TEXTSIZE") 2.0) tHgt)) midPt (polar btPt cAngl (/ (distance btPt tpPt) 2.0)) pt1 (polar btPt (+ cAngl (/ pi 2)) (/ tWid 2.0)) pt2 (polar btPt (- cAngl (/ pi 2)) (/ tWid 2.0)) pt3 (polar tpPt (+ cAngl (/ pi 2)) (/ tWid 2.0)) pt4 (polar tpPt (- cAngl (/ pi 2)) (/ tWid 2.0))) (grvecs (list VCol pt1 pt2 VCol pt2 pt4 VCol pt1 pt3 VCol pt3 pt4))))) (setq tAngl (- cAngl (/ pi 2))) (if (and (> tAngl 0) (</p> Perfect Lee!
I really appreciate all your hard work!
This will save us a ton of time, and I definitely couldn't have done it on my own! Actually, this is better (more options)
;;; =============Namer.lsp =============;;;;;;FUNCTION:;;;Will label a Curve with Piece Code,;;;Module, Direction, Material, and Description;;;;;;PLATFORMS:;;;No Restrictions, only tested on ACAD 2004;;;;;;CURVE COMPATIBILITY:;;;Arcs, Circles, Ellipses, *Polylines,;;;Regions & Splines.;;;;;;AUTHOR:;;;Copyright (c) 04.2009 Lee McDonnell;;; (contact Lee Mac, CADTutor.net);;;;;;VERSION:;;;1.002.04.09;;;2.003.04.09;;;3.003.04.09;;;;;; ======================================(defun c:namer (/ *error* APrec VCol tStyl tSze tLay tCol ptxt detxt cEnt cObj Area motxt dtxt mtxt tStr tBox tWid tHgt ClsPt btPt tpPt pt1 pt2 pt3 pt4 tAngl tObj) (vl-load-com) ;; ===== Adjustments ===== (setq APrec 2) ; Area Precision, integer >= 0 (setq VCol 3) ; Vector Colour, integer (0-255) (setq tStyl "STANDARD"); TextStyle, if non-existent, Standard. (setq tSze 2.5); TextSize, real > 0, if nil, will be Textstyle dependent. (setq tLay "NAME"); Layer for Text, layer will be created if non-existent (setq tCol 255); Text Colour, (255 = ByLayer) ; ======================== ; === Error Prevention === (or (and (eq 'INT (type APrec)) (>= APrec 0)) (setq APrec 2)) (or (and (eq 'INT (type VCol)) ( tSze 0)) (setq tSze (getvar "TEXTSIZE"))) (or tLay (setq tLay "NAME")) (or (and (eq 'INT (type tCol)) (</p> Wow!That's awesome Lee!
I can't thank you enough man!This is pure greatness!
页:
1
[2]