acad hispano
¿Quieres reaccionar a este mensaje? Regístrate en el foro con unos pocos clics o inicia sesión para continuar.

problema con una rutina para medir de vertice en vertice en auto lisp

Ir abajo

problema con una rutina para medir de vertice en vertice en auto lisp Empty problema con una rutina para medir de vertice en vertice en auto lisp

Mensaje por lazav el Jue Mar 26, 2020 4:38 am

hola.
me baje una rutina para medir los segmentos de una polilinea y el comando me tira un error "Comando: MPL
._Layer
Capa actual: "0"Indique una opción [?/Establ/Def/CRear/RENombrar/ACT/DES/COlor/Tlínea/Grosorl/tranSParencia/MATerial/TRazar/Inut/Reut/Bloq/desbLoq/eStado/DESCr/REConciliar]: n
Opción no válida.
; error: Función cancelada

el comando es el sig

(vl-load-com)

(defun c:MLin()
(setvar "luprec" 2)
(Cre_Lay "dist" 6)
(setq disttot 0)
(setq lines(ssget (list (cons 0 "line,pline,lwpolyline"))))
(setq ctr 0)
(if (/= lines nil)
(progn
(setq len(sslength lines))
(repeat len
(setq ent(ssname lines ctr))
(setq pntList(ReadPline ent))
(setq ptCntr 0)
(repeat (1- (length pntList))
(setq fpoint(nth ptCntr pntList))
(setq epoint(nth (1+ ptCntr) pntList))
(setq thr(distance fpoint epoint))
(setq fou(angle fpoint epoint))
(setq ang(* (/ fou pi) 180))
(if (and (>= ang 90) (<= ang 270)) (setq ang(rtos (+ ang 180))) (setq ang(rtos ang)))
(setq txt_ins(MidP fpoint epoint))
(command "._Text" "j" "bc" txt_ins "1.75" ang (rtos thr))
(command "._Change" (entlast) "" "p" "la" "dist" "")
(setq disttot(+ disttot (distance fpoint epoint)))
(setq ptCntr(1+ ptCntr))
)
(setq ctr(1+ ctr))
)
(princ (strcat "\nTotal distance :" (rtos disttot 2 4)))
)
)
(princ)
)
(princ "\nType \"MLin\" to Measure each Segment of the Polyline.") (princ)

; Function to find the mid point of two points.
(defun MidP(midp_fpo midp_spo)
(setq midp_mpo(list (/ (+ (car midp_fpo) (car midp_spo)) 2) (/ (+ (cadr midp_fpo) (cadr midp_spo)) 2)))
)

;Function to Create a Layer with given color.
(defun Cre_Lay(lay_layn lay_laycol)
(if (= (tblsearch "Layer" lay_layn) nil)
(command "._Layer" "n" lay_layn "c" lay_laycol lay_layn "")
(command "._Layer" "t" lay_layn "on" lay_layn "c" lay_laycol lay_layn "")
)
(princ)
)

