Lisp to crop a point cloud fails to entmod

dlbsurveysuk · ‎08-18-2023

I'm trying to write a lisp routine that crops a point cloud.

The routine runs and produces an entity list that looks to be correct when compared to DXF group data produced by the built in cropping command, but it fails to entmod the point cloud which just remains uncropped with it's original DXF group data.

Any ideas? Have I got a fundamental misconception of how this might work or just a simple error in the use of entmod?

Thanks.

Point cloud DXF Group Data -

(-1 . <Entity name: 240c1755d50>)
(0 . "ACDBPOINTCLOUDEX")
(330 . <Entity name: 240c2356020>)
(5 . "11CCD")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "A-point-clouds")
(100 . "AcDbPointCloudEx")
(70 . 1)
(10 490.642 502.882 24.7358)
(11 499.543 513.037 30.5393)
(12 0.0 0.0 0.0)
(210 1.0 0.0 0.0)
(211 0.0 1.0 0.0)
(212 0.0 0.0 1.0)
(290 . 1)
(340 . <Entity name: 240c1757cf0>)
(360 . <Entity name: 240c1755d60>)
(1 . "12 Bowling Green Lane Internal")
(291 . 0)
(71 . 1)
(1 . "")
(1 . "")
(1 . "")
(40 . 0.0)
(41 . 0.0)
(90 . 0)
(91 . 100)
(71 . 1)
(72 . 1)
(292 . 0)
(293 . 1)
(294 . 0)
(295 . 1)
(92 . 0)
(93 . 0)
(93 . 0)

Point cloud DXF Group Data after a single 4 vertices crop using the built in polygonal crop -

(-1 . <Entity name: 240c1755d50>)
(0 . "ACDBPOINTCLOUDEX")
(330 . <Entity name: 240c2356020>)
(5 . "11CCD")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "A-point-clouds")
(100 . "AcDbPointCloudEx")
(70 . 1)
(10 490.642 505.709 24.7358)
(11 499.543 513.037 30.5393)
(12 0.0 0.0 0.0)
(210 1.0 0.0 0.0)
(211 0.0 1.0 0.0)
(212 0.0 0.0 1.0)
(290 . 0)
(340 . <Entity name: 240c1757cf0>)
(360 . <Entity name: 240c1755d60>)
(1 . "12 Bowling Green Lane Internal")
(291 . 0)
(71 . 1)
(1 . "")
(1 . "")
(1 . "")
(40 . 0.0)
(41 . 0.0)
(90 . 0)
(91 . 100)
(71 . 1)
(72 . 1)
(292 . 0)
(293 . 1)
(294 . 0)
(295 . 1)
(92 . 1)
(280 . 2)
(290 . 1)
(290 . 0)
(13 0.0 0.0 0.0)
(213 1.0 0.0 0.0)
(213 0.0 1.0 0.0)
(93 . 4)
(13 500.954 506.895 0.0)
(13 489.15 508.022 0.0)
(13 492.022 514.139 0.0)
(13 501.179 513.267 0.0)
(93 . 0)
(93 . 0)

Lisp routine -

