PLINE FOR BLOCK

rolisonfelipe · ‎07-30-2022

HELLO EVERYONE, IT IS POSSIBLE TO LISP, SELECT THE BLOCKS AND EVALUATE WHICH IS THE LOWEST NUMBER, THEN CREATE A PLINE GOING THROUGH ALL AND THEN FINALIZING IN THE INITIAL BLOCK.

WITH THE OPTION TO INSERT A TABLE.

IF IT IS "YES", CREATE A TABLE QUOTING THE DISTANCE BETWEEN 2 POTS AND THEIR AZIMUTH.

SINCE I THANK YOU ALL FOR YOUR ATTENTION, AND A GREAT STUDY.

rolisonfelipe · ‎07-30-2022

IT'S A EXAMPLE, BUT SHE DOESN'T READ THE BLOCKS, AND YOU NEED A POLYLINE

;; ================================================== ================== ;;
;; ;;
;; TABCORD.LSP - Fills the table in co-ordinates of LwPolyline ;;
;; vertexes, and also the centres and radiuses ;;
;; of arc segments. Marks vertexes of LwPolyline ;;
;; accordingly data in the table by digits or ;;
;; letters. Look section 'ADJUSTMENT' for ;;
;; acquaintance with options. ;;
;; ;;
;; ================================================== ================== ;;
;; ;;
;; Command(s) to call: TABCORD ;;
;; ;;
;; Select LwPolyline and after the table will be generated ;;
;; insert it into the necessary place. After that vertexes of ;;
;; polylines will be marked by figures or letters. ;;
;; ;;
;; ================================================== ================== ;;
;; ;;
;; THIS PROGRAM AND PARTS OF IT MAY REPRODUCED BY ANY METHOD ON ANY ;;
;; MEDIUM FOR ANY REASON. YOU CAN USE OR MODIFY THIS PROGRAM OR ;;
;; PARTS OF IT ABSOLUTELY FREE. ;;
;; ;;
;; THIS PROGRAM PROVIDES 'AS IS' WITH ALL FAULTS AND SPECIFICALLY ;;
;; DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY OR FITNESS ;;
;; FOR A PARTICULAR USE. ;;
;; ;;
;; ================================================== ================== ;;
;; ;;
;; V1.3, 14th Aug 2008, Riga, Latvia ;;
;; © Aleksandr Smirnov (ASMI) ;;
;; For AutoCAD 2005 - 2008 (isn't tested in a next versions) ;;
;; ;;
;; ;;
;; ;;
;; ================================================== ================== ;;

(defun c:tabcord(/ aCen cAng cCen cPl cRad cReg
fDr it lCnt lLst mSp pCen pT1
pT2 ptLst R tHt tLst vlaPl vlaTab
vLst cTxt oldCol nPl clFlg actDoc
tPt1 tPt2 cAng tiPt oSnp *error*
mType mHt oZin cAcu dHead hStr
hHt w1 w2 w3 isPer isAre pMul aMul
lWrt aVal xVal yVal)

;;; ************************************************** **************
;;; *************************** ADJUSTMENT *************************
;;; ************************************************** **************

(setq mType nil) ; Markups mode. T - digits, NIL - letters

(setq tHt -1.0) ; Table text size. Positive - absolute,
; negative multiplayer to TEXTSIZE variable

(setq mHt -2.0) ; Markups text size. Positive - absolute,
; negative - multiplayer to TEXTSIZE variable

(setq cAcu 4) ; Precision of coordinates (from 0 to

(setq dHead nil) ; If T delete table header, if NIL not delete

(setq hStr "TABELA DE COORDENADAS") ; Standard header (if dHead not equal T)

(setq hHt -1.25) ; Header text size. Positive - absolute,
; negative - multiplayer to TEXTSIZE variable

(setq w1 -10.0) ; 'Point' column width. Positive - absolute,
; negative - multiplayer to TEXTSIZE variable

(setq w2 -20.0) ; 'X' and 'Y' colums width. Positive - absolute,
; negative - multiplayer to TEXTSIZE variable

(setq w3 -12.0) ; 'Radius' column width. Positive - absolute,
; negative - multiplayer to TEXTSIZE variable

(setq isPer T) ; if T adds perimeter row

(setq isAre T) ; if T adds area row

(setq isGCen T) ; if T adds center of gravity row

(setq pMul 0.001) ; perimeter multiplayer

(setq aMul 0.000001) ; area multiplayer

;;; ************************************************** **************
;;; ************************* END ADJUSTMENT ***********************
;;; ************************************************** **************

(if(minusp tHt)
(setq tHt(getvar "TEXTSIZE"))
); end if

(if(minusp mHt)
(setq mHt(*(abs mHt)(getvar "TEXTSIZE")))
); end if

(if(minusp hHt)
(setq hHt(*(abs hHt)(getvar "TEXTSIZE")))
); end if

(if(minusp w1)
(setq w1(*(abs w1)(getvar "TEXTSIZE")))
); end if

(if(minusp w2)
(setq w2(*(abs w2)(getvar "TEXTSIZE")))
); end if

(if(minusp w3)
(setq w3(*(abs w3)(getvar "TEXTSIZE")))
); end if

(vl-load-com)

(defun Get_Acad_Ver(Gen_Only)
(if Gen_Only
(substr(getvar "ACADVER") 1 2)
(substr(getvar "ACADVER") 1 4)
); end if
); and of Get_Acad_Ver

(defun Extract_DXF_Values(Ent Code)
(mapcar 'cdr
(vl-remove-if-not
'(lambda(a)(=(car a)Code))
(entget Ent)))
); end of

(defun *error*(msg)
(setvar "CMDECHO" 1)
(if oSnp(setvar "OSMODE" oSnp))
(if oZin(setvar "DIMZIN" oZin))
(if mSp(vla-EndUndoMark actDoc))
(princ)
); end of *error*

(defun Alph_Num(Counter / lLst cRes)
(setq lLst '("P1" "P2" "P3" "P4" "P5" "P6" "P7" "P8" "P9" "P10"
"P11" "P12" "P13" "P14" "P15" "P16" "P17" "P18" "P19" "P20"
"P21" "P22" "P23" "P24" "P25" "P26" "P27" "P28" "P29" "P30"))
(if(<= 1.0(setq cRes(/ Counter 26.0)))
(strcat(itoa(fix cRes))
(nth(- Counter(* 26(fix cRes)))lLst))
(nth Counter lLst)
); end if
); end of Alph_Num

(if(<= 16.1(atof(Get_Acad_Ver nil)))
(progn
(if
(and
(setq cPl(entsel "\nSelecione a Polilinha > "))
(= "LWPOLYLINE"(car(Extract_DXF_Values(car cPl)0)))
); end and
(progn
(princ "\nPor Favor Espere!!... \n")
(setq vlaPl(vlax-ename->vla-object(car cPl))
ptLst(mapcar 'append
(setq vLst(Extract_DXF_Values(car cPl)10))
(mapcar 'list(Extract_DXF_Values(car cPl)42)))
r 2 lCnt 0
tLst '((1 0 "PONTO")(1 1 "X(E)")(1 2 "Y(N)")(1 3 "RAIO"))
actDoc(vla-get-ActiveDocument
(vlax-get-acad-object))
mSp(vla-get-ModelSpace actDoc)
); end setq
(setvar "CMDECHO" 0)
(setq oSnp(getvar "OSMODE"))
(setq oZin(getvar "DIMZIN"))
(setvar "DIMZIN" 0)
(vla-StartUndoMark actDoc)
(foreach vert ptLst
(setq vert(trans vert 0 1)
tLst(append tLst
(list(list r 0(if mType
(itoa(1+ lCnt))
(Alph_Num lCnt)))
(list r 1(rtos(car vert)2 cAcu))
(list r 2(rtos(cadr vert)2 cAcu))
(list r 3 ""))))
(if(and
(/= 0.0(last vert))
(setq pt1(vlax-curve-GetPointAtParam vlaPl lCnt))
(setq pt2(vlax-curve-GetPointAtParam vlaPl(1+ lCnt)))
); end and
(setq r(1+ r)
cRad(abs(/(distance pt1 pt2)
2(sin(/(* 4(atan(abs(last vert))))2))))
aCen(vlax-curve-GetPointAtParam vlaPl(+ 0.5 lCnt))
fDr(vlax-curve-getFirstDeriv vlaPl
(vlax-curve-getParamAtPoint vlaPl aCen))
pCen(trans
(polar aCen(-(if(minusp(last vert)) pi(* 2 pi))
(atan(/(car fDr)(cadr fDr))))cRad)0 1)
tLst(append tLst(list
(list r 0 "center")
(list r 1(rtos(car pCen)2 cAcu))
(list r 2(rtos(cadr pCen)2 cAcu))
(list r 3(rtos cRad 2 cAcu))))
); end setq
); end if
(setq r(1+ r) lCnt(1+ lCnt))
); end foreach
(setq vlaTab(vla-AddTable mSp (vlax-3D-point '(0 0 0))
(+ 1(/(length tLst)4)) 4 (* 3 tHt)w2))
(foreach i tLst
(vl-catch-all-apply 'vla-SetText(cons vlaTab i))
(vla-SetCellTextHeight vlaTab(car i)(cadr i)tHt)
(vla-SetCellAlignment vlaTab(car i)(cadr i)acMiddleCenter)
); end foreach
(if(or isPer isAre)
(progn
(vla-InsertRows vlaTab r(* 0.05 tHt)1)
(vla-SetCellTextHeight vlaTab r 0(* 0.05 tHt))
(setq r(1+ r))
); end progn
); end if
(if isPer
(progn
(if(= :vlax-true(vla-get-Closed vlaPl))
(setq lWrt "PERÍMETRO")
(setq lWrt "COMPRIMENTO")
); end if
(vla-InsertRows vlaTab r tHt 1)
(vla-SetText vlaTab r 0 lWrt)
(vla-SetText vlaTab r 1
(rtos(*(vla-get-Length vlaPl)pMul)2 cAcu))
(vla-SetCellTextHeight vlaTab r 0 tHt)
(vla-SetCellTextHeight vlaTab r 1 tHt)
(setq r(1+ r))
); end progn
); end if
(if isAre
(progn
(if(= :vlax-true(vla-get-Closed vlaPl))
(setq aVal (rtos(*(vla-get-Area vlaPl)aMul)2 cAcu))
(setq aVal "Not closed contour")
); end if
(vla-InsertRows vlaTab r tHt 1)
(vla-SetText vlaTab r 0 "ÁREA")
(vla-SetText vlaTab r 1 aVal)
(vla-SetCellTextHeight vlaTab r 0 tHt)
(vla-SetCellTextHeight vlaTab r 1 tHt)
(setq r(1+ r))
); end progn
); end if
(if(= :vlax-true(vla-get-Closed vlaPl))
(progn
(setq nPl(vla-Copy vlaPl))
(command "_.region" (entlast) "")
(setq cCen(vlax-get(setq cReg
(vlax-ename->vla-object(entlast)))'Centroid))
(vla-Delete cReg)
(setq clFlg T)
); end progn
); end if
(if isAre
(progn
(if cCen
(setq xVal(rtos(car cCen)2 cAcu)
yVal (rtos(cadr cCen)2 cAcu))
(setq xVal "-"
yVal "-")
); end if
(vla-InsertRows vlaTab r tHt 1)
(vla-SetText vlaTab r 0 "CENTRO DE GRAVIDADE")
(vla-SetText vlaTab r 1 xVal)
(vla-SetText vlaTab r 2 yVal)
(vla-SetCellTextHeight vlaTab r 0 tHt)
(vla-SetCellTextHeight vlaTab r 1 tHt)
(vla-SetCellTextHeight vlaTab r 2 tHt)
(setq r(1+ r))
); end progn
); end if
(vla-put-VertCellMargin vlaTab (* 0.75 tHt))
(vla-SetColumnWidth vlaTab 0 w1)
(vla-SetColumnWidth vlaTab 3 w3)
(if(vlax-property-available-p vlaTab 'RepeatTopLabels)
(vla-put-RepeatTopLabels vlaTab :vlax-true)
); end if
(if(vlax-property-available-p vlaTab 'BreakSpacing)
(vla-put-BreakSpacing vlaTab (* 3 tHt))
); end if
(if dHead
(vla-DeleteRows vlaTab 0 1)
(progn
(vla-SetText vlaTab 0 0 hStr)
(vla-SetCellTextHeight vlaTab 0 0 hHt)
); end progn
); end if
(vla-put-Height vlaTab(* 1.75(/(length tLst)4)))
(princ "\n<<< Lugar da Tabela >>> ")
(command "_.copybase" (trans '(0 0 0)0 1)(entlast) "")
(command "_.erase" (entlast) "")
(command "_.pasteclip" pause)
(setq lCnt 0)
(foreach v vLst
(if clFlg
(setq cAng(angle cCen(trans v 0 1))
iPt(polar v cAng (* 2 mHt)))
(setq tPt1(vlax-curve-GetPointAtParam vlaPl
(- lCnt 0.0000001))
tPt2(vlax-curve-GetPointAtParam vlaPl
(+ lCnt 0.0000001))
iPt(polar v(+(* pi 0.5)(if(minusp
(setq cAng(angle tPt1(if tPt2 tPt2
(polar tPt1(* 0.5 pi)0.0000001)))))
cAng(- cAng)))(* 2 mHt))
); end setq
); end if
(setvar "OSMODE" 0)
(setq cTxt(vla-AddText mSp
(if mType(itoa(1+ lCnt))(Alph_Num lCnt))
(vlax-3d-point iPt) mHt)
tiPt(vla-get-InsertionPoint cTxt)
lCnt(1+ lCnt)
); end setq
(vla-put-Alignment cTxt 10)
(vla-put-TextAlignmentPoint cTxt tiPt)
(setq oldCol(getvar "CECOLOR"))
(setvar "CECOLOR" "1")
(command "_.circle"(trans v 0 1) (/ mHt 4))
(setvar "CECOLOR" oldCol)
); end foreach
(setvar "DIMZIN" oZin)
(setvar "OSMODE" oSnp)
(setvar "CMDECHO" 1)
(vla-EndUndoMark actDoc)
); end progn
(princ "\n<!> Essa não é uma Polilinha!<!> ")
); end if
); end progn
(princ "\n<!> This program works in AutoCAD 2005+ only! <!> " )
);end if
(gc)
(princ)
); end of c:tabcord

(princ "\n[Info] [Info]")
(princ "\n[Info] Type TABCORD para preencher tabela de coordenadas de polilinhas [Info]")

Sea-Haven · ‎07-30-2022

Throw away what you have provided pick block att get number 1202, pick block att get 1208, select group of blocks join in order. Will see if can find time to do.

rolisonfelipe · ‎07-30-2022

I'm mapping a cemetery, and for each grave, I have to have the coordinates for documentation in notary. since already thank you for the provision. and, this programming has a lot of potential

Sea-Haven · ‎07-30-2022

Ok 1st thing I have done what you want but it is the wrong way to approach this task. In say CIV3d you can auto join pts using string control so ptnum,x,y,code the code would be say plot number, the join pts part looks at the plot number and only joins points with a matching plotnum. This is standard field surveying reduction.

Are you doing this from say a paper copy or a aerial photo rather than a field survey with a total station or gps.

For me I would create a pts file say in excel then just do all in one go. Thinking more may be faster than inserting blocks and entering attributes, in excel can make the insert part and make a column of make the pline part just copy and paste the columns to the command line and all done.

Do you have a pts file ?

(defun c:joinpoints ( / ss lst att ent inspt x )
(setq ss (ssget '((0 . "INSERT"))))
(if (= ss nil)
(alert "Incorrect objects picked")
(progn
(setq lst '())
(repeat (setq x (sslength ss))
(setq ent (ssname SS (setq x (1- x) )))
(setq inspt (cdr (assoc 10 (entget ent))))
(foreach att (vlax-invoke (vlax-ename->vla-object ent) 'getattributes)
        (if (= "PONTO" (strcase (vla-get-tagstring att)))
        (setq lst (cons (list (vla-get-textstring att) inspt) lst))
        )
)
)
(setq lst ((lambda ( f ) (vl-sort lst 'f))
   (lambda ( a b / m n ) (if (= (setq m (car a)) (setq n (car b))) (f (cdr a) (cdr b)) (< m n)))
   )
)
(entmakex (append (list (cons 0 "LWPOLYLINE")
                         (cons 100 "AcDbEntity")
                         (cons 100 "AcDbPolyline")
                         (cons 90 (length lst))
                         (cons 70 1))
                   (mapcar (function (lambda (p) (cons 10 (cadr p)))) lst))
)
)
)
(princ)
)

rolisonfelipe · ‎07-30-2022

Perfect solution, exceeded my expectations. Yes, i have in txt flle.

THANK YOU SINCE THE SOLUTION

Sea-Haven · ‎07-31-2022

From a surveying point of view when doing something like this you would use what is known as string control, I am not sure what your descriptions mean.

So an example points JAZ01, JAZ01,JAZ01.......... when you get to the next JAZ it becomes JAZ02 points, the last would have a flag JAZ01*c the C implying close or I have close open plines, will do all in a dwg. The other thing is lines are drawn on correct

This would enable auto stringing.

The choice is do manually editing the dwg or open in excel and edit the file which would allow a possible stringing code.

The likes of CIV3D have this built in when reducing points.

I have often thought about doing a string points program but using CIV3D or others like "Stringer" make it un financial to do. It would be a nice front end to TriangV.0.6.7.lsp

Have a look at this excel I started to add stringing, but ignore that.

Copy the text in column H to the command line and you can see what it makes. This is one way around your problem.

You will understand how your coding works so edit the excel.

Community

PLINE FOR BLOCK

PLINE FOR BLOCK

PLINE FOR BLOCK