move point to vertex and draw 3d poly

[hosneyalaa]

On 6/22/2021 at 7:47 PM, jbach said:

Here you go. Yes they are COGO points and they are unlocked when trying to move with the LISP.

 

Thank you!

Moving Points.dwg 1.95 MB · 7 downloads

 

For civil 3d form

 

https://forums.autodesk.com/t5/civil-3d-customization/bd-p/190

[Marcelo Seipke]

On 5/6/2020 at 4:56 PM, ronjonp said:

is it posible to update this code work with Alignment PI ?

 

Thanks

(defun c:s2o (/ a b c d el m s)
  ;; RJP » 2020-04-29
  ;; Could give bad results for multiple vertices that are within the 'search distance'
  (cond
    ((and (setq d (getdist "\nPick a distance to search: "))
	  (setq s (ssget ":L" (list '(0 . "CIRCLE,INSERT,POINT,LWPOLYLINE"))))
     )
     (foreach e	(vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
       (if (= "LWPOLYLINE" (cdr (assoc 0 (setq el (entget e)))))
	 (setq b (cons (vl-remove-if '(lambda (x) (/= 10 (car x))) el) b))
	 (setq a (cons (list (cdr (assoc 10 el)) e) a))
       )
     )
     (if (setq b (mapcar 'cdr (apply 'append b)))
       (foreach	p a
	 (setq c (mapcar '+ (car p) '(0 0)))
	 (cond
	   ((setq m (vl-some '(lambda (x)
				(if (equal c x d)
				  x
				)
			      )
			     b
		    )
	    )
	    (setq b (vl-remove m b))
	    (entmod (append (entget (cadr p)) (list (cons 10 (append m (list (last (car p))))))))
	   )
	 )
       )
     )
    )
  )
  (princ)
)

 

 

On 5/6/2020 at 4:56 PM, ronjonp said:

Yup.

(defun c:s2o (/ a b c d el m s)
  ;; RJP » 2020-04-29
  ;; Could give bad results for multiple vertices that are within the 'search distance'
  (cond
    ((and (setq d (getdist "\nPick a distance to search: "))
	  (setq s (ssget ":L" (list '(0 . "CIRCLE,INSERT,POINT,LWPOLYLINE"))))
     )
     (foreach e	(vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
       (if (= "LWPOLYLINE" (cdr (assoc 0 (setq el (entget e)))))
	 (setq b (cons (vl-remove-if '(lambda (x) (/= 10 (car x))) el) b))
	 (setq a (cons (list (cdr (assoc 10 el)) e) a))
       )
     )
     (if (setq b (mapcar 'cdr (apply 'append b)))
       (foreach	p a
	 (setq c (mapcar '+ (car p) '(0 0)))
	 (cond
	   ((setq m (vl-some '(lambda (x)
				(if (equal c x d)
				  x
				)
			      )
			     b
		    )
	    )
	    (setq b (vl-remove m b))
	    (entmod (append (entget (cadr p)) (list (cons 10 (append m (list (last (car p))))))))
	   )
	 )
       )
     )
    )
  )
  (princ)
)