RBrigido Posted August 23, 2023 Posted August 23, 2023 Hello guys, how's it going? I'm having a problem with a code here, which in my view seems simple, but I'm not succeeding at all. The situation is the following: I want to click on a point of the building, showing me the Y above this point, however, before showing the point, I would like an arrow to be made, indicating the point below as the requested level (and in the future I would like a hatch solid inside the arrow). The code is the following: (defun c:buildingelev () (setq pt (getpoint "\nSelecione o ponto: ")) (setq elev (cadr pt)) (setq pt1 (trans pt 0 1 elev)) ;; Arrow Creation (setq arrow1 (list (- (car pt1) 0.000) (+ (cadr pt1) 0.0))) ; Position for arrow1 (setq arrow2 (list (- (car pt1) 0.075) (+ (cadr pt1) 0.175))) ; Position for arrow2 (setq arrow3 (list (- (car pt1) 0.019) (+ (cadr pt1) 0.150))) ; Position for arrow3 (setq arrow4 (list (- (car pt1) 0.038) (+ (cadr pt1) 0.235))) ; Position for arrow4 (setq arrow5 (list (+ (car pt1) 0.038) (+ (cadr pt1) 0.235))) ; Position for arrow5 (setq arrow6 (list (+ (car pt1) 0.019) (+ (cadr pt1) 0.150))) ; Position for arrow6 (setq arrow7 (list (+ (car pt1) 0.075) (+ (cadr pt1) 0.175))) ; Position for arrow7 (setq arrow8 (list (+ (car pt1) 0.000) (+ (cadr pt1) 0.000))) ; Position for arrow8 (setq arrowPoints (list arrow1 arrow2 arrow3 arrow4 arrow5 arrow6 arrow7 ;arrow8 )) (setq oldLayer (getvar "CLAYER")) (setq layerName "LEVEL_NCW") (setvar "CLAYER" layerName) (princ arrow1) (princ "\n") (princ arrow2) (princ "\n") (princ arrow3) (princ "\n") (princ arrow4) (princ "\n") (princ arrow5) (princ "\n") (princ arrow6) (princ "\n") (princ arrow7) (princ "\n") (princ arrow8) (command "_.pline" arrow1 arrow2 arrow3 arrow4 arrow5 arrow6 arrow7 arrow8 "c") ;(princ) ;; Criação do texto ;(setq textStr (rtos elev 2 2)) ; Converte a elevação para string ;(setq textPtLeft (trans (list (- (car pt) 0.0) (+ (cadr pt) 0.3)) 0 0 elev)) ; Posicionamento do texto à esquerda ;(setvar "CLAYER" layerName) ;(command "_.text" textPtLeft "0.3" "0" textStr) ;(setvar "CLAYER" oldLayer) ;(princ) ) In the situation of creating the arrow, I'm having problems but I can't understand the reason, whenever it arrives at apl3 it bugs, I've tried to do it, only (command "_pline" apl1 apl2 apl3) and it doesn't work "nil", but when I try to (command "_pline" apl2 apl3) or (command "_pline" apl3 apl4), works perfe ctly. I've tried so much with: (command "_pline" arrowPoints "c") How much: (command "_pline" arrow1 arrow2 arrow3 arrow4 arrow5 arrow6 arrow7 "c") I also put a principle validation, just to check if there are indeed coordinates and the software always gives a positive sign, but the pline doesn't work properly That suppose to be the result: Someone give me a light? Quote
exceed Posted August 24, 2023 Posted August 24, 2023 (edited) (defun c:buildingelev ( / *error* pt ex:lwpline_by_list pt elev pt1 clr arrow1 arrow2 arrow3 arrow4 arrow5 arrow6 arrow7 arrow8 arrowPoints oldLayer layerName lay lwp textStr textPtLeft textsize textent) (vl-load-com) (defun *error* (msg) (if (/= msg "Function cancelled") (princ (strcat "\nError: " msg)) ) (setvar "CLAYER" oldLayer) (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) (princ) ) ; make lwpolyline by pointlist ; lst - point list (2d), cls - closed (0 - no, 1 - yes), clr - color (by aci, 256 - by layer, 0 - by block, 1 - red, 2 - yellow ~~ ) ; return - ename (defun ex:lwpline_by_list (lst cls clr) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 62 clr) (cons 90 (length lst)) (cons 70 cls)) (mapcar (function (lambda (p) (cons 10 p))) lst) ) ) ) (vla-startundomark (vla-get-activedocument (vlax-get-acad-object))) (setq oldLayer (getvar "CLAYER")) (setq layerName "LEVEL_NCW") (if (not (tblsearch "LAYER" layerName)) (progn (setq lay (vla-add (vla-get-layers (vla-get-ActiveDocument (vlax-get-acad-object))) layerName)) (vlax-put-property lay 'color clr) ) ) (setvar "CLAYER" layerName) (while (setq pt (getpoint "\nSelecione o ponto: (pick point - continue / space bar or esc - exit)")) (setq elev (cadr pt)) (setq pt1 (trans pt 0 1 elev)) (setq clr 2) ;temp value - yellow ;; Arrow Creation (setq arrow1 (list (- (car pt1) 0.000) (+ (cadr pt1) 0.0))) ; Position for arrow1 (setq arrow2 (list (- (car pt1) 0.075) (+ (cadr pt1) 0.175))) ; Position for arrow2 (setq arrow3 (list (- (car pt1) 0.019) (+ (cadr pt1) 0.150))) ; Position for arrow3 (setq arrow4 (list (- (car pt1) 0.038) (+ (cadr pt1) 0.235))) ; Position for arrow4 (setq arrow5 (list (+ (car pt1) 0.038) (+ (cadr pt1) 0.235))) ; Position for arrow5 (setq arrow6 (list (+ (car pt1) 0.019) (+ (cadr pt1) 0.150))) ; Position for arrow6 (setq arrow7 (list (+ (car pt1) 0.075) (+ (cadr pt1) 0.175))) ; Position for arrow7 (setq arrow8 (list (+ (car pt1) 0.000) (+ (cadr pt1) 0.000))) ; Position for arrow8 (setq arrowPoints (list arrow1 arrow2 arrow3 arrow4 arrow5 arrow6 arrow7 arrow8)) (setq lwp (ex:lwpline_by_list arrowPoints 0 256)) ;; Criação do texto (setq textStr (rtos elev 2 2)) ; Converte a elevação para string (setq textPtLeft (trans (list (- (car pt) 0.0) (+ (cadr pt) 0.3)) 0 0 elev)) ; Posicionamento do texto à esquerda (setq textsize 0.3) ;temp value, or (setq textsize (getvar 'textsize)) (setq textent (entmakex (list (cons 0 "TEXT") (cons 62 256) (cons 10 textPtLeft) (cons 40 textsize) (cons 1 textStr) (cons 50 0) (cons 41 1) (cons 51 0) (cons 71 0) (cons 72 0) (cons 73 0) ) ) ) ) (setvar "CLAYER" oldLayer) (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) (princ) ) i cannot load your image, but if below gif is what you want, try this Edited August 24, 2023 by exceed 3 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.