;Function to Read Vertices of Selected Lines.
(defun ReadPline(imp_Ent)
(setq glb_obj(vlax-ename->vla-object imp_Ent))
(setq glb_PntCnt(vlax-curve-getEndParam glb_obj))
(setq returnPTList '())
(setq ptCntr 1)
(setq glb_oName(vlax-get-property glb_obj 'ObjectName))
(setq glb_OClosed nil)
(if (= glb_oName "AcDbLine")
(progn
(setq glb_EnDetails(entget imp_Ent))
(setq big_Point3d(cdr (assoc 10 glb_EnDetails)))
(setq end_Point3d(cdr (assoc 11 glb_EnDetails)))
(setq returnPTList(append returnPTList (list big_Point3d)))
(setq returnPTList(append returnPTList (list end_point3d)))
)
(progn
(setq glb_OClosed(vlax-curve-isClosed glb_obj))
(setq glb_2dDist 0)
(setq old_Point nil)
(repeat (1+ (fix glb_PntCnt))
(setq cur_Point3d(vlax-curve-getPointAtParam glb_obj (1- ptCntr)))
(setq returnPTList(append returnPTList (list cur_Point3d)))
(setq ptCntr(1+ ptCntr))
)
)
)
(setq return returnPTList)
)


me tira ese error siempre ya probe volviendo a instalar el cad

y un amigo lo probo en su pc y le anda barbaro

alguen sabe el por que?

lazav

Mensajes : 1
Fecha de inscripción : 26/03/2020

Volver arriba Ir abajo

problema con una rutina para medir de vertice en vertice en auto lisp Empty Re: problema con una rutina para medir de vertice en vertice en auto lisp

Mensaje por Admin el Jue Mar 26, 2020 3:14 pm

El comando es MLIN . No es MPL

Si puedes sube un DWG , debes comprimirlo ya que el foro no acepta adjuntos dwg

O puedes enviarlo a mi mail devitg@gmail.com

Admin
Admin

Mensajes : 216
Fecha de inscripción : 16/03/2016
Edad : 72
Localización : CORDOBA ARGENTINA

https://acadhispano.foroargentina.net

Volver arriba Ir abajo

problema con una rutina para medir de vertice en vertice en auto lisp Empty Re: problema con una rutina para medir de vertice en vertice en auto lisp

Mensaje por Dominguez el Vie Mar 27, 2020 9:28 pm

Tambien puedes utilizar esta rutina que funciona pefectamente Tramos_Pol.lsp
Código:
 ; Acota todos los tramos de una polilinea, Abierta ó Cerrada (incluso los curvos).
 ; luis Dominguez Gomez :copyright: 2017
;;;ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
;; polilinea abierta.
(defun pln_open   (/ ang ent explst ptxt long mid pol)
 (if (equal (cdr (assoc 0 (setq ent (entget (car (entsel "\nSelecciona Polilinea2D: ")))))) "LWPOLYLINE")
  (setq ent (cdr (car ent)))
  (progn (prompt "\nNo es una polilinea 2D: ") (textpage) (exit))
 )
 (setq pol (vlax-ename->vla-object ent))
 (setq explst (vlax-invoke pol 'explode))
 (foreach # explst
  (setq mid (vlax-curve-getpointatdist # (/ (vlax-curve-getdistatparam # (vlax-curve-getendparam #)) 2.0)))
  (setq long (rtos (vlax-curve-getdistatpoint # (vlax-curve-getendpoint #)) 2 3))
  (setq ang (rem (angle (vlax-curve-getstartpoint #) (vlax-curve-getendpoint #)) pi))
  (if (> ang (/ pi 2.0))
  (setq ang (+ pi ang))
  )
  (setq ptxt (polar mid (+ ang (/ pi 2)) (* *altxt* 0.75)))
  (text)
  (vla-delete #)
 )
)
;;;ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
(defun text nil
 (entmake (list   '(0 . "TEXT")
      (cons 1 long)
      '(7 . "TRAMOS")
      (cons 10 ptxt)
      (cons 11 ptxt)
      (cons 40 *altxt*)
      (cons 50 ang)
      '(72 . 1)
      '(73 . 2)
     )
 )
)
;;;ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
;; polilinea cerrada.
(defun pln_clos   (/ ang explst long mid pol poly pto ptxt)
 (setq pto (getpoint "\nIndicar punto interno: "))
 (vl-cmdf "_.boundary" pto "")
 (setq pol (entlast)) ;boundary
 (vl-cmdf "_offset" (* *altxt* 0.75) pol pto "")
 (setq poly (vlax-ename->vla-object (entlast))) ;offset
 (setq pol (vlax-ename->vla-object pol)) ;boundary
 (setq explst (vlax-invoke pol 'explode)) ;
 (foreach # explst
  (setq mid (vlax-curve-getpointatdist # (/ (vlax-curve-getdistatparam # (vlax-curve-getendparam #)) 2.0)))
  (setq ptxt (vlax-curve-getclosestpointto poly mid))
  (setq long (rtos (vlax-curve-getdistatpoint # (vlax-curve-getendpoint #)) 2 3))
  (setq ang (rem (angle (vlax-curve-getstartpoint #) (vlax-curve-getendpoint #)) pi))
  (if (> ang (/ pi 2.0))
  (setq ang (+ pi ang))
  )
  (text)
  (vla-delete #)
 )
 (vla-delete pol) ;boundary
 (vla-delete poly) ;offset
)
;;;ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
(defun c:tp (/ alt mod opc)
 (vl-load-com)
 (setvar 'cmdecho 0)
 (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
 (setq mod (getvar 'osmode))
 (setvar 'osmode 0)
 (setvar 'dimzin 1)
 (if (not *altxt*)
  (setq *altxt* (getreal (strcat "\nIndique altura de textos: ")))
  (progn (setq alt (getreal (strcat "\nIndique altura de textos: <" (rtos *altxt* 2 2) ">")))
    (if (/= alt nil)
     (setq *altxt* alt)
    )
  )
 )
 (if (not (tblobjname "STYLE" "TRAMOS"))
  (entmake (list '(0 . "STYLE")   '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbTextStyleTableRecord") '(2 . "TRAMOS")
       '(70 . 0) '(40 . 0.0) '(41 . 1.0) '(50 . 0.0) '(71 . 0) '(3 . "ARIAL")   '(4 . "")
      )
  )
 )
 (setvar 'textsize *altxt*)
 (initget 7 "A C")
 (setq opc (getkword "Poly <Abierta/Cerrada>: "))
 (if (= opc "A")
  (pln_open)
  (pln_clos)
 )
 (setvar 'osmode mod)
 (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
 (prin1)
)
;;;ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
(alert "\nComando: < TP > para ejecutar")
(prin1)
Dominguez
Dominguez

Mensajes : 94
Fecha de inscripción : 20/03/2016
Edad : 70
Localización : Zaragoza (España)

Volver arriba Ir abajo

problema con una rutina para medir de vertice en vertice en auto lisp Empty Re: problema con una rutina para medir de vertice en vertice en auto lisp

Mensaje por Dominguez el Vie Mar 27, 2020 11:20 pm

De todas formas aqui tienes tu rutina actualizada
Pero que sepas que esta rutina no acota tramos curvos.
Código:
(vl-load-com)
(defun c:mlin ()
 (setvar "luprec" 2)
 (cre_lay "dist" 6)
 (setq disttot 0)
 (setq lines (ssget (list (cons 0 "line,pline,lwpolyline"))))
 (setq ctr 0)
 (if (/= lines nil)
  (progn (setq len (sslength lines))
 (repeat len
  (setq ent (ssname lines ctr))
  (setq pntlist (readpline ent))
  (setq ptcntr 0)
  (repeat (1- (length pntlist))
   (setq fpoint (nth ptcntr pntlist))
   (setq epoint (nth (1+ ptcntr) pntlist))
   (setq thr (distance fpoint epoint))
   (setq fou (angle fpoint epoint))
   (setq ang (* (/ fou pi) 180))
   (if (and (>= ang 90) (<= ang 270))
    (setq ang (rtos (+ ang 180)))
    (setq ang (rtos ang))
   )
   (setq txt_ins (midp fpoint epoint))
   (command "._Text" "_j" "_bc" txt_ins "1.75" ang (rtos thr))
   (command "._Change" (entlast) "" "_p" "_la" "dist" "")
   (setq disttot (+ disttot (distance fpoint epoint)))
   (setq ptcntr (1+ ptcntr))
  )
  (setq ctr (1+ ctr))
 )
 (princ (strcat "\nTotal distance :" (rtos disttot 2 4)))
  )
 )
 (princ)
)
(princ "\nType "MLin" to Measure each Segment of the Polyline.")
(princ)

 ; Function to find the mid point of two points.
(defun midp (midp_fpo midp_spo)
 (setq midp_mpo (list (/ (+ (car midp_fpo) (car midp_spo)) 2) (/ (+ (cadr midp_fpo) (cadr midp_spo)) 2)))
)

 ;Function to Create a Layer with given color.
(defun cre_lay (lay_layn lay_laycol)
 (if (= (tblsearch "Layer" lay_layn) nil)
  (command "._Layer" "_n" lay_layn "_c" lay_laycol lay_layn "")
  (command "._Layer" "_t" lay_layn "_on" lay_layn "_c" lay_laycol lay_layn "")
 )
 (princ)
)

 ;Function to Read Vertices of Selected Lines.
(defun readpline (imp_ent)
 (setq glb_obj (vlax-ename->vla-object imp_ent))
 (setq glb_pntcnt (vlax-curve-getendparam glb_obj))
 (setq returnptlist '())
 (setq ptcntr 1)
 (setq glb_oname (vlax-get-property glb_obj 'objectname))
 (setq glb_oclosed nil)
 (if (= glb_oname "AcDbLine")
  (progn (setq glb_endetails (entget imp_ent))
 (setq big_point3d (cdr (assoc 10 glb_endetails)))
 (setq end_point3d (cdr (assoc 11 glb_endetails)))
 (setq returnptlist (append returnptlist (list big_point3d)))
 (setq returnptlist (append returnptlist (list end_point3d)))
  )
  (progn (setq glb_oclosed (vlax-curve-isclosed glb_obj))
 (setq glb_2ddist 0)
 (setq old_point nil)
 (repeat (1+ (fix glb_pntcnt))
  (setq cur_point3d (vlax-curve-getpointatparam glb_obj (1- ptcntr)))
  (setq returnptlist (append returnptlist (list cur_point3d)))
  (setq ptcntr (1+ ptcntr))
 )
  )
 )
 (setq return returnptlist)
)
Un saludo
Dominguez
Dominguez

Mensajes : 94
Fecha de inscripción : 20/03/2016
Edad : 70
Localización : Zaragoza (España)

Volver arriba Ir abajo

problema con una rutina para medir de vertice en vertice en auto lisp Empty Re: problema con una rutina para medir de vertice en vertice en auto lisp

Mensaje por Contenido patrocinado


Contenido patrocinado


Volver arriba Ir abajo

Volver arriba


 
Permisos de este foro:
No puedes responder a temas en este foro.