Hello,
I am trying to write a program to align a block with two selected destination points.
- first the user is prompted to select a lwpolyline of a block entity
- then he is prompted to pick two destination points
I face problem with the sub-routine SegmentPts. It is supposed to return the coordinates of two vertexes on both sides of the picked point on a lwpolyline using entsel. But here in my program, when i am picking a point using entsel on a lwpolyline inside a block entity, it is not returning the two vertexes on both sides of the picked point. In stead, it returns some other points of the selected LWPOLYLINE. Why it is doing so? Where is the problem in my program?
It works fine with my other programs where i pick on a LWPOLYLINE entity.
In this particular case, the LWPOLYLINE is inside a Block entity and the program is not returning correct points.
Any help in thisregard will be highly appreciated.
Thanks
Please check my my Lisp Program below:
(defun C:alb()
(setq ent1 (entsel "\nPick on one side of LWLINE ofa Block:" ))
(setq ent (nentselp (cadr ent1)))
(setq ins_pt (cdr (assoc 10 (entget (car ent1)))))
(setq pt_d1 (getpoint "\nSpecify first destination point:"))
(setq pt_d2 (getpoint "\nSpecify Second destination point:" pt_d1))
(setq pt_l (SegmentPts ent))
(setq pt_a (car pt_l) pt_b (cadr pt_l))
(command "align" (car ent1) "" (setq a (translate pt_a ins_pt)) pt_d1 (setq b (translate pt_b ins_pt)) pt_d2 "" "N")
)
;;;;;;;;;;;;;;;;;;;;;;;
(defun translate (pt pin /)
(mapcar '+ pt pin)
)
;;;;;;;;;;;;;;;;;;;;;;;
(defun SegmentPts (ent / e pnt vobj Name param1 param2 p1 p2 SegPts)
(vl-load-com)
(and
(setq e (car ent))
(= (type e) 'ENAME)
(setq pnt (cadr ent))
(listp pnt)
(not (atom (cdr pnt)))
(vl-every (function (lambda (x) (= (type x) 'REAL))) pnt)
(setq vobj (vlax-ename->vla-object (car ent)))
(setq pnt (trans (cadr ent) 1 0))
(setq pnt (vlax-curve-getClosestPointTo vobj pnt))
(setq Name (vla-get-ObjectName vobj))
(cond
((vl-position Name '("AcDbArc" "AcDbLine"))
(setq p1 (vlax-curve-getStartPoint vobj))
(setq p2 (vlax-curve-getEndPoint vobj))
)
((wcmatch (strcase Name) "*POLYLINE")
(setq param1 (vlax-curve-getParamAtPoint vobj pnt))
(setq param1 (fix param1))
(setq param2 (1+ param1))
(if (equal param1 (vlax-curve-getStartParam vobj) 1e-10)
(setq p1 (vlax-curve-getStartPoint vobj))
(setq p1 (vlax-curve-getPointAtParam vobj param1))
)
(if (equal param2 (vlax-curve-getEndParam vobj) 1e-10)
(setq p2 (vlax-curve-getEndPoint vobj))
(setq p2 (vlax-curve-getPointAtParam vobj param2))
)
) ;pline cond
(T
(prompt (strcat "\nHaven't figured out a(n) " Name " yet."))
)
) ;conditions
p1
p2
(setq SegPts (list p1 p2))
) ;and
SegPts
) ;end