TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: eduardoceliz on June 07, 2020, 08:38:14 AM
-
hello, I am generating this code to insert texts to a civil 3d surface it works ok, my problem is when the peak outside the surface is automatically canceled, what I am looking for is that the lisp when it detects that error automatically restarts asking me to insert the point again or failing to insert the text but with a value of "0" or "---" or "", I hope you can help me
(defun c:test ()
(setq sup (vlax-ename->vla-object (car (entsel "\nSurface:"))))
(WHILE
(setq pt1 (getpoint "\nPoint: "))
(setq ele(vlax-invoke sup 'FindElevationAtXY (car pt1) (cadr pt1)))
(command "text" "j" "mc" pt1 2.5 0 (rtos ele 2 2))
);fin while
);fin defun
-
Hi,
I don't have Civil 3D to test the codes out but you can try it yourself and let me know how it works for you.
(defun c:test
(/ text_ sel pt ele
) '(40 . 2.5)
'(71 . 0)
'(72 . 1)
'(73 . 2)
)
)
)
'FindElevationAtXY
)
)
(text_ pt
(rtos ele
2 2)) (princ "\nInvalid point !. Try again.") )
)
)
-
I just tried it but it throws the following error "; error: Civil 3D API: Triangle is deleted" and the lisp stops, what I am looking for is that the lisp does not stop
-
I just tried it but it throws the following error "; error: Civil 3D API: Triangle is deleted" and the lisp stops, what I am looking for is that the lisp does not stop
Try this:
(defun c:test ( / sup sup_name pt1 ele lavelTin )
(vl-load-com)
(if
(setq sup (car (entsel "\nSurface ->> ")))
(progn
(setq sup_name (vlax-ename->vla-object sup))
(while (setq pt1 (getpoint "\nSpecify a Point ->> "))
(setq ele (if (vl-catch-all-error-p (setq lavelTin (vl-catch-all-apply 'vlax-invoke (list sup_name 'FindElevationAtXY (car pt1) (cadr pt1)))))
"" ; if out of Surface
(rtos lavelTin 2 3)
))
(entmake
(list
(cons 0 "TEXT")
(cons 8 "TIN_point")
(cons 10 pt1)
(cons 40 1); Text height <<--
(cons 1 ele)
(cons 50 0)
(cons 7 (getvar 'textstyle))
(cons 62 150)
)
)
);fin while
); end of progn
(princ "\nInvalid Surface. Try again.")
); end of if
(princ)
);fin defun
-
I just tried it but it throws the following error "; error: Civil 3D API: Triangle is deleted" and the lisp stops, what I am looking for is that the lisp does not stop
Or this version:
(defun c:test ( / get-entsel-no-error sup sup_name pt1 ele lavelTin )
(vl-load-com)
;-----
(defun get-entsel-no-error (message / ent)
(setvar "errno" 0)
(while
(and
(not (setq ent (entsel (strcat "\n" message))))
(equal 7 (getvar "errno"))
)
(setvar "errno" 0)
)
(cond
((equal (getvar "errno") 52)
nil
)
(t
(list (car ent) (trans (cadr ent) 1 0))
)
)
)
;-----
(if
(setq sup (car (get-entsel-no-error "\nSurface ->> ")))
(progn
(setq sup_name (vlax-ename->vla-object sup))
(while (setq pt1 (getpoint "\nSpecify a Point ->> "))
(setq ele (if (vl-catch-all-error-p (setq lavelTin (vl-catch-all-apply 'vlax-invoke (list sup_name 'FindElevationAtXY (car pt1) (cadr pt1)))))
"" ; if out of Surface
(rtos lavelTin 2 3)
))
(entmake
(list
(cons 0 "TEXT")
(cons 8 "TIN_point")
(cons 10 pt1)
(cons 40 1); Text height <<--
(cons 1 ele)
(cons 50 0)
(cons 7 (getvar 'textstyle))
(cons 62 150)
)
)
);fin while
); end of progn
(princ "\nInvalid Surface. Try again.")
); end of if
(princ)
);fin defun
-
I just tried it but it throws the following error "; error: Civil 3D API: Triangle is deleted" and the lisp stops, what I am looking for is that the lisp does not stop
Here is the version with filter when choosing for surface:
(defun c:test ( / mip:entsel sup sup_name pt1 ele lavelTin )
(vl-load-com)
;-----
(defun mip:entsel (promt filter entlist / key n newentlist ent_point promt)
(setq key T n 0 newentlist nil)
(if (eq (type entlist) 'PICKSET)
(progn
(while (setq a (ssname entlist n)) (setq newentlist (append newentlist (list a)) n (1+ n)))
(setq entlist newentlist)
);progn
);if
(while key
(if (or (setq ent_point (entsel promt)) (= (getvar "ERRNO") 7))
(if (or (eq (type ent_point) 'LIST) (not ent_point))
(if ent_point
(if (member (setq ent (car ent_point)) entlist)
(princ "\nObject already selected")
(if filter
(if (not (member (cdr (assoc 0 (entget ent))) filter))
(progn (setq str "\nWrong choice, specify: ")
(princ (substr (setq str (foreach n filter (setq str (strcat str n ", ")))) 1 (- (strlen str) 2)))
);progn
(setq key nil)
);if
(setq key nil)
);if
);if
(setq key T)
);if
(setq key nil)
);if
(setq key nil)
);if
);while
(if (eq (type ent_point) 'LIST)
(progn (setvar "LASTPOINT" (cadr ent_point)) ent)
ent_point
);if
)
;-----
(if
(setq sup (mip:entsel "\nSpecify a Surface ->> " '("AECC_TIN_SURFACE") nil))
(progn
(setq sup_name (vlax-ename->vla-object sup))
(while (setq pt1 (getpoint "\nSpecify a Point ->> "))
(setq ele (if (vl-catch-all-error-p (setq lavelTin (vl-catch-all-apply 'vlax-invoke (list sup_name 'FindElevationAtXY (car pt1) (cadr pt1)))))
"" ; if out of Surface
(rtos lavelTin 2 3)
))
(entmake
(list
(cons 0 "TEXT")
(cons 8 "TIN_point")
(cons 10 pt1)
(cons 40 1); Text height <<--
(cons 1 ele)
(cons 50 0)
(cons 7 (getvar 'textstyle))
(cons 62 150)
)
)
);fin while
); end of progn
(princ "\nInvalid Surface. Try again.")
); end of if
(princ)
);fin defun
-
thanks it works perfect
-
Answer over at cadtutor as well re choose surface option.