automated revision cloud?

draw a lwpolyline and then run "convertpoly" and change it pack to a regular
polyline..

Tim W.

polylines, but they all came back as being "LWPOLYLINE", so if you list one
(with entget) and post it, then I can see about doing that.

 

Here is one that will change a "polyline" to a "lwpolyline" and ask you if you want it closed or not. If you chose not to close it, then it exits the lisp. I also added the command undo while testing. If you don't want them in just take them out.

Tim

(defun pcloud (/ op1)

(command "_.undo" "end")
(command "_.undo" "group")
(setq pcd1 (entsel "\nSelect closed polyline: "))
(if pcd1
(progn
(setq pcd1 (entget (car pcd1)))
(if (= (cdr (assoc 0 pcd1)) "POLYLINE")
(progn
(command "_.convertpoly" "l" (cdr (assoc -1 pcd1)) "")
(setq pcd1 (entget (cdr (assoc -1 pcd1))))
); progn
); if
(if (= (cdr (assoc 0 pcd1)) "LWPOLYLINE")
(if (= (cdr (assoc 70 pcd1)) 1)
(verticepoints pcd1)
(progn
(initget "Y N")
(setq op1 (getkword "\nPolyline is not closed. Would you like to close it? [<Y>,N]: "))
(if (not op1)
(setq op1 "Y")
); if
(if (= (strcase op1) "Y")
(progn
(setq pcd1 (subst (cons 70 1) (assoc 70 pcd1) pcd1))
(entmod pcd1)
(entupd (cdr (assoc -1 pcd1)))
(verticepoints pcd1)
); progn
(vl-exit-with-value nil)
); if
);progn
); if
(princ "\nObject selected is not a polyline. ")
); if
); progn
(princ "\n Nothing selected: ")
); if
(command "_.undo" "end")
(princ)
)

;=========================================

(defun VerticePoints(poly1 / n vpl)

(setq n 0)
(while (nth n poly1)
(if (= (car (nth n poly1)) 10)
(setq vpl (append vpl (list (cdr (nth n poly1)))))
)
(setq n (1+ n))
)
(command "_.erase" (cdr (assoc -1 pcd1)) "")
(if (= op1 "Y")
(setq vpl (reverse (cdr (reverse vpl))))
)
(if (> (angle (car vpl) (cadr vpl)) 3.14159)
(setq vpl (reverse vpl))
)
(getangs (reverse vpl))
)

;================================================

(defun getangs (vpts / alist dlist)

(setq vpts (append vpts (list (car vpts))))
(while (> (vl-list-length vpts) 1)
(setq alist (append alist (list (angle (car vpts) (cadr vpts)))))
(setq dlist (append dlist (list (distance (car vpts) (cadr vpts)))))
(setq vpts (cdr vpts))
)
(drpcld alist dlist (car vpts))
)

;=================================================

(defun drpcld (ang0 dist0 start / dist2 pt1 sc1 cdsc pclss cnt1 cnt2 rad1 adist)

(if (>= (getvar"cvport") 2)
(setq sc1 (getvar "DIMSCALE"))
(setq sc1 1)
)
(setq dist2 0
pt1 start
dist1 (car dist0)
ang1 (car ang0)
cdsc (* sc1 0.03125)
rad1 0.65
pclss (ssadd)
cnt1 (vl-list-length dist0)
cnt2 1
)
(if (> dist1 3)
(setq adist 1.0)
(setq adist (* dist1 0.3333))
)
(repeat cnt1
(while (< dist2 dist1)
(if (and (> (1+ dist2) dist1) (= cnt2 cnt1))
(progn
(setq pt2 start)
(setq rad1 (* (distance pt1 pt2) 0.65))
)
(setq pt2 (polar pt1 ang1 adist))
)
(command "_.arc" pt1 "e" pt2 "r" rad1)
(command "_.pedit" (entlast) "y" "e" "w" cdsc "0" "x" "")
(ssadd (entlast) pclss)
(setq dist2 (1+ dist2)
pt1 pt2
)
)
(setq dist2 0
ang0 (cdr ang0)
ang1 (car ang0)
dist0 (cdr dist0)
dist1 (car dist0)
cnt2 (1+ cnt2)
)
(if dist1
(if (> dist1 3)
(setq adist 1.0)
(setq adist (* dist1 0.3333))
)
)
)
(command "_.pedit" "m" pclss "" "j" "" "")

)

 

Works as advertised...

Thanks For Reworking it.

Tim W.

you want it closed or not. If you chose not to close it, then it exits the
lisp. I also added the command undo while testing. If you don't want them
in just take them out.

 

Good routine..............................You might need this too

Gary



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;; Flip the Bulges Function
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;You can also flip the bulges with this code
;;;Peter Jamtjaard
(defun BULGEIT (/ CNT COORDS DIV EOBJ )
(setq EOBJ (vlax-ename->vla-object
(car (entsel "\n* Select pline: "))
)
)
(if EOBJ
(progn
(setq COORDS (vlax-safearray->list
(vlax-variant-value
(vla-get-coordinates EOBJ)
)
)
)
(setq CNT 0)
(if (or (= (vla-get-objectname EOBJ) "AcDb2dPolyline")
(= (vla-get-objectname EOBJ) "AcDb3dPolyline")
)
(setq DIV 3)
(setq DIV 2)
)
(while (< CNT (/ (length COORDS) DIV))
(if (< (vla-getbulge EOBJ CNT) 0.0)
(vla-setbulge EOBJ CNT 1.0)
(vla-setbulge EOBJ CNT -1.0)
)
(setq CNT (1+ CNT))
)
)
)
(prin1)
)

 

Gary,

I added a check with the last one I posted. It asks if it's shown right, if not then it flips the way the buldges go, either inside or outside like a revision cloud.

Tim

 

I quess I missed that...I got no prompt for flipping the bulge........

Gary

not then it flips the way the buldges go, either inside or outside like a
revision cloud.

 

Wow, all the responses!! I've been out sick since Thursday, so I'll go
through all these and see what works. Thanks so much for all your help!!
Allison