Community

Might need Apply, Mapcar, not sure how to do this..

Might need Apply, Mapcar, not sure how to do this..

rapidcad
Collaborator Collaborator
882 Views
17 Replies
Message 1 of 18

Might need Apply, Mapcar, not sure how to do this..

rapidcad
Collaborator
Collaborator
‎02-06-2015 08:46 AM

Any help greatly appreciated.

 

As usual, I am way over my head is lisp again, working on a program to take dynamic block properties from a number of (up to 30) dynamic blocks and temporarily store the data, then use the stored data to configure a "conglomerate" dynamic block which will represent the plan view of the multiple dynamic blocks and contain their data. I have many parts working already, but I am struggling with some sorting functions I haven't ever had to use before.

 

So I have created a program that prompts the user to select all the dynamic blocks that represent an elevation view of a belted conveyor unit. the unit consists of any combination of 6 dynamic blocks - it has to have a drive bed block and also two end pulleys which could be in any one of 3 other kinds of beds,  and two more types of the blocks are simply intermediate beds - they are beds that make the unit longer by varying lengths. So what I am saying is that when the user selects blocks, he will get a filtered pickset of up to 30 dynamic blocks which will be of the 6 possible bed definitions.

 

Each of the six definitions has some common data which I am storing in association lists named BEDINFO_0, BEDINFO_1, BEDINFO_2.... up to BEDINFO_30. This should be enough. My program is creating these stored lists as required, so there will only be as many as required, usually about 10 - 15 or less.

 

I have gotten to the point that I have the association lists made, but I am having trouble figuring out how to find the important data from them.

 

For example, I'll need to check (car (cdr (nth 5 BEDINFO_EACHNUMBER))) to find the minimum x value. I'll have to do this to different nth numbers to check for maximum y value, or to find other stored information like degrees of rotation, etc. Of course, I just supplied the EACHNUMBER for this post to convey an issue- each association list will be called BEDINFO_X and I'll need to check up to a flexible number of them to find the data I need, (BEDINFO_0, BEDINFO_1, ETC..) you get the idea.

 

I figure that mapcar and apply will be needed to create a function to do this but I can't figure out exactly how.

 

I know the number of times to index BEDINFO_ by (sslength finalss), so starting with (car (cdr (nth 5 BEDINFO_0))) I have to search for the min coordinate x value (for this example) until I reach the number of BEDINFO_ sets represented by (sslength finalss).

 

I think that is enough info to figure out how to construct such a function.

 

Anyone with more experience care to enlighten me?

 

Thanks in advance,

 

Ron

 

 

ADN CAD Developer/Operator
0 Likes
Like
Report
Accepted solutions (2)
Solution 1
Solution 2
883 Views
17 Replies
Replies (17)
Message 2 of 18

Anonymous
Not applicable
‎02-06-2015 10:12 AM

Hi rapidcad,

 

Can you give as an example of input and output of your function.

I don't understand in which format are you having BEDINFO association lists, are they stored as xdata in entities in selection set, or in list.

If you want to use aply mapcar, foreach, I think you need to have all information stored in one list, on which one you are going to manipulate with mentioned functions.

And about your results, do you want to store them in list too?

 

dicra

 

 

0 Likes
Like
Report
Message 3 of 18

rapidcad
Collaborator
Collaborator
in reply to Anonymous
‎02-06-2015 10:40 AM

Thanks dicra, I'll try to throw together pieces of this so you can test, but it will be difficult, and the full program has external functions that I would have to include. Additionaly, it only goes so far at this point and I'm not sure if I'm headed in the right direction. Attached find drawing including dynamic blocks.

 

Here's code: Watch for word wrap...

and oh yeah, these two functions might be needed too -

 

(DEFUN d2r (a) (* pi (/ a 180.0)) )

(DEFUN r2d (a) (/ (* a 180.0) pi) )

 

; Function for transforming a point from block object coordinate system to a world coordinate system.
; It handles normals other than (0.0 0.0 1.0)
; lstPoint is the point to transform and objBlock is the block object
; The block is uniformly scaled at 1.0.
; Written By: Peter Jamtgaard copr 2008
(defun TranslateObjectToWorld (objBlock         ; Block object 
                               lstPointInBlock  ; Coordinates of point (RELATIVE TO BASE POINT)
                                                ; inside the block
                               /       
                               lstInsertion     ; Insertion Point of Block
                               lstPoint         ; List Point of return translate coordinates
                               lstPointInWorld  ; Coordinates of point inside the WorldCS
                               sngTheta         ; Rotation angle of Block
                               varReturn        ; Variant return of translate coordinates
                              )
 (if (not objDocument)(setq objDocument (vla-get-activedocument 
                                         (vlax-get-acad-object))))
 (setq lstInsertion    (vlax-get objBlock "insertionpoint")
       sngTheta        (vla-get-rotation objBlock)
       lstPointInBlock (list (* (vla-get-XEffectiveScaleFactor objBlock)
                                 (+ (*    (cos sngTheta) (car  lstPointInBlock))
                                    (* -1 (sin sngTheta) (cadr lstPointInBlock))))
                              (* (vla-get-YEffectiveScaleFactor objBlock)
                                 (+ (*    (sin sngTheta) (car  lstPointInBlock))
                                    (*    (cos sngTheta) (cadr lstPointInBlock))))
                              (* (vla-get-ZEffectiveScaleFactor objBlock)
                                 (caddr lstPointInBlock)))
       varReturn       (vla-translateCoordinates (vla-get-utility
                                                 objDocument)                
                                                 (vlax-3d-point lstPointInBlock)
                                                 acOCS
                                                 acWorld
                                                 :vlax-false
                                                 (vla-get-normal objBlock))
       lstPointInWorld (mapcar '+ lstInsertion 
                                  (vlax-safearray->list (variant-value varReturn)))
 )
)