(defun c:CROPTEST ( / *error* MSG CLOUD WASLOCKED PTLIST PT X1 X2 PTLISTR LPTLISTR CLOUDATA NUMCROPS NUMVERTS COPTION RX RY)

         (defun *error* (MSG)
            (if (/= MSG "Function cancelled")
                (princ (strcat "\nError: " MSG)))
         (princ))

  (setvar 'cmdecho 1)
  (vl-load-com)

(setq cloud nil                                                                                         ;;;select cloud
         cloud (while (not cloud)
	       (initget 1)
	       (if (not (eq "ACDBPOINTCLOUDEX" (cdr (assoc 0 (setq CLOUDDATA (entget (setq CLOUD (car (entsel "\nSelect Point Cloud: ")))))))))
		(progn (prompt "...invalid.") (setq CLOUD nil))
		CLOUD)))

    (if (= 1 (getpropertyvalue CLOUD "Locked"))                                         ;;; unlock if locked
          (progn
	(vlax-put-property (vlax-ename->vla-object CLOUD) 'Locked 0)
	(setq WASLOCKED t)
          )
    )

(command "UCS" "V")

(setq PTLIST (list (setq PT (getpoint "Specify first point : "))))                   ;;; polygon selection
(princ "\nSpecify next point : ")
(princ)

  (while
     (setq PT (progn
                          (while (and (setq PT (grread t 5 0)) (= (car PT) 5))
                                (redraw)
                                (mapcar
                                     (function
                                          (lambda (X1 X2)
                                              (grdraw X1 X2 255 0)
                                     )    )
                                     (cons (cadr PT) PTLIST)
                                     (append PTLIST (cdr PT))
                           )    )
                        (if (listp (cadr PT))
                            (cadr PT))
      )            )
  (setq PTLIST (cons PT PTLIST))
  )
(redraw)

(setq PTLISTR (mapcar '(lambda (ITEM) (cons 13 ITEM)) PTLIST))   ;;; add assoc 13 to all vertices
(setq LPTLISTR (length PTLISTR))                                            ;;; number of vertices
(setq CLOUDDATA (reverse (cdr (cdr (reverse CLOUDDATA)))))          ;;; remove last two items
(setq NUMCROPS (+ 1 (cdr (assoc 92 CLOUDDATA))))                     ;;; set number of crops
(setq NUMVERTS (cons 93 LPTLISTR))                                              ;;; set number of vertices

           (initget "Inside Outside")
           (setq COPTION (cond ((getkword "\nChoose [Inside/Outside] <Inside>: ")) ("Inside")))

                (cond ((= COPTION "Inside")   (IN))
	          ((= COPTION "Outside")   (OUT))        ;;; inside / outside crop
         	)

(setq ROTX (cons 213 (trans (setq RX (getvar 'UCSXDIR)) 1 0)))                                       ;;; rotation of cloud when cropped
(setq ROTY (cons 213 (trans (setq RY (getvar 'UCSYDIR)) 1 0)))

(setq CROPLIST (list '(280 . 2) INOUT '(290 . 0)  '(13 0.0 0.0 0.0)  ROTX ROTY NUMVERTS))   ;;; make list of all crop data
(setq CROPLIST (append CROPLIST PTLISTR))
(setq ADDEND (list '(93 . 0) '(93 . 0)))
(setq CROPLIST (append CROPLIST ADDEND ))

(setq CLOUDDATA (subst (cons 92 NUMCROPS) (assoc 92 CLOUDDATA) CLOUDDATA))
(setq CLOUDDATA (append CLOUDDATA CROPLIST))
(princ CLOUDDATA)
(entmod CLOUDDATA)

    (command "UCS" "P")
    (if WASLOCKED (vlax-put-property (vlax-ename->vla-object CLOUD) 'Locked 1))               ;;; restore lock

(princ)
)

(defun IN (/) (setq INOUT (cons 280 1)))
(defun OUT (/) (setq INOUT (cons 280 2)))

(princ CLOUDDATA) after a 4 vertices crop using the above routine -

(-1 . <Entity name: 240c1755d50>)
(0 . ACDBPOINTCLOUDEX)
(330 . <Entity name: 240c2356020>)
(5 . 11CCD)
(100 . AcDbEntity)
(67 . 0)
(410 . Model)
(8 . A-point-clouds)
(100 . AcDbPointCloudEx)
(70 . 1)
(10 490.642 502.882 24.7358)
(11 499.543 513.037 30.5393)
(12 0.0 0.0 0.0)
(210 1.0 0.0 0.0)
(211 0.0 1.0 0.0)
(212 0.0 0.0 1.0)
(290 . 1)
(340 . <Entity name: 240c1757cf0>)
(360 . <Entity name: 240c1755d60>)
(1 . 12 Bowling Green Lane Internal)
(291 . 0)
(71 . 1)
(1 . )
(1 . )
(1 . )
(40 . 0.0)
(41 . 0.0)
(90 . 0)
(91 . 100)
(71 . 1)
(72 . 1)
(292 . 0)
(293 . 1)
(294 . 0)
(295 . 1)
(92 . 1)
(280 . 2)
(280 . 1)
(290 . 0)
(13 0.0 0.0 0.0)
(213 1.0 0.0 0.0)
(213 0.0 1.0 0.0)
(93 . 4)
(13 499.781 513.703 0.0)
(13 491.902 514.034 0.0)
(13 489.316 507.707 0.0)
(13 499.901 507.512 0.0)
(93 . 0)
(93 . 0)

dlbsurveysuk · ‎08-18-2023

I forgot to add. These are the assoc codes that I worked out. Assoc 92 increases as more crops are added. The rest is added before the two assoc 93s. Subsequent crops are added to the list in the same way.

(92 . 1)                            Number of crops

(280 . 1)                           Polygon / Rectangle
(290 . 0)                           Inside / Outside
(290 . 0)
(13 0.0 0.0 0.0)                    Pointcloud rotation (UCS View)
(213 1.0 0.0 0.0)                   UCSXDIR
(213 0.0 1.0 0.0)                   UCSYDIR
(93 . 4)                            Number vertices
(13 493.48 509.203 0.0)             V1 (in WCS)
(13 498.579 509.203 0.0)            V2
(13 498.579 510.84 0.0)             V3
(13 493.48 510.84 0.0)              V4

dlbsurveysuk · ‎08-20-2023

I've tried both of these to no avail. Am I messing up my code / general procedures, or is this just not possible with point clouds and there is some other way of doing it?

(setq REDATA (entget (ssname (setq RECLOUD (ssget "L")) 0)))
(setq REDATA CLOUDDATA)
(entmod REDATA)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(setq REDATA (entget (ssname (setq RECLOUD (ssget "L")) 0)))
(command "ERASE" "L" "")
(setq REDATA CLOUDDATA)
(entmake REDATA)

d_marsh · ‎08-17-2024

Hey, complete novice in this space but would using (command "pointcloudcrop") then just manually doing it through command line not be a viable option for what youre trying to achieve?

You seem to know alot more lisp than i do but i tend to just brute force some things and it gets the job done.

Community

Lisp to crop a point cloud fails to entmod

Lisp to crop a point cloud fails to entmod

Lisp to crop a point cloud fails to entmod