feargt Posted February 15, 2009 Posted February 15, 2009 Hi, I have got some code that I was trying to modify. the code will label a LWpolyline with the global width. (vl-load-com) (defun c:Label_Width ( / js htx AcDoc Space nw_style obj dxf_ent ename t_mod key pr t_char js_text pt deriv rtx nw_obj n) (princ "\nSelect a polyline.") (while (null (setq js (ssget "_+.:E:S" (list '(0 . "*POLYLINE") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) ) ) ) ) (princ "\nIsn't an available object for this fonction!") ) (setq obj (ssname js 0) dxf_ent (entget obj) ename (vlax-ename->vla-object obj) t_mod '+ key "Yes" ) (cond ((assoc 43 dxf_ent) (initget 6) (setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpecify text height <" (rtos (getvar "TEXTSIZE")) ">: "))) (if htx (setvar "TEXTSIZE" htx)) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (cond ((null (tblsearch "LAYER" "Label")) (vlax-put (vla-add (vla-get-layers AcDoc) "Label") 'color 96) ) ) (cond ((null (tblsearch "STYLE" "Romand-Label")) (setq nw_style (vla-add (vla-get-textstyles AcDoc) "Romand-Label")) (mapcar '(lambda (pr val) (vlax-put nw_style pr val) ) (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag) (list "romand.shx" 0.0 (/ (* 15.0 pi) 180) 1.0 0.0) ) ) ) (repeat 2 (setq pr -0.5 t_char 64 js_text (ssadd)) (if (eq key "Yes") (repeat (fix (vlax-curve-getEndParam ename)) (setq pt (vlax-curve-GetpointAtParam ename (setq pr (1+ pr))) deriv (vlax-curve-getFirstDeriv ename pr) rtx (- (atan (cadr deriv) (car deriv)) (angle '(0 0 0) (getvar "UCSXDIR"))) ) (setq nw_obj (vla-addMtext Space (vlax-3d-point (setq pt (polar pt ((eval t_mod) rtx (* pi 0.5)) (getvar "TEXTSIZE")))) 0.0 (strcat "%<\\AcObjProp.16.2 Object(%<\\_ObjId " (itoa (vla-get-ObjectID (vlax-ename->vla-object obj))) ">%).ConstantWidth \\f \"%lu2\">%" ) ) ) (if (or (> rtx (* pi 0.5)) (< rtx (- (* pi 0.5)))) (setq rtx (+ rtx pi))) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation) (list 5 (getvar "TEXTSIZE") 5 pt "Romand-Label" "Label" rtx) ) (ssadd (entlast) js_text) ) ) (if (not (eq t_mod '-)) (progn (initget "Yes No") (if (eq (setq key (getkword "\nPut labels on other side [Yes/No]? <No>: ")) "Yes") (progn (setq n -1 t_mod '-) (repeat (sslength js_text) (entdel (ssname js_text (setq n (1+ n)))))) (setq t_mod '-) ) ) ) ) ) (T (princ "\nThis polyine does not have a constant width!")) ) (prin1) ) 1.I need to change the code so that it just uses the current textstyle or even asks the user which text style it should use. It should not ask for the height and should not create a style. 2.I also want to put this text on the same layer as the lwpolyline. 3.The code uses a textfield for the text. I need to modify this text field so that it takes the global width and multiplies it by a 1000 and puts a prefix before the new value. ie. a pline with global width of 0.5 will have a text label of DN 500. I have spent some time trying to achieve the above without success. I thought number 3 would be the easiest to change by just editing the code for the text field but unfortunately it's not or else I did something wrong. Any help at all would be much appreciated. ie where I need to modify code, how to modify it and why it needs to be modified so that I can learn from it for other code. I'm sure this code may be useful to others too. Unfortunately I just do not have time at the mo to spend time on this as I am up the walls in work at the mo. Thanks Quote
ASMI Posted February 17, 2009 Posted February 17, 2009 To break not to build... (vl-load-com) (defun c:Label_Width ( / js htx AcDoc cLay Space nw_style obj dxf_ent ename t_mod key pr t_char js_text pt deriv rtx nw_obj n) (princ "\nSelect a polyline.") (while (null (setq js (ssget "_+.:E:S" (list '(0 . "*POLYLINE") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) ) ) ) ) (princ "\nIsn't an available object for this fonction!") ) (setq obj (ssname js 0) dxf_ent (entget obj) ename (vlax-ename->vla-object obj) cLay(vla-get-Layer ename) t_mod '+ key "Yes" ) (cond ((assoc 43 dxf_ent) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (repeat 2 (setq pr -0.5 t_char 64 js_text (ssadd)) (if (eq key "Yes") (repeat(fix (vlax-curve-getEndParam ename)) (setq pt (vlax-curve-GetpointAtParam ename (setq pr (1+ pr))) deriv (vlax-curve-getFirstDeriv ename pr) rtx (- (atan (cadr deriv) (car deriv)) (angle '(0 0 0) (getvar "UCSXDIR"))) ) (setq nw_obj (vla-addMtext Space (vlax-3d-point (setq pt (polar pt ((eval t_mod) rtx (* pi 0.5)) (getvar "TEXTSIZE")))) 0.0 (strcat "DN" "%<\\AcExpr (%<\\AcObjProp.16.2 Object(%<\\_ObjId " (itoa (vla-get-ObjectID (vlax-ename->vla-object obj))) ">%).ConstantWidth >% * 1000) \\f \"%lu2%pr0\">%" ) ) ) (if (or (> rtx (* pi 0.5)) (< rtx (- (* pi 0.5)))) (setq rtx (+ rtx pi))) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation) (list 5 (getvar "TEXTSIZE") 5 pt (getvar "TEXTSTYLE") cLay rtx) ) (ssadd (entlast) js_text) ) ) (if (not (eq t_mod '-)) (progn (initget "Yes No") (if (eq (setq key (getkword "\nPut labels on other side [Yes/No]? <No>: ")) "Yes") (progn (setq n -1 t_mod '-) (repeat (sslength js_text) (entdel (ssname js_text (setq n (1+ n)))))) (setq t_mod '-) ) ) ) ) ) (T (princ "\nThis polyine does not have a constant width!")) ) (prin1) ) Quote
feargt Posted March 11, 2009 Author Posted March 11, 2009 Again sorry for the delay in responding. Please do not think I am not appreciative of your help and assistance. I am, very. This does the job just fine for me. Thanks again Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.