(princ "\nSelect configured CRUZbelt dynamic blocks from elevation view: ")
  
(setq ss (ssget (list (cons 0 "INSERT")(cons 2 (strcat "`*U*," "###_*")))))
(setq inc 0)
(setq finalss (ssadd))
  
(while (setq en (ssname ss inc))
  (setq blockname (vla-get-effectivename (vlax-ename->vla-object en)))
   (setq lastblockchr (substr blockname  (strlen blockname) 1));;finds version suffix
       (if (wcmatch  lastblockchr "#");;if block is original beta non-indexed (ends in a number)
	 (setq rootblockname blockname );;set rootblockname=blockname to be caught
  	(setq rootblockname (substr blockname 1 (- (strlen blockname) 1)));;if it is a later version block - set rootblockname to be caught w/o version letter
	 )
   
   (if (and (wcmatch (substr blockname 1 4 ) "150_")(not (wcmatch  blockname  "*EFWK*")) )
  (progn (setq IC (substr blockname 1 3 ))
    (ssadd en finalss)
    )
  ) 
  (setq inc (1+ inc))
 )

;finalss

(defun intbed ( / name prop );pulls the values out of an endbed and cued them up for applying into a plan unit block
  
	     (foreach prop props ;list for end bed
		(if (eq (setq name (vla-get-propertyname prop)) "Flip state1")(setq FL1Prop prop))
		(if (eq (setq name (vla-get-propertyname prop)) "Angle1")(setq AngProp prop))
		(if (eq (setq name (vla-get-propertyname prop)) "CRUZbelt CTC INCLINE/DECLINE INTERMEDIATE BED X")(setq XProp prop))
		(if (eq (setq name (vla-get-propertyname prop)) "CRUZbelt CTC INCLINE/DECLINE INTERMEDIATE BED Y")(setq YProp prop))
		   )
	     (foreach prop props 
		(if (eq (setq name (vla-get-propertyname prop)) "Planning length [b1]")(setq LenProp prop))
		(if (eq (setq name (vla-get-propertyname prop)) "typ_support")(setq SPTProp prop))
		(if (eq (setq name (vla-get-propertyname prop)) "typ_guardrail")(setq GRDProp prop))
		(if (eq (setq name (vla-get-propertyname prop)) "typ_adjustable_guardrail")(setq AGRDProp prop))
		  )
       		(setq fl1_val (vlax-variant-value (vla-get-value FL1Prop)))
	        (setq Ang_val (r2d (vlax-variant-value (vla-get-value AngProp))))
	        (setq X_val (vlax-variant-value (vla-get-value XProp)))
       		(setq Y_val (vlax-variant-value (vla-get-value YProp)))
       		(setq Len_val (vlax-variant-value (vla-get-value LenProp)))
       		(setq spt_val (vlax-variant-value (vla-get-value SptProp)))
       		(setq grd_val (vlax-variant-value (vla-get-value GrdProp)))
       		(setq agd_val (vlax-variant-value (vla-get-value AGrdProp)))
          	(Setq lstPointInBlock (list X_val Y_val 0.0))
           	(Setq XYpoint (TranslateObjectToWorld objBlock  lstPointInBlock ) )
	     
	   (set (read(strcat "BEDINFO_"(itoa (1+ inc))));evaluated values only
		(list (cons '"INTBED" rootblk)(cons '"HANDLE" handname)(cons '"prd_LP" tag)(cons '"BLOCKROT" rotval)
		(cons '"BLOCKINS" inspt)(cons '"ENDPOINT" XYpoint)(cons 'FL1Prop fl1_val)(cons 'AngProp Ang_val)(cons 'XProp X_val)
		(cons 'YProp Y_val)(cons 'LenProp Len_val)(cons 'SptProp spt_val)(cons 'GrdProp grd_val)(cons 'AGrdProp agd_val)))
	  )
(defun SSKbed ( / name prop );pulls the values out of an endbed and cued them up for applying into a plan unit block
  
	     (foreach prop props ;list for end bed
		(if (eq (setq name (vla-get-propertyname prop)) "Flip state1")(setq FL1Prop prop))
		(if (eq (setq name (vla-get-propertyname prop)) "Angle1")(setq AngProp prop))
		(if (eq (setq name (vla-get-propertyname prop)) "CRUZbelt CTC INCLINE/DECLINE SLICE SPLICE KIT X")(setq XProp prop))
		(if (eq (setq name (vla-get-propertyname prop)) "CRUZbelt CTC INCLINE/DECLINE SLICE SPLICE KIT Y")(setq YProp prop))
		   )
	     (foreach prop props 
		(if (eq (setq name (vla-get-propertyname prop)) "Planning length [b1]")(setq LenProp prop))
		  )
       		(setq fl1_val (vlax-variant-value (vla-get-value FL1Prop)))
	        (setq Ang_val (r2d (vlax-variant-value (vla-get-value AngProp))))
	        (setq X_val (vlax-variant-value (vla-get-value XProp)))
       		(setq Y_val (vlax-variant-value (vla-get-value YProp)))
       		(setq Len_val (vlax-variant-value (vla-get-value LenProp)))
            	(Setq lstPointInBlock (list X_val Y_val 0.0))
           	(Setq XYpoint (TranslateObjectToWorld objBlock  lstPointInBlock ) )

	     
	   (set (read(strcat "BEDINFO_"(itoa (1+ inc))));evaluated values only
		(list (cons '"SSKIT" rootblk)(cons '"HANDLE" handname)(cons '"prd_LP" tag)(cons '"BLOCKROT" rotval)
		(cons '"BLOCKINS" inspt)(cons '"ENDPOINT" XYpoint)(cons 'FL1Prop fl1_val)(cons 'AngProp Ang_val)(cons 'XProp X_val)
		(cons 'YProp Y_val)(cons 'LenProp Len_val)))
	  )

(defun endbed ( / name prop );pulls the values out of an endbed and cued them up for applying into a plan unit block
  
	     (foreach prop props ;list for end bed
		(if (eq (setq name (vla-get-propertyname prop)) "Flip state1")(setq FL1Prop prop))
		(if (eq (setq name (vla-get-propertyname prop)) "Angle1")(setq AngProp prop))
		(if (eq (setq name (vla-get-propertyname prop)) "CRUZbelt CTC INCLINE/DECLINE END BED X")(setq XProp prop))
		(if (eq (setq name (vla-get-propertyname prop)) "CRUZbelt CTC INCLINE/DECLINE END BED Y")(setq YProp prop))
		   )
	     (foreach prop props 
		(if (eq (setq name (vla-get-propertyname prop)) "Planning length [b1]")(setq LenProp prop))
		(if (eq (setq name (vla-get-propertyname prop)) "typ_support")(setq SPTProp prop))
		(if (eq (setq name (vla-get-propertyname prop)) "typ_guardrail")(setq GRDProp prop))
		(if (eq (setq name (vla-get-propertyname prop)) "typ_adjustable_guardrail")(setq AGRDProp prop))
		  )
       		(setq fl1_val (vlax-variant-value (vla-get-value FL1Prop)))
	        (setq Ang_val (r2d (vlax-variant-value (vla-get-value AngProp))))
	        (setq X_val (vlax-variant-value (vla-get-value XProp)))
       		(setq Y_val (vlax-variant-value (vla-get-value YProp)))
       		(setq Len_val (vlax-variant-value (vla-get-value LenProp)))
       		(setq spt_val (vlax-variant-value (vla-get-value SptProp)))
       		(setq grd_val (vlax-variant-value (vla-get-value GrdProp)))
       		(setq agd_val (vlax-variant-value (vla-get-value AGrdProp)))
                (Setq lstPointInBlock (list X_val Y_val 0.0))
           	(Setq XYpoint (TranslateObjectToWorld objBlock  lstPointInBlock ) )
	     
	   (set (read(strcat "BEDINFO_"(itoa (1+ inc))));evaluated values only
		(list (cons '"ENDBED" rootblk)(cons '"HANDLE" handname)(cons '"prd_LP" tag)(cons '"BLOCKROT" rotval)
		(cons '"BLOCKINS" inspt)(cons '"ENDPOINT" XYpoint)(cons 'FL1Prop fl1_val)(cons 'AngProp Ang_val)(cons 'XProp X_val)
		(cons 'YProp Y_val)(cons 'LenProp Len_val)(cons 'SptProp spt_val)(cons 'GrdProp grd_val)(cons 'AGrdProp agd_val)))
;;;	     (setq CHBinfo;nothing evaluated 
;;;		'(("CHARGEBED" . CHB)("HANDLE" . handname)("prd_LP" . tag)("BLOCKROT" . rotval)
;;;		("BLOCKINS" . inspt)(FL1Prop . fl1_val)(AngProp . Ang_val)(XProp . X_val)(YProp . Y_val)
;;;		(LenProp . Len_val)(SptProp . spt_val)(GrdProp . grd_val)(AGrdProp . agd_val)))
;;;	     (setq CHBinfo;both symbol and values evaluated
;;;		(list (cons "CHARGEBED" CHB)(cons "HANDLE" handname)(cons "prd_LP" tag)(cons "BLOCKROT" rotval)
;;;		(cons "BLOCKINS" inspt)(cons FL1Prop fl1_val)(cons AngProp Ang_val)(cons XProp X_val)(cons YProp Y_val)
;;;		(cons LenProp Len_val)(cons SptProp spt_val)(cons GrdProp grd_val)(cons AGrdProp agd_val)))
	  )
(defun noseoverbed ( / name prop )
	    (foreach prop props ;list for noseover bed
		(if (eq (setq name (vla-get-propertyname prop)) "Flip state1")(setq FL1Prop prop))
		(if (eq (setq name (vla-get-propertyname prop)) "geo_id_angle")(setq AngProp prop))
		(if (eq (setq name (vla-get-propertyname prop)) "CRUZbelt CTC INCLINE/DECLINE NOSEOVER BED X")(setq XProp prop))
		(if (eq (setq name (vla-get-propertyname prop)) "CRUZbelt CTC INCLINE/DECLINE NOSEOVER BED Y")(setq YProp prop))
		  )
	    (foreach prop props
		(if (eq (setq name (vla-get-propertyname prop)) "typ_ls")(setq LSProp prop))
	        (if (eq (setq name (vla-get-propertyname prop)) "typ_support")(setq SPTProp prop))
		(if (eq (setq name (vla-get-propertyname prop)) "typ_guardrail")(setq GRDProp prop))
		(if (eq (setq name (vla-get-propertyname prop)) "typ_adjustable_guardrail")(setq AGRDProp prop))
	        
		  )	
       		(setq fl1_val (vlax-variant-value (vla-get-value FL1Prop)))
	        (setq Ang_val (vlax-variant-value (vla-get-value AngProp)))
    		(setq LS_val (vlax-variant-value (vla-get-value LSProp)))
	        (setq X_val (vlax-variant-value (vla-get-value XProp)))
       		(setq Y_val (vlax-variant-value (vla-get-value YProp)))
       		(setq spt_val (vlax-variant-value (vla-get-value SptProp)))
       		(setq grd_val (vlax-variant-value (vla-get-value GrdProp)))
       		(setq agd_val (vlax-variant-value (vla-get-value AGrdProp)))
                (Setq lstPointInBlock (list X_val Y_val 0.0))
           	(Setq XYpoint (TranslateObjectToWorld objBlock  lstPointInBlock ) )

	    (set (read(strcat "BEDINFO_"(itoa (1+ inc))))
		 (list  (cons '"NOSEOVERBED" rootblk)(cons '"HANDLE" handname)(cons '"prd_LP" tag)(cons '"BLOCKROT" rotval)
		(cons '"BLOCKINS" inspt)(cons '"ENDPOINT" XYpoint)(cons 'FL1Prop fl1_val)(cons 'AngProp Ang_val)(cons 'LSProp LS_val)
		(cons 'XProp X_val)(cons 'YProp Y_val)(cons 'SptProp spt_val)(cons 'GrdProp grd_val)(cons 'AGrdProp agd_val)))
	  )

(defun noseunderbed ( / name prop )
	   (foreach prop props ;list for noseunder bed
		(if (eq (setq name (vla-get-propertyname prop)) "Flip state1")(setq FL1Prop prop))
		(if (eq (setq name (vla-get-propertyname prop)) "geo_id_angle")(setq AngProp prop))
		(if (eq (setq name (vla-get-propertyname prop)) "CRUZbelt CTC INCLINE/DECLINE NOSEUNDER BED X")(setq XProp prop))
		(if (eq (setq name (vla-get-propertyname prop)) "CRUZbelt CTC INCLINE/DECLINE NOSEUNDER BED Y")(setq YProp prop))
	          )
	   (foreach prop props
	        (if (eq (setq name (vla-get-propertyname prop)) "typ_ls")(setq LSProp prop))
	        (if (eq (setq name (vla-get-propertyname prop)) "typ_support")(setq SPTProp prop))
	        (if (eq (setq name (vla-get-propertyname prop)) "typ_guardrail")(setq GRDProp prop))
		(if (eq (setq name (vla-get-propertyname prop)) "typ_adjustable_guardrail")(setq AGRDProp prop))
	          )
       		(setq fl1_val (vlax-variant-value (vla-get-value FL1Prop)))
	        (setq Ang_val (vlax-variant-value (vla-get-value AngProp)))
    		(setq LS_val (vlax-variant-value (vla-get-value LSProp)))
	        (setq X_val (vlax-variant-value (vla-get-value XProp)))
       		(setq Y_val (vlax-variant-value (vla-get-value YProp)))
       		(setq spt_val (vlax-variant-value (vla-get-value SptProp)))
       		(setq grd_val (vlax-variant-value (vla-get-value GrdProp)))
       		(setq agd_val (vlax-variant-value (vla-get-value AGrdProp)))
    		(Setq lstPointInBlock (list X_val Y_val 0.0))
           	(Setq XYpoint (TranslateObjectToWorld objBlock  lstPointInBlock ) )
	   
	  (set (read(strcat "BEDINFO_"(itoa (1+ inc))))
		(list  (cons '"NOSEUNDERBED" rootblk)(cons '"HANDLE" handname)(cons '"prd_LP" tag)(cons '"BLOCKROT" rotval)
		(cons '"BLOCKINS" inspt)(cons '"ENDPOINT" XYpoint)(cons 'FL1Prop fl1_val)(cons 'AngProp Ang_val)(cons 'LSProp LS_val)
		(cons 'XProp X_val)(cons 'YProp Y_val)(cons 'SptProp spt_val)(cons 'GrdProp grd_val)(cons 'AGrdProp agd_val)))
	   )
(defun drvbed ( / name prop );pulls the values out of an endbed and cued them up for applying into a plan unit block
  
	     (foreach prop props ;list for end bed
		(if (eq (setq name (vla-get-propertyname prop)) "Flip state1")(setq FL1Prop prop))
		(if (eq (setq name (vla-get-propertyname prop)) "Angle1")(setq AngProp prop))
		(if (eq (setq name (vla-get-propertyname prop)) "CRUZbelt CTC INCLINE/DECLINE DRIVE BED X")(setq XProp prop))
		(if (eq (setq name (vla-get-propertyname prop)) "CRUZbelt CTC INCLINE/DECLINE DRIVE BED Y")(setq YProp prop))
		   )
    	     (foreach prop props 
		(if (eq (setq name (vla-get-propertyname prop)) "geo_roller_pitch")(setq RcProp prop))
		(if (eq (setq name (vla-get-propertyname prop)) "typ_belt")(setq BtProp prop))
		(if (eq (setq name (vla-get-propertyname prop)) "DRIVETRAIN_BRAKE_VOLTAGE")(setq DBVProp prop))
		(if (eq (setq name (vla-get-propertyname prop)) "typ_drivetrain")(setq TdtProp prop))
		  )
    	     (foreach prop props 
		(if (eq (setq name (vla-get-propertyname prop)) "typ_drive_model")(setq TdmProp prop))
		(if (eq (setq name (vla-get-propertyname prop)) "con_drive_voltage")(setq CdvProp prop))
		(if (eq (setq name (vla-get-propertyname prop)) "CONVEYOR_SPEED_HP")(setq ShpProp prop))
	        (if (eq (setq name (vla-get-propertyname prop)) "kin_velocity")(setq KvProp prop))
		(if (eq (setq name (vla-get-propertyname prop)) "typ_motor_power")(setq HpProp prop))
		  )
	     (foreach prop props 
		(if (eq (setq name (vla-get-propertyname prop)) "Planning length [b1]")(setq LenProp prop))
		(if (eq (setq name (vla-get-propertyname prop)) "typ_support")(setq SPTProp prop))
		(if (eq (setq name (vla-get-propertyname prop)) "typ_guardrail")(setq GRDProp prop))
		(if (eq (setq name (vla-get-propertyname prop)) "typ_adjustable_guardrail")(setq AGRDProp prop))
		  )
       		(setq fl1_val (vlax-variant-value (vla-get-value FL1Prop)))
	        (setq Ang_val (r2d (vlax-variant-value (vla-get-value AngProp))))
	        (setq X_val (vlax-variant-value (vla-get-value XProp)))
       		(setq Y_val (vlax-variant-value (vla-get-value YProp)))
    
		(setq rc_val (vlax-variant-value (vla-get-value RcProp)))
		(setq bt_val (vlax-variant-value (vla-get-value BtProp)))
    		(setq DBV_val (vlax-variant-value (vla-get-value DbvProp)))
    		(setq Tdt_val (vlax-variant-value (vla-get-value TdtProp)))
    		(setq Tdm_val (vlax-variant-value (vla-get-value TdmProp)))
    		(setq Cdv_val (vlax-variant-value (vla-get-value CdvProp)))
    		(setq Shp_val (vlax-variant-value (vla-get-value ShpProp)))
    		(setq Kv_val (vlax-variant-value (vla-get-value KvProp)))    
    		(setq Hp_val (vlax-variant-value (vla-get-value HpProp)))
       		(setq Len_val (vlax-variant-value (vla-get-value LenProp)))
       		(setq spt_val (vlax-variant-value (vla-get-value SptProp)))
       		(setq grd_val (vlax-variant-value (vla-get-value GrdProp)))
       		(setq agd_val (vlax-variant-value (vla-get-value AGrdProp)))
                (Setq lstPointInBlock (list X_val Y_val 0.0))
           	(Setq XYpoint (TranslateObjectToWorld objBlock  lstPointInBlock ) )
	     
	   (set (read(strcat "BEDINFO_"(itoa (1+ inc))));evaluated values only
		(list (cons '"DRIVEBED" rootblk)(cons '"HANDLE" handname)(cons '"prd_LP" tag)(cons '"BLOCKROT" rotval)
		(cons '"BLOCKINS" inspt)(cons '"ENDPOINT" XYpoint)(cons 'FL1Prop fl1_val)(cons 'AngProp Ang_val)(cons 'XProp X_val)
		(cons 'YProp Y_val)(cons 'RcProp rc_val)(cons 'BtProp bt_val)(cons 'DbvProp DBV_val)(cons 'TdtProp Tdt_val)
		(cons 'TdmProp Tdm_val)(cons 'CdvProp Cdv_val)(cons 'ShpProp Shp_val)(cons 'KvProp Kv_val)(cons 'HpProp Hp_val)
		(cons 'LenProp Len_val)(cons 'SptProp spt_val)(cons 'GrdProp grd_val)(cons 'AGrdProp agd_val)))
	  )



(defun getBprops ()
  (setq inc 0)
  (while (setq en (ssname finalss inc))
    
  
(setq BLKNAME (vla-get-effectivename (vlax-ename->vla-object en)))
(setq rootblk (substr BLKNAME 1 (- (strlen BLKNAME) 1)))
    
(setq blockdef (vla-item
			(vla-get-blocks
			  (vla-get-activedocument (vlax-get-acad-object)))
			BLKNAME))
(setq tmp (vlax-ename->vla-object en))
(setq objBlock tmp)
(setq handname (vla-get-handle tmp))
(setq rotval (r2d (vla-get-rotation  tmp)))
(setq props (vlax-invoke tmp 'GetDynamicBlockProperties))

(setq inspt (trans (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint tmp))) 0 1)   )
(foreach attrib  (vlax-invoke tmp 'GetAttributes)
	    (vlax-for it  blockdef
	      (if (equal (vla-get-objectname it) "AcDbAttributeDefinition")
		(progn
		  (if (equal (vla-get-tagstring attrib) (vla-get-tagstring it))
		    (if (equal "prd_LP" (vla-get-tagstring attrib))
		      (setq tag (vla-get-textstring attrib) )
		      )
		    )
		  )
		)
		)
  )

;now run a cond to run the appropriate gleaner to make the right assoc list
(cond
   	((= rootblk "150_END_06") (endbed))
	((= rootblk "150_NU_02") (noseunderbed))
	((= rootblk "150_NO_03") (noseoverbed))
	((= rootblk "150_DRIVE_06") (drvbed))
	((= rootblk "150_INT_06") (intbed))
	((= rootblk "150_SSK_05") (SSKbed))
	((T) (nil));skip this block

    
)
 (setq inc (1+ inc))
)
  )

 

ADN CAD Developer/Operator
blocks.dwg
0 Likes
Like
Report
Message 4 of 18

dbroad
Mentor
Mentor
‎02-06-2015 12:17 PM
Accepted solution

Assuming that inc is significant after (getbprops) runs, then the following should work.  Personally I would avoid the need to store every part with its own symbol.  That would open the door to symbol management issues.  Use a list instead.  Then the (read(strcat junk won't be necessary.

 

(defun maxx (inc / lst itm)
  (while (> inc 0)
    (setq itm (eval (read (strcat "BEDINFO_" (ITOA INC)))))
    (setq lst (cons (CADR (NTH 5 ITM)) LST))
    (setq inc (1- inc))
    )
  (APPLY 'MAX LST)
    )

 

Architect, Registered NC, VA, SC, & GA.
0 Likes
Like
Report
Message 5 of 18

rapidcad
Collaborator
Collaborator
in reply to dbroad
‎02-06-2015 12:52 PM

Thanks Doug - that is exactly what I was looking for. I will  use it to better understand the apply function.

 

Additionally, I appreciate your insight into the overall structure. I know that the way I headed on this isn't optimum, but it used some existing functions and it worked. it was a brainchild of mine to try storing each of the blocks individually as an association list. I am trying to keep each bed as an individual set of data so I can make decisions about what the user has laid out in elevation view. Depending on several key positions, right to left, top to bottom, and which way the drive is flipped, the unit will need several properties manipulated by this code in order to produce the plan view in the correct configuration.

 

I have a much simpler working version of this (without the association lists), but it requires the user to select important points (which he could screw- up). Addtionally, it does not cover every case I will eventually need to cover.

 

So how would I store data from some flexible number of beds so that I could figure out which one is in which order, and how they are flipped, etc. - to a single variable? What I'm asking is, how would I structure it so I don't have to store every part with it's own symbol?

ADN CAD Developer/Operator
0 Likes
Like
Report
Message 6 of 18

dbroad
Mentor
Mentor
in reply to rapidcad
‎02-06-2015 12:59 PM

Each place you use the (set....), just use (setq lst (cons (list (cons '"DRIVEBED" rootblk)
(cons '"HANDLE" handname).....)) lst).  Choose the global variable name you want for lst.  (I assume you need it global). To access any block data, use (nth i lst)

 

Architect, Registered NC, VA, SC, & GA.
0 Likes
Like
Report
Message 7 of 18

rapidcad
Collaborator
Collaborator
in reply to dbroad
‎02-06-2015 01:04 PM

Alright - let me try it and I'll see if I can't rearrange this to work that way. Once I run it and check the output the light bulb might go on!

Thanks!

ADN CAD Developer/Operator
0 Likes
Like
Report
Message 8 of 18

rapidcad
Collaborator
Collaborator
in reply to rapidcad
‎02-06-2015 01:49 PM

Ok, now that I look at the solution, I see that you have returned the minimum X value. I also see why you thought that the data wasn't important to keep associated. I'm still not real good at picking apart what something is doing, but I am getting better at it. My comments in red..

 

(defun maxx (inc / lst itm)  (while (> inc 0);;;;;function to return maximum x value

(setq itm (eval (read (strcat "BEDINFO_" (ITOA INC)))));;;set itm as a temporary placeholder to represent each BEDINFO list passed to it

(setq lst (cons (CADR (NTH 5 ITM)) LST));;make a list of just the x values of all the beds

    (setq inc (1- inc))    )  (APPLY 'MAX LST)    ) ;;;find the max value.

)

 

The following might help explain why I had each block keep the associated values isolated. I will need to make decisions regarding my next step depending on which kind of bed was the MAX X bed. I am trying to interpert the data to see if the user positioned a noseover or noseunder or end bed as their starting bed, or ending bed (could be any of the three kinds.) I'll also be looking for which way the drive is flowing, and which end is higher than the other. The various decisions will be predicated on the relationship that each data set has with it's location.

 

From the above function, I don't think I can find which bed had the MAX X.

ADN CAD Developer/Operator
0 Likes
Like
Report
Message 9 of 18

dbroad
Mentor
Mentor
in reply to rapidcad
‎02-07-2015 06:22 AM

If you need the data at the minimum x rather than the minimum x, you need to process the blocks keeping up with the  item of interest.  

(defun minx (inc / lst itm itmm xm xc)
  ;;get last first
  ;;program assumes a valid inc value
  (setq itmm (read (strcat "BEDINFO_" (ITOA INC))))
  (setq xm (CADR (NTH 5 (eval ITMm))))
  (setq inc (1- inc))
  ;;process  the rest
  (while (> inc 0)  ;;assumes index begins at 1
    (setq itm (read (strcat "BEDINFO_" (ITOA INC))))
    (setq xc (CADR (NTH 5 (eval ITM))))
    (if (< xc xm) (setq xm xc itmm itm));;update minimum value
    (setq inc (1- inc))
    )
  itmm ;; return item with minimum x value
  ;;(list xm itmm);;optional return with a list of x and symbol.
    )

 

Architect, Registered NC, VA, SC, & GA.
Report
Message 10 of 18

rapidcad
Collaborator
Collaborator
in reply to dbroad
‎02-09-2015 08:20 AM

Thanks Doug - I'm close to understanding it. I am struggling with a problem I introduced right off the bat.

When I first posted, I had originally attempted to keep the sets named "BEDINFO_1" through "BEDINFO_xx" by writing the functions like so:

 

(set (read(strcat "BEDINFO_"(itoa (1+ inc))))

 

However, I have since abandoned that idea due to compliations and I just accepted that "BEDINFO_0" could be my first set and (sslength finalss) would just end up being one greater than the highest number "BEDINFO_xx", so I am now setting the association lists starting with 0, like so:

 

(set (read(strcat "BEDINFO_"(itoa inc)))

 

So, I am trying to figure out how to make adjustments to your latest post since it "assumes index begins at 1"

 

I have worked around it like so:

 

(minx (setq inc (1- inc)))

 

or, actually -keeping inc the same but running the loop appropriately...

(minx (1- inc))

 

This returns the minimum x followed by the name of the association list. Works great! I'll try to write a few variations and see if I can't get all the information I need.

 

Thanks again,

Ron

 

ADN CAD Developer/Operator
0 Likes
Like
Report
Message 11 of 18

dbroad
Mentor
Mentor
in reply to rapidcad
‎02-09-2015 08:30 AM 
(while (>= inc 0);assumes a zero index
Architect, Registered NC, VA, SC, & GA.
0 Likes
Like
Report
Message 12 of 18

rapidcad
Collaborator
Collaborator
in reply to dbroad
‎02-09-2015 08:48 AM

Right, already made that adjustment. However, when my getBprops finishes running, it leaves the last "BEDINFO_" one less than (sslength finalss).

However, your function starts off like this:

 

(setq itmm (read (strcat "BEDINFO_" (ITOA INC))))

 

where INC will read one greater than the highest "BEDINFO_", so here's one of my workaround functions:

 

(defun minyend (inc / lst itm itmm xm xc) ;;get last first
   (setq itmm (read (strcat "BEDINFO_" (ITOA INC))));;program assumes a valid inc value
  (setq xm (CADDR (NTH 5 (eval ITMm))))
  (setq inc (1- inc))
  ;;process  the rest
  (while (>= inc 0)  ;;assumes index begins at 1
    (setq itm (read (strcat "BEDINFO_" (ITOA INC))))
    (setq xc (CADDR (NTH 5 (eval ITM))))
    (if (< xc xm) (setq xm xc itmm itm));;update minimum value
    (setq inc (1- inc))
    )
  itmm ;; return item with minimum y value
  (list xm itmm);;optional return with a list of y and symbol.
    )

 

(minyend (1- inc))

ADN CAD Developer/Operator
0 Likes
Like
Report
Message 13 of 18

dbroad
Mentor
Mentor
in reply to rapidcad
‎02-09-2015 09:37 AM

call it with (miny inc), not (Miny (1- inc))

 

Get inc set right in the main program to represent the last block.  The problem is not in these routines.

Architect, Registered NC, VA, SC, & GA.
0 Likes
Like
Report
Message 14 of 18

rapidcad
Collaborator
Collaborator
in reply to dbroad
‎02-09-2015 10:08 AM
I'll just (setq INC (1- inc)) before I run the comparison functions - Thanks..
ADN CAD Developer/Operator
0 Likes
Like
Report
Message 15 of 18

rapidcad
Collaborator
Collaborator
in reply to rapidcad
‎02-11-2015 01:53 PM

Doug, Dicra,

Thanks to your great help and the genius of Peter's function I have this working for every scenario. My only problem is coordinate systems. The program works fine if used in positive x and y space but fails to calculate correctly if the source dynamic blocks are in either negitive x or y coordinate space.

 

I understand why - it is because I used Peter's TranslateObjectToWorld function to convert the dynamic XY parameter coordinate data so I could compare it with the insertion point data and store each block's total x length. Then I check for furthest x points and furthest y points, make decisions about direction and which  way the system is flowing, where the high end is - all based on X and Y data. If I select blocks configured in negative coordinate value areas, the returned values no longer calculate correctly because the math is all designed to work in positive X and Y.

 

I attempted to create a temporary UCS at the begining of the program with the origin set at VSmin, then do all the work and return the UCS to the prevoius one when done, but that only made the corruption of coordinate data worse.

 

 ;at top of program
(setq #cucs (list (getvar "UCSORG")(trans (list 1 0 0) 1 0) (trans (list 0 1 0) 1 0)))
;Atilla on Autodesk forums via Marc'Antonio Alessi 6-1-2000
 


(defun resetucs (/);Atilla on Autodesk forums via Marc'Antonio Alessi 6-1-2000
  	(if (not (equal #cucs (list (getvar "UCSORG") (trans (list 1 0 0) 1 0) (trans (list 0 1 0) 1 0))))
  		((if command-s command-s vl-cmdf)
  			"_.UCS" "_3POINT" "_NONE" (trans (car #cucs) 0 1)
  			"_NONE" (trans (cadr #cucs) 0 1) "_NONE" (trans (caddr #cucs) 0 1)
  		)	
 	); test if changed and restore original
   )

 (defun	GetScreenCoords	(/ ViwCen ViwDim ViwSiz);Juerg Menzi 1-18-2001 Autodesk forms
   (setq ViwSiz	(/ (getvar "VIEWSIZE") 2.0)
	 ViwCen	(getvar "VIEWCTR")
	 ViwDim	(list
		  (* ViwSiz (apply '/ (getvar "SCREENSIZE")))
		  ViwSiz
		)
   )
   (list (mapcar '- ViwCen ViwDim) (mapcar '+ ViwCen ViwDim))
 ) 
  
(setq temporigin (car (GetScreenCoords ))) (append temporigin (list 0.0))
(command "_.UCS" temporigin "")

;;;here's where all the calculating and configuring goes on...

;and this at end of program
(resetucs)

 I'd post the whole program, but it is huge and not a pretty thing. I haven't changed the coordinate collection data methods since I posted last. Shouldn't the strategy work to set a new UCS origin first?

ADN CAD Developer/Operator
0 Likes
Like
Report
Message 16 of 18

Anonymous
Not applicable
in reply to rapidcad
‎02-12-2015 02:41 AM
Accepted solution

rapidcad,

 

I didn't follow your code but one way for creating your custom ucs is something like this:

 

(defun c:ucsobj()

(setq insertion (getpoint)
      rotation (getreal)
      adoc (vla-get-activedocument (vlax-get-acad-object))
      regUCS (vla-add
	       (vla-get-usercoordinateSystems adoc)
               (vlax-3D-point '(0 0 0))
               (vlax-3D-point (list (cos rotation) (sin rotation) 0))
               (vlax-3d-point (list (* -1 (sin rotation)) (cos rotation) 0))
               "ucs_obj")
      )
  (vla-put-origin regUCS (vlax-3d-point insertion 0 1))
  (vla-put-activeUCS adoc regUCS)
  )

 Remember that you will need to use trans for point manipulation between coordinate systems.

More about trans you can find here:

trans HELP

 

Second way for your problem might be with matrix translation.

Lee mac commands are really helpful for this problem:

lee-mac matrix , thanks @Lee_Mac .

 

Hope this help,

dicra

Report
Message 17 of 18

rapidcad
Collaborator
Collaborator
in reply to Anonymous
‎02-12-2015 07:23 AM

Thanks Dicra - I got it now. I had to take Peter Jamtgaard's fantastic  TranslateObjectToWorld function and change it to a TranslateObjectToUCS function - aiming at the current ucs. like this:

; Function for transforming a point from block object coordinate system to THE CURRENT user coordinate system.
; It handles normals other than (0.0 0.0 1.0)
; lstPoint is the point to transform and objBlock is the block object
; The block is uniformly scaled at 1.0.
; Written By: Peter Jamtgaard copr 2008

(defun TranslateObjectToUCS (objBlock         ; Block object 
                               lstPointInBlock  ; Coordinates of point (RELATIVE TO BASE POINT)
                                                ; inside the block
                               /       
                               lstInsertion     ; Insertion Point of Block
                               lstPoint         ; List Point of return translate coordinates
                               lstPointInUCS  ; Coordinates of point inside the CURRENT UCS
                               sngTheta         ; Rotation angle of Block
                               varReturn        ; Variant return of translate coordinates
                              )
 (if (not objDocument)(setq objDocument (vla-get-activedocument 
                                         (vlax-get-acad-object))))
 (setq lstInsertion    (vlax-get objBlock "insertionpoint")
       sngTheta        (vla-get-rotation objBlock)
       lstPointInBlock (list (* (vla-get-XEffectiveScaleFactor objBlock)
                                 (+ (*    (cos sngTheta) (car  lstPointInBlock))
                                    (* -1 (sin sngTheta) (cadr lstPointInBlock))))
                              (* (vla-get-YEffectiveScaleFactor objBlock)
                                 (+ (*    (sin sngTheta) (car  lstPointInBlock))
                                    (*    (cos sngTheta) (cadr lstPointInBlock))))
                              (* (vla-get-ZEffectiveScaleFactor objBlock)
                                 (caddr lstPointInBlock)))
       varReturn       (vla-translateCoordinates (vla-get-utility
                                                 objDocument)                
                                                 (vlax-3d-point lstPointInBlock)
                                                 acOCS
                                                 acUCS
                                                 :vlax-false
                                                 (vla-get-normal objBlock))
       lstPointInUCS (mapcar '+ lstInsertion 
                                  (vlax-safearray->list (variant-value varReturn)))
 )
)

 I also decided to try your ucsobj function instead of the way I was using command UCS. It works perfectly now in any part of the coordinate system. Thanks again for helping.

 

Ron

ADN CAD Developer/Operator
0 Likes
Like
Report
Message 18 of 18

Anonymous
Not applicable
in reply to rapidcad
‎02-12-2015 10:06 AM

Ron,

 

You're welcome, Im glad I could be of help.

 

dicra

 

 

 

 

0 Likes
Like
Report
Report a website issue