Jump to content

Problem with _pline


RBrigido

Recommended Posts

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:

Screenshot2023-08-23103501.png.af323e3673010a60ab4c018a592c02f6.png

 

 

Someone give me a light?

Link to comment
Share on other sites

 

(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

 

spacer.png

Edited by exceed
  • Like 3
Link to comment
Share on other sites

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...